[pal-cvs] CVS pal

[tneste]

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

Modified Files:
	pal.lisp 
Log Message:
More gl-begin optimisations, ALIGN keywords currently broken.

--- /project/pal/cvsroot/pal/pal.lisp	2007/07/29 19:11:44	1.23
+++ /project/pal/cvsroot/pal/pal.lisp	2007/07/29 21:55:24	1.24
@@ -1,9 +1,9 @@
 ;; Notes:
-;; smoothed polygons, guess circle segment count, add start/end args to draw-circle
+;; smoothed polygons, guess circle segment count, add start/end args to draw-circle, use triangle-fan
 ;; calculate max-texture-size
 ;; fix the fps
 ;; clean up the do-event
-
+;; check for redundant close-quads, make sure rotations etc. are optimised.
 
 (declaim (optimize (speed 3)
                    (safety 3)))
@@ -105,7 +105,6 @@
     (clear-screen 0 0 0)
     (reset-tags)
     (define-tags default-font (load-font "default-font"))
-
     (add-path *pal-directory*)
     (add-path *default-pathname-defaults*)
     (if (listp paths)
@@ -505,52 +504,68 @@
                                                              3))))))
       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 0f0) (scale 1f0) (valign :left) (halign :top))
+    (image image vec pos single-float angle single-float scale symbol halign symbol valign)
   (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)
-        (with-transformation ()
-          (translate pos)
-          (when angle
-            (rotate angle))
-          (when scale
-            (scale scale scale)) ;; :-)
-          (let ((x (case halign
-                     (:right (coerce (- width) 'single-float))
-                     (:left 0f0)
-                     (:middle (- (/ width 2f0)))
-                     (otherwise 0f0)))
-                (y (case valign
-                     (:bottom (coerce (- height) 'single-float))
-                     (:top 0f0)
-                     (:middle (- (/ height 2f0)))
-                     (otherwise 0f0))))
-            (with-gl pal-ffi:+gl-quads+
-              (pal-ffi:gl-tex-coord2f 0f0 0f0)
-              (pal-ffi:gl-vertex2f x y)
-              (pal-ffi:gl-tex-coord2f tx2 0f0)
-              (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-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-vertex2f x y)
-            (pal-ffi:gl-tex-coord2f tx2 0f0)
-            (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-vertex2f x height))))))
+  (if (and (= angle 0f0) (= scale 1f0) (eq valign :left) (eq halign :top))
+      (let* ((tx2 (pal-ffi:image-tx2 image))
+             (ty2 (pal-ffi:image-ty2 image))
+             (x (vx pos))
+             (y (vy pos))
+             (width (+ x (image-width image)))
+             (height (+ y (image-height image))))
+        (with-gl pal-ffi:+gl-quads+
+          (pal-ffi:gl-tex-coord2f 0f0 0f0)
+          (pal-ffi:gl-vertex2f x y)
+          (pal-ffi:gl-tex-coord2f tx2 0f0)
+          (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-vertex2f x height)))
+      (let* ((tx2 (pal-ffi:image-tx2 image))
+             (ty2 (pal-ffi:image-ty2 image))
+             (width (* (image-width image) scale))
+             (height (* (image-height image) scale))
+             (b (v+ (v-rotate (v width 0) angle) pos))
+             (c (v+ (v-rotate (v width height) angle) pos))
+             (d (v+ (v-rotate (v 0 height) angle) pos)))
+        (with-gl pal-ffi:+gl-quads+
+          (pal-ffi:gl-tex-coord2f 0f0 0f0)
+          (pal-ffi:gl-vertex2f (vx pos) (vy pos))
+          (pal-ffi:gl-tex-coord2f tx2 0f0)
+          (pal-ffi:gl-vertex2f (vx b) (vy b))
+          (pal-ffi:gl-tex-coord2f tx2 ty2)
+          (pal-ffi:gl-vertex2f (vx c) (vy c))
+          (pal-ffi:gl-tex-coord2f 0f0 ty2)
+          (pal-ffi:gl-vertex2f (vx d) (vy d))))
+      ;; (with-transformation ()
+      ;; (translate pos)
+      ;; (when angle
+      ;; (rotate angle))
+      ;; (when scale
+      ;; (scale scale scale)) ;; :-)
+      ;; (let ((x (case halign
+      ;; (:right (coerce (- width) 'single-float))
+      ;; (:left 0f0)
+      ;; (:middle (- (/ width 2f0)))
+      ;; (otherwise 0f0)))
+      ;; (y (case valign
+      ;; (:bottom (coerce (- height) 'single-float))
+      ;; (:top 0f0)
+      ;; (:middle (- (/ height 2f0)))
+      ;; (otherwise 0f0))))
+      ;; (with-gl pal-ffi:+gl-quads+
+      ;; (pal-ffi:gl-tex-coord2f 0f0 0f0)
+      ;; (pal-ffi:gl-vertex2f x y)
+      ;; (pal-ffi:gl-tex-coord2f tx2 0f0)
+      ;; (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-vertex2f x (+ y height)))))
+      ))
 
 
 (defunct draw-image* (image from-pos to-pos width height)