From tneste at common-lisp.net  Wed Nov 14 00:04:34 2007
From: tneste at common-lisp.net (tneste)
Date: Tue, 13 Nov 2007 19:04:34 -0500 (EST)
Subject: [pal-cvs] CVS pal/examples
Message-ID: <20071114000434.7C48C4B05E@common-lisp.net>

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)



From tneste at common-lisp.net  Wed Nov 14 00:04:34 2007
From: tneste at common-lisp.net (tneste)
Date: Tue, 13 Nov 2007 19:04:34 -0500 (EST)
Subject: [pal-cvs] CVS pal
Message-ID: <20071114000434.BE3874B05E@common-lisp.net>

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



From tneste at common-lisp.net  Thu Nov 29 23:26:51 2007
From: tneste at common-lisp.net (tneste)
Date: Thu, 29 Nov 2007 18:26:51 -0500 (EST)
Subject: [pal-cvs] CVS pal
Message-ID: <20071129232651.62B326F23D@common-lisp.net>

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))