Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv32428

Modified Files: package.lisp pal-macros.lisp pal.asd pal.lisp todo.txt vector.lisp Added Files: color.lisp Log Message: Added color.lisp. WITH-BLEND now takes a COLOR structure as its :COLOR argument instead of a list.

--- /project/pal/cvsroot/pal/package.lisp 2007/10/24 18:07:03 1.20 +++ /project/pal/cvsroot/pal/package.lisp 2007/10/30 20:43:10 1.21 @@ -370,7 +370,7 @@ #:free-resource #:free-all-resources #:define-tags - #:add-tag + #:add-tag #:tag #:sample #:music @@ -388,8 +388,8 @@ #:random-elt #:clamp #:do-n - - #:handle-events + + #:handle-events #:key-pressed-p #:keysym-char #:test-keys @@ -451,6 +451,8 @@ #:play-music #:halt-music

+ #:color #:color-r #:color-g #:color-b #:color-a #:random-color + #:v #:vec #:copy-vec #:angle-v #:v-angle #:vx #:vy #:v= #:v-round #:v-floor #:v-random #:v+ #:v+! #:v- #:v-! #:v* #:v*! #:v/ #:v/! #:v-max #:v-min #:v-rotate --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/10/24 17:51:47 1.15 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/10/30 20:43:10 1.16 @@ -90,20 +90,20 @@ (defmacro with-default-settings (&body body) "Evaluate BODY with default transformations and blend settings." `(with-transformation () - (with-blend (:mode :blend :color '(255 255 255 255)) + (with-blend (:mode :blend :color (color 255 255 255 255)) (pal-ffi:gl-load-identity) ,@body)))

(defmacro with-blend ((&key (mode t) color) &body body) - "Evaluate BODY with blend options set to MODE and COLOR. Color is a list of (r g b a) values." + "Evaluate BODY with blend options set to MODE and COLOR." `(progn (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) ,(unless (eq mode t) `(set-blend-mode ,mode)) ,(when color - `(set-blend-color (first ,color) (second ,color) (third ,color) (fourth ,color))) + `(set-blend-color (color-r ,color) (color-g ,color) (color-b ,color) (color-a ,color))) (prog1 (progn ,@body) (close-quads) --- /project/pal/cvsroot/pal/pal.asd 2007/07/21 16:34:16 1.3 +++ /project/pal/cvsroot/pal/pal.asd 2007/10/30 20:43:10 1.4 @@ -8,12 +8,14 @@ :components ((:file "ffi" :depends-on ("package")) + (:file "color" + :depends-on ("package")) (:file "vector" :depends-on ("pal-macros")) (:file "pal-macros" - :depends-on ("ffi")) + :depends-on ("ffi" "color")) (:file "pal" - :depends-on ("pal-macros" "vector")) + :depends-on ("pal-macros" "color" "vector")) (:file "package")) :depends-on ("cffi"))

--- /project/pal/cvsroot/pal/pal.lisp 2007/10/29 20:04:19 1.37 +++ /project/pal/cvsroot/pal/pal.lisp 2007/10/30 20:43:10 1.38 @@ -1,8 +1,3 @@ -;; Notes: -;; add start/end args to draw-circle -;; check for redundant close-quads, optimise rotations/offsets etc. in draw-image -;; optimise gl state handling, fix clipping, structured color values -

(declaim (optimize (speed 3) (safety 1))) @@ -185,10 +180,12 @@

(defunct keysym-char (keysym) (symbol keysym) - (let ((kv (cffi:foreign-enum-value 'pal-ffi:sdl-key keysym))) - (if (and (> kv 0) (< kv 256)) - (code-char kv) - nil))) + (if (or (eq keysym :key-mouse-1) (eq keysym :key-mouse-2) (eq keysym :key-mouse-3)) + nil + (let ((kv (cffi:foreign-enum-value 'pal-ffi:sdl-key keysym))) + (if (and (> kv 0) (< kv 256)) + (code-char kv) + nil))))

