From tneste at common-lisp.net Sat Dec 29 14:45:53 2007 From: tneste at common-lisp.net (tneste) Date: Sat, 29 Dec 2007 09:45:53 -0500 (EST) Subject: [pal-cvs] CVS pal Message-ID: <20071229144553.CAA02111EA@common-lisp.net> Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv9369 Modified Files: color.lisp ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt Log Message: Fixed a few brainfarts in, mostly in pal-macros.lisp and examples/ --- /project/pal/cvsroot/pal/color.lisp 2007/10/31 12:51:22 1.2 +++ /project/pal/cvsroot/pal/color.lisp 2007/12/29 14:45:53 1.3 @@ -18,4 +18,13 @@ (defun random-color () - (color (random 255) (random 255) (random 255) (random 255))) \ No newline at end of file + (color (random 255) (random 255) (random 255) (random 255))) + + + + +(defparameter +black+ (color 0 0 0)) +(defparameter +gray+ (color 128 128 128)) +(defparameter +light-gray+ (color 200 200 200)) +(defparameter +dark-gray+ (color 64 64 64)) +(defparameter +white+ (color 255 255 255)) \ No newline at end of file --- /project/pal/cvsroot/pal/ffi.lisp 2007/11/29 23:26:51 1.23 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/12/29 14:45:53 1.24 @@ -435,7 +435,7 @@ (defvar *resources* () "List of currently loaded resources.") (defstruct image - (file "") + (file nil) (texture 0 :type u11) ; "GL texture id for image." (texture-width 0 :type u11) ; "Actual (rounded up to power of two) width of texture." (texture-height 0 :type u11) ; "Actual (rounded up to power of two) height of texture." @@ -445,17 +445,17 @@ (width 0 :type u11)) ; "Width of textures visible part." (defstruct font - (file "") + (file nil) (image nil :type (or boolean image)) (glyphs nil :type (or boolean (simple-vector 255))) (height 0 :type u11)) (defstruct music - file + (file nil) music) (defstruct sample - file + (file nil) chunk) --- /project/pal/cvsroot/pal/package.lisp 2007/11/14 00:04:34 1.23 +++ /project/pal/cvsroot/pal/package.lisp 2007/12/29 14:45:53 1.24 @@ -452,6 +452,7 @@ #:halt-music #:color #:color-r #:color-g #:color-b #:color-a #:random-color + #:+black+ #:+white+ #:+gray+ #:+dark-gray+ #:+light-gray+ #:v #:vec #:copy-vec #:angle-v #:v-angle #:vx #:vy #:v= #:v-round #:v-floor #:v-random --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/10/31 22:38:22 1.17 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/12/29 14:45:53 1.18 @@ -90,7 +90,7 @@ (defmacro with-default-settings (&body body) "Evaluate BODY with default transformations and blend settings." `(with-transformation () - (with-blend (:mode :blend :color (color 255 255 255 255)) + (with-blend (:mode :blend :color +white+) (pal-ffi:gl-load-identity) , at body))) @@ -103,7 +103,7 @@ ,(unless (eq mode t) `(set-blend-mode ,mode)) ,(when color - `(set-blend-color (color-r ,color) (color-g ,color) (color-b ,color) (color-a ,color))) + `(set-blend-color ,color)) (prog1 (progn , at body) (close-quads) @@ -152,7 +152,7 @@ (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) - (set-blend-color ,r ,g ,b ,a) + (set-blend-color (color ,r ,g ,b ,a)) (pal-ffi:gl-line-width ,size) (if ,smoothp (pal-ffi:gl-enable pal-ffi:+gl-line-smooth+) --- /project/pal/cvsroot/pal/pal.lisp 2007/11/29 23:26:51 1.42 +++ /project/pal/cvsroot/pal/pal.lisp 2007/12/29 14:45:53 1.43 @@ -97,7 +97,7 @@ (pal-ffi:gl-matrix-mode pal-ffi:+gl-modelview+) (pal-ffi:gl-load-identity) (pal-ffi:gl-pixel-store pal-ffi:+gl-pack-alignment+ 1) - (clear-screen 0 0 0) + (clear-screen +black+) (reset-tags) (define-tags default-font (load-font "default-font")) (add-path *pal-directory*) @@ -268,12 +268,12 @@ (truncate 1000 *fps*)) (declaim (inline clear-screen)) -(defunct clear-screen (r g b) - (u8 r u8 g u8 b) +(defunct clear-screen (color) + (color color) (close-quads) - (pal-ffi:gl-clear-color (/ r 255f0) - (/ g 255f0) - (/ b 255f0) + (pal-ffi:gl-clear-color (/ (color-r color) 255f0) + (/ (color-g color) 255f0) + (/ (color-b color) 255f0) 1f0) (pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+)) @@ -366,12 +366,12 @@ (defun reset-blend () (close-quads) (set-blend-mode :blend) - (set-blend-color 255 255 255 255)) + (set-blend-color +white+)) (declaim (inline set-blend-color)) -(defunct set-blend-color (r g b a) - (u8 r u8 g u8 b u8 a) - (pal-ffi:gl-color4ub r g b a)) +(defunct set-blend-color (color) + (color color) + (pal-ffi:gl-color4ub (color-r color) (color-g color) (color-b color) (color-a color))) (declaim (inline set-image)) (defunct set-image (image) --- /project/pal/cvsroot/pal/todo.txt 2007/11/29 23:26:51 1.22 +++ /project/pal/cvsroot/pal/todo.txt 2007/12/29 14:45:53 1.23 @@ -2,7 +2,7 @@ - Make sure resources are loaded only once. -- Fix offsets in draw-image. +- Fix offsets in draw-image (shouldn't need transformations). - Polygon smooth hint? From tneste at common-lisp.net Sat Dec 29 14:45:54 2007 From: tneste at common-lisp.net (tneste) Date: Sat, 29 Dec 2007 09:45:54 -0500 (EST) Subject: [pal-cvs] CVS pal/examples Message-ID: <20071229144554.1103312083@common-lisp.net> Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv9369/examples Modified Files: hello.lisp images.lisp Log Message: Fixed a few brainfarts in, mostly in pal-macros.lisp and examples/ --- /project/pal/cvsroot/pal/examples/hello.lisp 2007/10/31 12:51:23 1.10 +++ /project/pal/cvsroot/pal/examples/hello.lisp 2007/12/29 14:45:53 1.11 @@ -16,7 +16,7 @@ (/ (- (pal:get-screen-height) (pal:get-font-height font)) 2))))) - (pal:set-blend-color 0 0 0 255) + (pal:set-blend-color (pal:color 0 0 0 255)) (pal:draw-text "Hello from PAL" (pal:v+ midpoint (pal:v 5 5)) font) (pal:reset-blend) (pal:draw-text "Hello from PAL" midpoint font))) @@ -28,7 +28,7 @@ (defun hello-2 () (pal:with-pal (:fps 10000) (let ((angle 0f0)) - (pal:set-blend-color 0 255 0 255) + (pal:set-blend-color (pal:color 0 255 0 255)) (pal:event-loop () (pal:draw-rectangle (pal:v 0 0) (pal:get-screen-width) (pal:get-screen-height) @@ -42,7 +42,7 @@ (defun hello-3 () (pal:with-pal (:fps 10000) (pal:event-loop () - (pal:clear-screen 0 0 0) + (pal:clear-screen pal:+black+) (loop for x from 0 to 800 by (pal:get-text-size "Hello from PAL") do (loop for y from 20 to 600 by 10 --- /project/pal/cvsroot/pal/examples/images.lisp 2007/10/31 12:51:23 1.9 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/12/29 14:45:53 1.10 @@ -14,17 +14,18 @@ (truncate (+ 127 (* 128 (cos (/ (- x y) 10)))))))) ;; IMAGE-FROM-ARRAY builds an image from a 2d array of (list r g b &optional a) ;; Try setting the SMOOTHP parameter to T and see what happens. - image-2 (image-from-array nil #2A(((255 255 255 128) (0 0 0) (255 255 255)) - ((255 255 255) (255 255 0) (255 255 255)) - ((255 255 255) (0 0 0) (255 255 255 128)))) + image-2 (image-from-array #2A(((255 255 255 128) (0 0 0) (255 255 255)) + ((255 255 255) (255 255 0) (255 255 255)) + ((255 255 255) (0 0 0) (255 255 255 128))) + nil) ;; LOAD-IMAGE-TO-ARRAY does exactly what it says. Let's load the plane image and randomize the alpha values a bit. - image-3 (image-from-array nil - (let ((image (load-image-to-array "lego-plane.png"))) + image-3 (image-from-array (let ((image (load-image-to-array "lego-plane.png"))) (do-n (x (array-dimension image 0) y (array-dimension image 1)) (when (> (fourth (aref image x y)) 200) (setf (fourth (aref image x y)) (+ (random 128) 127)))) - image))) + image) + nil)) @@ -57,8 +58,8 @@ ;; Press left mousebutton to capture part of the screen as a new cursor. ;; Note that altough the allocated images are released when PAL is closed we really should manually release - ;; the old cursor image with FREE-RESOURCE if we keep allocating lots of new images. + ;; the old cursor image with FREE-RESOURCE if we keep allocating lots of new images. (when (key-pressed-p :key-mouse-1) (set-cursor (image-from-array - nil - (screen-to-array (get-mouse-pos) 128 128))))))) \ No newline at end of file + (screen-to-array (get-mouse-pos) 128 128) + nil)))))) \ No newline at end of file