pal-cvs

pal-cvs@common-lisp.net

127 discussions

[pal-cvs] CVS pal
by tneste 02 Jan '08

02 Jan '08

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv29264 Modified Files: ffi.lisp Log Message: Fixed the glyph array declaration in ffi.lisp --- /project/pal/cvsroot/pal/ffi.lisp 2007/12/29 14:45:53 1.24 +++ /project/pal/cvsroot/pal/ffi.lisp 2008/01/02 19:58:34 1.25 @@ -447,7 +447,7 @@ (defstruct font (file nil) (image nil :type (or boolean image)) - (glyphs nil :type (or boolean (simple-vector 255))) + (glyphs nil :type (or boolean (simple-vector 256))) (height 0 :type u11)) (defstruct music

1 0

[pal-cvs] CVS pal/examples
by tneste 29 Dec '07

29 Dec '07

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

1 0

[pal-cvs] CVS pal
by tneste 29 Dec '07

29 Dec '07

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) ,@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 ,@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?

1 0

[pal-cvs] CVS pal
by tneste 29 Nov '07

29 Nov '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv14930 Modified Files: ffi.lisp pal.lisp todo.txt vector.lisp Log Message: DATA-PATH should now always return a truename. --- /project/pal/cvsroot/pal/ffi.lisp 2007/10/24 18:07:03 1.22 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/11/29 23:26:51 1.23 @@ -435,6 +435,7 @@ (defvar *resources* () "List of currently loaded resources.") (defstruct image + (file "") (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." @@ -444,14 +445,17 @@ (width 0 :type u11)) ; "Width of textures visible part." (defstruct font + (file "") (image nil :type (or boolean image)) (glyphs nil :type (or boolean (simple-vector 255))) (height 0 :type u11)) (defstruct music + file music) (defstruct sample + file chunk) --- /project/pal/cvsroot/pal/pal.lisp 2007/11/14 00:04:34 1.41 +++ /project/pal/cvsroot/pal/pal.lisp 2007/11/29 23:26:51 1.42 @@ -158,8 +158,9 @@ "Find a FILE from the search paths." (let ((result nil)) (dolist (i *data-paths* result) - (when (probe-file (merge-pathnames file i)) - (setf result (namestring (merge-pathnames file i))))) + (let ((truename (probe-file (merge-pathnames file i)))) + (when truename + (setf result (namestring (merge-pathnames truename i)))))) (if result result (error "Data file not found: ~a" file)))) @@ -524,7 +525,7 @@ (ty1 (if vmirror (pal-ffi:image-ty2 image) 0f0)) (tx2 (if hmirror 0f0 (pal-ffi:image-tx2 image))) (ty2 (if vmirror 0f0 (pal-ffi:image-ty2 image)))) - (if (or angle scale valign halign) + (if (or angle scale valign halign) (with-transformation () (translate pos) (when angle --- /project/pal/cvsroot/pal/todo.txt 2007/10/31 12:51:23 1.21 +++ /project/pal/cvsroot/pal/todo.txt 2007/11/29 23:26:51 1.22 @@ -1,11 +1,12 @@ TODO: +- Make sure resources are loaded only once. - Fix offsets in draw-image. - Polygon smooth hint? -- Add align, scale and angle options to DRAW-IMAGE*. +- Add align, scale, mirror and angle options to DRAW-IMAGE*. - Better clipping. @@ -17,7 +18,7 @@ - As always, optimise GL state handling. Blitting in batches, possibly VOBs. -- Implement image mirroring, tiles and animation. +- Implement "tiles" and animation. - Box/box/line/circle etc. overlap functions, faster v-dist. --- /project/pal/cvsroot/pal/vector.lisp 2007/11/14 00:04:34 1.11 +++ /project/pal/cvsroot/pal/vector.lisp 2007/11/29 23:26:51 1.12 @@ -265,7 +265,8 @@ t nil))) -(defun rectangles-overlap-p (a a-width a-height b b-width b-height) +(defunct rectangles-overlap-p (a a-width a-height b b-width b-height) + (vec a component a-width component a-height vec b component b-width component b-height) (let ((ax (vx a)) (ay (vy a)) (bx (vx b))

1 0

[pal-cvs] CVS pal
by tneste 14 Nov '07

