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)