(declaim (inline get-mouse-pos)) (defun get-mouse-pos () @@ -882,9 +879,7 @@ (declaim (inline get-font-height)) (defunct get-font-height (&optional font) ((or font boolean) font) - (pal-ffi:font-height (if font - font - (tag 'default-font)))) + (pal-ffi:font-height (or font (tag 'default-font))))

(defunct get-text-size (text &optional font) ((or font boolean) font simple-string text) @@ -904,5 +899,4 @@ (defun message (&rest messages) (setf *messages* (append *messages* (list (format nil "~{~S ~}" messages)))) (when (> (length *messages*) (- (truncate (get-screen-height) (get-font-height)) 1)) - (pop *messages*))) - + (pop *messages*))) \ No newline at end of file --- /project/pal/cvsroot/pal/todo.txt 2007/10/29 20:04:20 1.19 +++ /project/pal/cvsroot/pal/todo.txt 2007/10/30 20:43:10 1.20 @@ -1,7 +1,26 @@ TODO:

+ +For v1.1 + +- Fix offsets in draw-image. + +- Polygon smooth hint? + - Add align, scale and angle options to DRAW-IMAGE*.

+- Better clipping. + +- Structured color values. + + + +After v1.1 + +- Better drawing primitives, real lines, start/end args to draw-circle etc. + +- As always, optimise GL state handling. + - Implement image mirroring, tiles and animation.

- Box/box/line/circle etc. overlap functions, faster v-dist. @@ -16,9 +35,11 @@

As separate projects on top of PAL:

-- Native CL font resource builder +- GUI, work in progress. + +- Native CL font resource builder.

-- TTF support +- TTF support.

- Some sort of sprite library?

--- /project/pal/cvsroot/pal/vector.lisp 2007/10/11 19:26:23 1.9 +++ /project/pal/cvsroot/pal/vector.lisp 2007/10/30 20:43:10 1.10 @@ -12,12 +12,12 @@

(declaim (inline component)) (defunct component (x) - (number x) + (number x) (coerce x 'component))

(declaim (inline v)) (defunct v (x y) - (component x component y) + (component x component y) (make-vec :x x :y y))

(declaim (inline vf)) @@ -29,74 +29,74 @@

(declaim (inline rad)) (defunct rad (degrees) - (component degrees) + (component degrees) (* (/ pi 180) degrees))

(declaim (inline deg)) (defunct deg (radians) - (component radians) + (component radians) (* (/ 180 pi) radians))

(declaim (inline angle-v)) (defunct angle-v (angle) - (component angle) + (component angle) (v (sin (rad angle)) (- (cos (rad angle)))))

(declaim (inline v-angle)) (defunct v-angle (vec) - (vec vec) + (vec vec) (mod (deg (atan (vx vec) (if (zerop (vy vec)) least-negative-short-float - (- (vy vec))))) + (- (vy vec))) )) 360))

(defunct v-random (length) - (number length) + (number length) (v* (angle-v (random 360.0)) length))

(declaim (inline v-round)) (defunct v-round (v) - (vec v) + (vec v) (v (round (vx v)) (round (vy v))))

(declaim (inline v-floor)) (defunct v-floor (v) - (vec v) + (vec v) (v (floor (vx v)) (floor (vy v))))

(declaim (inline v=)) (defunct v= (a b) - (vec a vec b) + (vec a vec b) (and (= (vx a) (vx b)) (= (vy a) (vy b))))

(declaim (inline v+!)) (defunct v+! (a b) - (vec a vec b) + (vec a vec b) (setf (vx a) (+ (vx a) (vx b))) (setf (vy a) (+ (vy a) (vy b))) nil)

(declaim (inline v+)) (defunct v+ (a b) - (vec a vec b) + (vec a vec b) (vf (+ (vx a) (vx b)) (+ (vy a) (vy b))))

(declaim (inline v-)) (defunct v- (a b) - (vec a vec b) + (vec a vec b) (vf (- (vx a) (vx b)) (- (vy a) (vy b))))

(declaim (inline v-!)) (defunct v-! (a b) - (vec a vec b) + (vec a vec b) (setf (vx a) (- (vx a) (vx b))) (setf (vy a) (- (vy a) (vy b))) nil) @@ -104,47 +104,47 @@

(declaim (inline v*!)) (defunct v*! (v m) - (component m) + (component m) (setf (vx v) (* (vx v) m)) (setf (vy v) (* (vy v) m)) nil)

(declaim (inline v*)) (defunct v* (v m) - (vec v component m) + (vec v component m) (vf (* (vx v) m) (* (vy v) m)))

(declaim (inline v/)) (defunct v/ (v d) - (vec v component d) + (vec v component d) (vf (/ (vx v) d) (/ (vy v) d)))