14 Nov '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13845 Modified Files: package.lisp pal.lisp vector.lisp Log Message: Added :VMIRROR and :HMIRROR options to DRAW-IMAGE. Added RECTANGLES-OVERLAP-P. --- /project/pal/cvsroot/pal/package.lisp 2007/10/31 22:38:22 1.22 +++ /project/pal/cvsroot/pal/package.lisp 2007/11/14 00:04:34 1.23 @@ -459,5 +459,6 @@ #:v-dot #:v-magnitude #:v-normalize #:v-distance #:v-truncate #:v-direction #:closest-point-to-line #:point-in-line-p #:lines-intersection - #:distance-from-line #:circle-line-intersection #:point-inside-rectangle-p + #:distance-from-line #:circle-line-intersection + #:point-inside-rectangle-p #:rectangles-overlap-p #:circles-overlap-p #:point-inside-circle-p)) \ No newline at end of file --- /project/pal/cvsroot/pal/pal.lisp 2007/10/31 22:38:22 1.40 +++ /project/pal/cvsroot/pal/pal.lisp 2007/11/14 00:04:34 1.41 @@ -515,14 +515,16 @@ array))) -(defunct draw-image (image pos &key angle scale valign halign) - (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign) +(defunct draw-image (image pos &key angle scale valign halign vmirror hmirror) + (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign symbol vmirror symbol hmirror) (set-image image) (let ((width (image-width image)) (height (image-height image)) - (tx2 (pal-ffi:image-tx2 image)) - (ty2 (pal-ffi:image-ty2 image))) - (if (or angle scale valign halign) + (tx1 (if hmirror (pal-ffi:image-tx2 image) 0f0)) + (ty1 (if vmirror (pal-ffi:image-ty2 image) 0f0)) + (tx2 (if hmirror 0f0 (pal-ffi:image-tx2 image))) + (ty2 (if vmirror 0f0 (pal-ffi:image-ty2 image)))) + (if (or angle scale valign halign) (with-transformation () (translate pos) (when angle @@ -540,26 +542,26 @@ (:middle (- (/ height 2f0))) (otherwise 0f0)))) (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) + (pal-ffi:gl-tex-coord2f tx1 ty1) (pal-ffi:gl-vertex2f x y) - (pal-ffi:gl-tex-coord2f tx2 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty1) (pal-ffi:gl-vertex2f (+ x width) y) (pal-ffi:gl-tex-coord2f tx2 ty2) (pal-ffi:gl-vertex2f (+ x width) (+ y height)) - (pal-ffi:gl-tex-coord2f 0f0 ty2) + (pal-ffi:gl-tex-coord2f tx1 ty2) (pal-ffi:gl-vertex2f x (+ y height))))) (let* ((x (vx pos)) (y (vy pos)) (width (+ x width)) (height (+ y height))) (with-gl pal-ffi:+gl-quads+ - (pal-ffi:gl-tex-coord2f 0f0 0f0) + (pal-ffi:gl-tex-coord2f tx1 ty1) (pal-ffi:gl-vertex2f x y) - (pal-ffi:gl-tex-coord2f tx2 0f0) + (pal-ffi:gl-tex-coord2f tx2 ty1) (pal-ffi:gl-vertex2f width y) (pal-ffi:gl-tex-coord2f tx2 ty2) (pal-ffi:gl-vertex2f width height) - (pal-ffi:gl-tex-coord2f 0f0 ty2) + (pal-ffi:gl-tex-coord2f tx1 ty2) (pal-ffi:gl-vertex2f x height)))))) @@ -897,8 +899,8 @@ font (tag 'default-font))))) -(defun draw-fps () - (draw-text (prin1-to-string (get-fps)) (v 0 0))) +(defun draw-fps (&optional font) + (draw-text (prin1-to-string (get-fps)) (v 0 0) font)) (defun message (&rest messages) (setf *messages* (append *messages* (list (format nil "~{~S ~}" messages)))) --- /project/pal/cvsroot/pal/vector.lisp 2007/10/30 20:43:10 1.10 +++ /project/pal/cvsroot/pal/vector.lisp 2007/11/14 00:04:34 1.11 @@ -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,24 +29,24 @@ (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 @@ -54,49 +54,49 @@ 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)) @@ -264,12 +264,24 @@ (> y y1) (< y y2)) t nil))) + +(defun rectangles-overlap-p (a a-width a-height b b-width b-height) + (let ((ax (vx a)) + (ay (vy a)) + (bx (vx b)) + (by (vy b))) + (not (or (> ax (+ bx b-width)) + (< (+ ax a-width) bx) + (> ay (+ by b-height)) + (< (+ ay a-height) by))))) + + (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

1 0

[pal-cvs] CVS pal/examples
by tneste 14 Nov '07

14 Nov '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv13845/examples Modified Files: hares.lisp Log Message: Added :VMIRROR and :HMIRROR options to DRAW-IMAGE. Added RECTANGLES-OVERLAP-P. --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/08/30 09:02:23 1.9 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/11/14 00:04:34 1.10 @@ -29,9 +29,7 @@ (defmethod draw ((s sprite)) (set-blend-color (r-of s) (g-of s) (b-of s) 255) (draw-image (tag 'hare) - (v- (pos-of s) (v* (v (image-width (tag 'hare)) - (image-height (tag 'hare))) - (* (scale-of s) .5))) + (pos-of s) :halign :middle :valign :middle :scale (scale-of s) @@ -70,8 +68,8 @@ :angle (random 360.0))) (event-loop () - ;;(+ 1 (v 10 10)) (draw-rectangle (v 0 0) 800 600 255 255 255 255 :fill (tag 'bg)) + (with-blend (:mode *blend-mode*) (dolist (i *sprites*) (draw i)

1 0

[pal-cvs] CVS pal/examples
by tneste 31 Oct '07

31 Oct '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv19546 Added Files: vecto.lisp Log Message: Added vecto.lisp. --- /project/pal/cvsroot/pal/examples/vecto.lisp 2007/10/31 22:39:33 NONE +++ /project/pal/cvsroot/pal/examples/vecto.lisp 2007/10/31 22:39:33 1.1 ;;; Few utility functions and examples of using PAL with Vecto (http://www.xach.com/lisp/vecto/) (defpackage :pal-vecto (:use :cl) (:export state-to-image)) (in-package :pal-vecto) (defun state-to-image (smoothp) "Convert current Vecto graphics state to PAL image." (let* ((data (vecto::image-data vecto::*graphics-state*)) (width (vecto::width vecto::*graphics-state*)) (height (vecto::height vecto::*graphics-state*)) (image (make-array (list width height)))) (pal:do-n (x width y height) (let ((pixel (+ (* x 4) (* y width 4)))) (setf (aref image x y) (list (aref data pixel) (aref data (+ pixel 1)) (aref data (+ pixel 2)) (aref data (+ pixel 3)))))) (pal:image-from-array image smoothp)))

1 0

[pal-cvs] CVS pal
by tneste 31 Oct '07

31 Oct '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv19301 Modified Files: package.lisp pal-macros.lisp pal.lisp Log Message: Fixed a bug in WITH-RESOURCE. Swapped the arguments of IMAGE-FROM-ARRAY. --- /project/pal/cvsroot/pal/package.lisp 2007/10/30 20:43:10 1.21 +++ /project/pal/cvsroot/pal/package.lisp 2007/10/31 22:38:22 1.22 @@ -358,7 +358,7 @@ (defpackage #:pal (:use :common-lisp) (:import-from :pal-ffi - #:free-resource #:register-resource #:load-foreign-libraries + #:register-resource #:load-foreign-libraries #:image-p #:image #:font #:font-p #:sample #:music #:sample-p #:music-p #:resource #:resource-p #:image-width #:image-height #:u8 #:u11 #:u16) @@ -452,7 +452,7 @@ #: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/30 20:43:10 1.16 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/10/31 22:38:22 1.17 @@ -84,7 +84,7 @@ `(let ((,resource ,init-form)) (prog1 (progn ,@body) - (free-resource ,resource)))) + (pal:free-resource ,resource)))) (defmacro with-default-settings (&body body) --- /project/pal/cvsroot/pal/pal.lisp 2007/10/31 12:51:22 1.39 +++ /project/pal/cvsroot/pal/pal.lisp 2007/10/31 22:38:22 1.40 @@ -115,6 +115,10 @@ (defun random-elt (sequence) (elt sequence (random (length sequence)))) +(defun free-resource (resource) + (close-quads) + (pal-ffi:free-resource resource)) + (defun free-all-resources () (reset-tags) (pal-ffi:halt-music) @@ -404,7 +408,7 @@ (cffi:mem-ref b :uint8) (cffi:mem-ref a :uint8))))) -(defun image-from-array (smoothp array) +(defun image-from-array (array smoothp) (image-from-fn (array-dimension array 0) (array-dimension array 1) smoothp

1 0

[pal-cvs] CVS pal/documentation
by tneste 31 Oct '07

31 Oct '07

Update of /project/pal/cvsroot/pal/documentation In directory clnet:/tmp/cvs-serv19301/documentation Modified Files: pal-manual.lyx Log Message: Fixed a bug in WITH-RESOURCE. Swapped the arguments of IMAGE-FROM-ARRAY. --- /project/pal/cvsroot/pal/documentation/pal-manual.lyx 2007/10/31 12:51:23 1.3 +++ /project/pal/cvsroot/pal/documentation/pal-manual.lyx 2007/10/31 22:38:22 1.4 @@ -1761,7 +1761,7 @@ \end_layout \begin_layout Subsection -SET-BLEND +SET-BLEND-MODE \end_layout \begin_layout Subsection

1 0

[pal-cvs] CVS pal/examples
by tneste 31 Oct '07

31 Oct '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv6234/examples Modified Files: hello.lisp images.lisp swarm.lisp teddy.lisp Log Message: Some polishing. Version 1.1 --- /project/pal/cvsroot/pal/examples/hello.lisp 2007/07/27 21:25:40 1.9 +++ /project/pal/cvsroot/pal/examples/hello.lisp 2007/10/31 12:51:23 1.10 @@ -18,7 +18,7 @@ 2))))) (pal:set-blend-color 0 0 0 255) (pal:draw-text "Hello from PAL" (pal:v+ midpoint (pal:v 5 5)) font) - (pal:reset-blend-mode) + (pal:reset-blend) (pal:draw-text "Hello from PAL" midpoint font))) (pal:wait-keypress))) --- /project/pal/cvsroot/pal/examples/images.lisp 2007/09/07 07:55:15 1.8 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/10/31 12:51:23 1.9 @@ -57,7 +57,7 @@ ;; 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 --- /project/pal/cvsroot/pal/examples/swarm.lisp 2007/07/21 16:34:16 1.5 +++ /project/pal/cvsroot/pal/examples/swarm.lisp 2007/10/31 12:51:23 1.6 @@ -1,5 +1,6 @@ ;; NOTE: the following example is intentionally slow and somewhat obfuscated + (defun swarm () (let ((vectors nil)) (pal:with-pal (:width 1024 :height 768) @@ -9,7 +10,7 @@ (setf vectors (append vectors (loop repeat 50 collecting (cons (pal:get-mouse-pos) (pal:v-random 5.0)))))))) (pal:draw-rectangle (pal:v 0 0) 1024 768 0 0 0 128) - (pal:with-blend (:color '(255 128 128 255)) + (pal:with-blend (:color (pal:color 255 128 128)) (pal:draw-text "Use left mousekey to add particles." (pal:v 0 0))) (let ((midpoint (pal:v/ (reduce 'pal:v+ vectors :initial-value (pal:v 0 0) :key 'car) --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/09/07 07:55:15 1.10 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/10/31 12:51:23 1.11 @@ -121,7 +121,7 @@ ;; then the sprites, first the shadows ;; sorting the sprites and their shadows according to their altitude is left as an exercise to the reader - (with-blend (:color '(0 0 0 128)) + (with-blend (:color (color 0 0 0 128)) (dolist (i *sprites*) (with-transformation (:pos (v (alt-of i) (alt-of i))) (draw i)))) @@ -148,6 +148,7 @@ (draw-fps) ;; Draw the frames/second counter to the top left corner. (draw-text "Press key to select blend-mode:" (v 200 (* 0 (get-font-height)))) - (draw-text "1=nil 2=:blend 3=:additive" (v 200 (* 1 (get-font-height))))))) + (draw-text "1=nil 2=:blend 3=:additive" (v 200 (* 1 (get-font-height)))) + (draw-text "Press F to fade out the music." (v 200 (* 2 (get-font-height))))))) ;; (example) \ No newline at end of file

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs