[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Mon Jul 30 10:38:13 UTC 2007
Update of /project/pal/cvsroot/pal
In directory clnet:/tmp/cvs-serv15809
Modified Files:
ffi.lisp pal-macros.lisp pal.lisp vector.lisp
Log Message:
Rest of gl-quad optimisations
--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/27 21:25:40 1.15
+++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/30 10:38:12 1.16
@@ -1,5 +1,5 @@
(declaim (optimize (speed 3)
- (safety 3)))
+ (safety 0)))
(in-package :pal-ffi)
--- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/29 19:11:44 1.11
+++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/30 10:38:12 1.12
@@ -1,5 +1,5 @@
(declaim (optimize (speed 3)
- (safety 3)))
+ (safety 2)))
(in-package :pal)
--- /project/pal/cvsroot/pal/pal.lisp 2007/07/29 21:55:24 1.24
+++ /project/pal/cvsroot/pal/pal.lisp 2007/07/30 10:38:12 1.25
@@ -4,9 +4,11 @@
;; fix the fps
;; clean up the do-event
;; check for redundant close-quads, make sure rotations etc. are optimised.
+;; newline support for draw-text
+
(declaim (optimize (speed 3)
- (safety 3)))
+ (safety 2)))
(in-package :pal)
@@ -505,67 +507,52 @@
array)))
-(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)
+(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)
(set-image image)
- (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)))))
- ))
+ (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))))))
(defunct draw-image* (image from-pos to-pos width height)
@@ -573,21 +560,23 @@
(set-image image)
(let* ((vx (vx from-pos))
(vy (vy from-pos))
- (vx-to (vx to-pos))
- (vy-to (vy to-pos))
+ (x1 (vx to-pos))
+ (y1 (vy to-pos))
+ (x2 (+ x1 width))
+ (y2 (+ y1 height))
(tx1 (/ vx (pal-ffi:image-texture-width image)))
(ty1 (/ vy (pal-ffi:image-texture-height image)))
(tx2 (/ (+ vx width) (pal-ffi:image-texture-width image)))
(ty2 (/ (+ vy height) (pal-ffi:image-texture-height image))))
(with-gl pal-ffi:+gl-quads+
(pal-ffi:gl-tex-coord2f tx1 ty1)
- (pal-ffi:gl-vertex2f vx-to vy-to)
+ (pal-ffi:gl-vertex2f x1 y1)
(pal-ffi:gl-tex-coord2f tx2 ty1)
- (pal-ffi:gl-vertex2f (+ vx-to width) vy-to)
+ (pal-ffi:gl-vertex2f x2 y1)
(pal-ffi:gl-tex-coord2f tx2 ty2)
- (pal-ffi:gl-vertex2f (+ vx-to width) (+ vy-to height))
+ (pal-ffi:gl-vertex2f x2 y2)
(pal-ffi:gl-tex-coord2f tx1 ty2)
- (pal-ffi:gl-vertex2f vx-to (+ vy-to height)))))
+ (pal-ffi:gl-vertex2f x1 y2))))
(declaim (inline draw-line))
(defunct draw-line (la lb r g b a &key (size 1.0f0) (smoothp))
--- /project/pal/cvsroot/pal/vector.lisp 2007/07/29 21:53:52 1.6
+++ /project/pal/cvsroot/pal/vector.lisp 2007/07/30 10:38:12 1.7
@@ -1,5 +1,5 @@
(declaim (optimize (speed 3)
- (safety 3)))
+ (safety 2)))
(in-package :pal)
More information about the Pal-cvs
mailing list