(declaim (inline v/!)) (defunct v/! (v d) - (vec v component d) + (vec v component d) (setf (vx v) (/ (vx v) d)) (setf (vy v) (/ (vy v) d)) nil)

(declaim (inline v-max)) (defunct v-max (a b) - (vec a vec b) + (vec a vec b) (if (< (v-magnitude a) (v-magnitude b)) b a))

(declaim (inline v-min)) (defunct v-min (a b) - (vec a vec b) + (vec a vec b) (if (< (v-magnitude a) (v-magnitude b)) a b))

(defunct v-rotate (v a) - (vec v component a) + (vec v component a) (let ((a (rad a))) (v (- (* (cos a) (vx v)) (* (sin a) (vy v))) @@ -153,20 +153,20 @@

(declaim (inline v-dot)) (defunct v-dot (a b) - (vec a vec b) + (vec a vec b) (+ (* (vx a) (vx b)) (* (vy a) (vy b))))

(declaim (inline v-magnitude)) (defunct v-magnitude (v) - (vec v) + (vec v) (the component (sqrt (the component (+ (expt (vx v) 2) (expt (vy v) 2))))))

(defunct v-normalize (v) - (vec v) + (vec v) (let ((m (v-magnitude v))) (if (/= m 0f0) (vf (/ (vx v) m) @@ -174,23 +174,23 @@ (vf 0f0 0f0))))

(defunct v-direction (from-vector to-vector) - (vec from-vector vec to-vector) + (vec from-vector vec to-vector) (v-normalize (v- to-vector from-vector)))

(defunct v-distance (v1 v2) - (vec v1 vec v2) + (vec v1 vec v2) (v-magnitude (v- v1 v2)))

(defunct v-truncate (v l) - (vec v component l) + (vec v component l) (v* (v-normalize v) l))

(defunct closest-point-to-line (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let* ((dir (v- b a)) (diff (v- p a)) (len (v-dot dir dir))) @@ -204,14 +204,14 @@ a)))))

(defunct point-in-line-p (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let ((d (v-direction a b))) (if (< (abs (+ (v-dot d (v-direction a p)) (v-dot d (v-direction b p)))) .00001) t nil)))

(defunct lines-intersection (la1 la2 lb1 lb2) - (vec la1 vec la2 vec lb1 vec lb2) + (vec la1 vec la2 vec lb1 vec lb2) (let ((x1 (vx la1)) (y1 (vy la1)) (x2 (vx la2)) @@ -237,7 +237,7 @@ nil))))))

(defunct circle-line-intersection (a b co r) - (vec a vec b vec co component r) + (vec a vec b vec co component r) (let ((cp (closest-point-to-line a b co))) (if cp (if (<= (v-distance co cp) r) @@ -246,14 +246,14 @@ nil)))

(defunct distance-from-line (a b p) - (vec a vec b vec p) + (vec a vec b vec p) (let ((cp (closest-point-to-line a b p))) (if cp (v-distance cp p) nil)))

(defunct point-inside-rectangle-p (topleft width height point) - (vec topleft vec point component width component height) + (vec topleft vec point component width component height) (let* ((x1 (vx topleft)) (y1 (vy topleft)) (x2 (+ x1 width)) @@ -266,10 +266,10 @@

(declaim (inline point-inside-circle-p)) (defunct point-inside-circle-p (co r p) - (vec co vec p component r) + (vec co vec p component r) (<= (v-distance co p) r))

(declaim (inline circles-overlap-p)) (defunct circles-overlap-p (c1 r1 c2 r2) - (vec c1 vec c2 component r1 component r2) + (vec c1 vec c2 component r1 component r2) (<= (v-distance c1 c2) (+ r2 r1))) \ No newline at end of file

--- /project/pal/cvsroot/pal/color.lisp 2007/10/30 20:43:11 NONE +++ /project/pal/cvsroot/pal/color.lisp 2007/10/30 20:43:11 1.1 (in-package :pal)

(defstruct color (r 0 :type pal::u8) (g 0 :type pal::u8) (b 0 :type pal::u8) (a 0 :type pal::u8))

(declaim (inline color)) (defun color (r g b a) (make-color :r r :g g :b b :a a))

(defun random-color () (color (random 255) (random 255) (random 255) (random 255)))