pal-cvs July 2007

pal-cvs@common-lisp.net

1 participants
48 discussions

[pal-cvs] CVS pal
by tneste 30 Jul '07

30 Jul '07

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)

1 0

[pal-cvs] CVS pal/examples
by tneste 30 Jul '07

30 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv15809/examples Modified Files: hares.lisp Log Message: Rest of gl-quad optimisations --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/29 19:11:44 1.6 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/30 10:38:11 1.7 @@ -54,7 +54,7 @@ (defun example () - (with-pal (:width 800 :height 600 :fullscreenp t :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*)) + (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*)) (setf *sprites* nil) (set-cursor nil) (dotimes (i 500)

1 0

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

29 Jul '07

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)

1 0

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

29 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv22662/examples Modified Files: teddy.lisp Log Message: More gl-begin optimisations, ALIGN keywords currently broken. --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/29 19:11:44 1.6 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/29 21:55:23 1.7 @@ -80,7 +80,7 @@ (defun example () - (with-pal (:fullscreenp nil :width 800 :height 600 :fullscreenp nil :fps 60 :paths (merge-pathnames "examples/" pal::*pal-directory*)) + (with-pal (:fullscreenp nil :width 800 :height 600 :fps 60 :paths (merge-pathnames "examples/" pal::*pal-directory*)) ;; inits PAL, the args used are the default values. ;; PATHS is a pathname or list of pathnames that PAL uses to find the resource files loaded with LOAD-* functions. ;; By default PATHS contains the PAL source directory and value of *default-pathname-defaults*

1 0

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

29 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv22308 Modified Files: package.lisp vector.lisp Log Message: Mnor cleanups and name changes: circles-overlap => circles-overlap-p, point-inside-rectangle => point-inside-rectangle-p, point-in-line => point-in-line-p. --- /project/pal/cvsroot/pal/package.lisp 2007/07/27 21:25:40 1.13 +++ /project/pal/cvsroot/pal/package.lisp 2007/07/29 21:53:52 1.14 @@ -454,6 +454,6 @@ #:v+ #:v+! #:v- #:v-! #:v* #:v*! #:v/ #:v/! #:v-max #:v-min #:v-rotate #:v-dot #:v-magnitude #:v-normalize #:v-distance #:v-truncate #:v-direction - #:closest-point-to-line #:point-in-line #:lines-intersection - #:distance-from-line #:circle-line-intersection #:point-inside-rectangle - #:circles-overlap #:point-inside-circle)) \ No newline at end of file + #:closest-point-to-line #:point-in-line-p #:lines-intersection + #:distance-from-line #:circle-line-intersection #:point-inside-rectangle-p + #:circles-overlap-p #:point-inside-circle-p)) \ No newline at end of file --- /project/pal/cvsroot/pal/vector.lisp 2007/07/21 16:34:16 1.5 +++ /project/pal/cvsroot/pal/vector.lisp 2007/07/29 21:53:52 1.6 @@ -9,6 +9,7 @@ (defstruct (vec (:conc-name v)) (x 0 :type component) (y 0 :type component)) + (declaim (inline component)) (defunct component (x) (number x) @@ -28,19 +29,19 @@ (declaim (inline rad)) (defunct rad (degrees) - (number degrees) - (component (* (/ pi 180) degrees))) + (component degrees) + (* (/ pi 180) degrees)) (declaim (inline deg)) (defunct deg (radians) - (number radians) - (component (* (/ 180 pi) radians))) + (component radians) + (* (/ 180 pi) radians)) (declaim (inline angle-v)) (defunct angle-v (angle) - (number angle) + (component angle) (v (sin (rad angle)) (- (cos (rad angle))))) (declaim (inline vec-angle)) @@ -145,10 +146,10 @@ (defunct v-rotate (v a) (vec v component a) (let ((a (rad a))) - (vf (- (* (cos a) (vx v)) - (* (sin a) (vy v))) - (+ (* (sin a) (vx v)) - (* (cos a) (vy v)))))) + (v (- (* (cos a) (vx v)) + (* (sin a) (vy v))) + (+ (* (sin a) (vx v)) + (* (cos a) (vy v)))))) (declaim (inline v-dot)) (defunct v-dot (a b) @@ -166,10 +167,11 @@ (defunct v-normalize (v) (vec v) - (if (/= (v-magnitude v) 0.0) - (vf (/ (vx v) (v-magnitude v)) - (/ (vy v) (v-magnitude v))) - (vf 0.0 0.0))) + (let ((m (v-magnitude v))) + (if (/= m 0f0) + (vf (/ (vx v) m) + (/ (vy v) m)) + (vf 0f0 0f0)))) (defunct v-direction (from-vector to-vector) (vec from-vector vec to-vector) @@ -201,7 +203,7 @@ b) a))))) -(defunct point-in-line (a b p) +(defunct point-in-line-p (a b p) (vec a vec b vec p) (let ((d (v-direction a b))) (if (< (abs (+ (v-dot d (v-direction a p)) @@ -229,8 +231,8 @@ nil (let ((p (vf (/ (- (* b1 c2) (* b2 c1)) denom) (/ (- (* a2 c1) (* a1 c2)) denom)))) - (if (and (point-in-line la1 la2 p) - (point-in-line lb1 lb2 p)) + (if (and (point-in-line-p la1 la2 p) + (point-in-line-p lb1 lb2 p)) p nil)))))) @@ -250,24 +252,24 @@ (v-distance cp p) nil))) -(defunct point-inside-rectangle (topleft width height pos) - (vec topleft vec pos component width component height) +(defunct point-inside-rectangle-p (topleft width height point) + (vec topleft vec point component width component height) (let* ((x1 (vx topleft)) (y1 (vy topleft)) (x2 (+ x1 width)) (y2 (+ y1 height)) - (x (vx pos)) - (y (vy pos))) + (x (vx point)) + (y (vy point))) (if (and (> x x1) (< x x2) (> y y1) (< y y2)) t nil))) -(declaim (inline point-inside-circle)) -(defunct point-inside-circle (co r p) +(declaim (inline point-inside-circle-p)) +(defunct point-inside-circle-p (co r p) (vec co vec p component r) (<= (v-distance co p) r)) -(declaim (inline circles-overlap)) -(defunct circles-overlap (c1 r1 c2 r2) +(declaim (inline circles-overlap-p)) +(defunct circles-overlap-p (c1 r1 c2 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 29 Jul '07

29 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv8365/examples Modified Files: hares.lisp images.lisp teddy.lisp Log Message: Eliminated some of the unnecessary gl-begins. --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/28 13:13:17 1.5 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/29 19:11:44 1.6 @@ -16,7 +16,6 @@ (defclass sprite () ((pos :accessor pos-of :initarg :pos :initform (v 0 0)) (vel :accessor vel-of :initarg :vel :initform (v 0 0)) - (image :accessor image-of :initarg :image) (angle :accessor angle-of :initarg :angle :initform 0) (r :accessor r-of :initarg :r) (g :accessor g-of :initarg :g) @@ -29,12 +28,14 @@ (defmethod draw ((s sprite)) (set-blend-color (r-of s) (g-of s) (b-of s) 255) - (draw-image (image-of s) - (pos-of s) + (draw-image (tag 'hare) + (v- (pos-of s) (v* (v (image-width (tag 'hare)) + (image-height (tag 'hare))) + (* (scale-of s) .5))) :halign :middle :valign :middle - :angle (angle-of s) - :scale (scale-of s))) + :scale (scale-of s) + :angle (angle-of s))) (defmethod act ((s sprite)) (setf (angle-of s) (mod (+ (angle-of s) 1) 360)) @@ -53,13 +54,12 @@ (defun example () - (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*)) + (with-pal (:width 800 :height 600 :fullscreenp t :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*)) (setf *sprites* nil) (set-cursor nil) (dotimes (i 500) (make-instance 'sprite - :image (tag 'hare) - :scaled (- (random .2) .1) + :scaled (- (random .1) .05) :scale (+ (random 1.5) .5) :r (random 255) :g (random 255) --- /project/pal/cvsroot/pal/examples/images.lisp 2007/07/27 22:48:40 1.6 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/07/29 19:11:44 1.7 @@ -29,7 +29,8 @@ (with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*)) - (set-cursor (tag 'image-3)) ;; sets image-3 as a mouse cursor image + (set-cursor (tag 'image-3)) + ;; sets image-3 as a mouse cursor image (let ((a 0)) (event-loop () (draw-polygon* (list (v 0 0) --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/27 20:12:12 1.5 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/29 19:11:44 1.6 @@ -44,8 +44,8 @@ (defmethod act ((s sprite)) (v+! (pos-of s) (vel-of s)) - (v*! (vel-of s) .90) - (v*! (vel-of s) .90)) + (v*! (vel-of s) .98) + (v*! (vel-of s) .98)) (defmethod draw ((s sprite)) (draw-image (image-of s)

1 0

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

29 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv8365 Modified Files: pal-macros.lisp pal.lisp Log Message: Eliminated some of the unnecessary gl-begins. --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/24 12:55:06 1.10 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/29 19:11:44 1.11 @@ -79,6 +79,7 @@ (defmacro with-blend ((&key (mode t) color) &body body) `(progn + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) ,(unless (eq mode t) `(set-blend-mode ,mode)) @@ -86,6 +87,7 @@ `(set-blend-color (first ,color) (second ,color) (third ,color) (fourth ,color))) (prog1 (progn ,@body) + (close-quads) (pal-ffi:gl-pop-attrib)))) (defmacro with-clipping ((x y width height) &body body) @@ -97,6 +99,7 @@ (defmacro with-transformation ((&key pos angle scale) &body body) `(progn + (close-quads) (pal-ffi:gl-push-matrix) ,(when pos `(translate ,pos)) @@ -108,16 +111,23 @@ (scale ,s ,s)))) (prog1 (progn ,@body) + (close-quads) (pal-ffi:gl-pop-matrix)))) (defmacro with-gl (mode &body body) - `(progn - (pal-ffi:gl-begin ,mode) - ,@body - (pal-ffi:gl-end))) + (if (eq mode 'pal-ffi:+gl-quads+) + `(progn + (open-quads) + ,@body) + `(progn + (close-quads) + (pal-ffi:gl-begin ,mode) + ,@body + (pal-ffi:gl-end)))) (defmacro with-line-settings (smoothp size r g b a &body body) `(progn + (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) --- /project/pal/cvsroot/pal/pal.lisp 2007/07/27 22:48:40 1.22 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/29 19:11:44 1.23 @@ -3,7 +3,6 @@ ;; calculate max-texture-size ;; fix the fps ;; clean up the do-event -;; open quads and other optimisations (declaim (optimize (speed 3) @@ -33,6 +32,8 @@ (defvar *mouse-y* 0) (defvar *current-image* nil) (defvar *max-texture-size* 0) +(defvar *quads-open* nil) + (declaim (type list *messages*) (type list *clip-stack*) @@ -47,6 +48,7 @@ (type fixnum *fps*) (type u11 *max-fps*) (type u11 *delay*) + (type boolean *quads-open*) (type (or boolean image) *cursor*) (type (or boolean image) *current-image*)) @@ -79,6 +81,7 @@ *max-fps* (truncate 1000 fps) *ticks* (pal-ffi:get-tick) *clip-stack* nil + *quads-open* nil *fps* 1 *delay* 0 *new-fps* 0 @@ -220,10 +223,10 @@ (draw-text m (v 0 (incf y fh)))))) (defun update-screen () + (close-quads) (let ((e (pal-ffi:gl-get-error))) (unless (= e 0) (error "GL error ~a" e))) - (setf *new-fps* (max 1 (the fixnum (- (pal-ffi:get-tick) *ticks*)))) (setf *fps* (truncate (+ *fps* *new-fps*) 2)) (if (> *delay* 1) @@ -239,7 +242,6 @@ (with-default-settings (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) (draw-messages))) - (pal-ffi:gl-swap-buffers)) (declaim (inline get-screen-width)) @@ -257,6 +259,7 @@ (declaim (inline clear-screen)) (defunct clear-screen (r g b) (u8 r u8 g u8 b) + (close-quads) (pal-ffi:gl-clear-color (/ r 255f0) (/ g 255f0) (/ b 255f0) @@ -286,11 +289,13 @@ (defunct push-clip (x y width height) (u16 x u16 y u16 width u16 height) + (close-quads) (pal-ffi:gl-scissor x y width height) (pal-ffi:gl-enable pal-ffi:+gl-scissor-test+) (push (vector x y width height) *clip-stack*)) (defun pop-clip () + (close-quads) (pop *clip-stack*) (if *clip-stack* (let ((r (first *clip-stack*))) @@ -302,9 +307,23 @@ ;; State + +(declaim (inline open-quads)) +(defun open-quads () + (unless *quads-open* + (pal-ffi:gl-begin pal-ffi:+gl-quads+) + (setf *quads-open* t))) + +(declaim (inline close-quads)) +(defun close-quads () + (when *quads-open* + (pal-ffi:gl-end) + (setf *quads-open* nil))) + (declaim (inline set-blend-mode)) (defunct set-blend-mode (mode) (symbol mode) + (close-quads) (case mode ((nil) (pal-ffi:gl-disable pal-ffi:+gl-blend+)) (:blend (pal-ffi:gl-enable pal-ffi:+gl-blend+) @@ -315,20 +334,24 @@ (declaim (inline rotate)) (defunct rotate (angle) (single-float angle) + (close-quads) (pal-ffi:gl-rotatef angle 0f0 0f0 1f0)) (declaim (inline scale)) (defunct scale (x y) (single-float x single-float y) + (close-quads) (pal-ffi:gl-scalef x y 1f0)) (declaim (inline translate)) (defunct translate (vec) (vec vec) + (close-quads) (pal-ffi:gl-translatef (vx vec) (vy vec) 0f0)) (declaim (inline reset-blend-mode)) (defun reset-blend-mode () + (close-quads) (set-blend-mode :blend) (set-blend-color 255 255 255 255)) @@ -341,12 +364,12 @@ (defunct set-image (image) (image image) (unless (eq image *current-image*) + (close-quads) (setf *current-image* image) (pal-ffi:gl-bind-texture pal-ffi:+gl-texture-2d+ (pal-ffi::image-texture image)))) - ;; Images (defun surface-get-pixel (image x y) @@ -385,6 +408,7 @@ (fourth pixel)))))) (defun image-from-fn (width height smoothp fn) + (close-quads) (let* ((mode pal-ffi:+gl-rgb+) (width (min 1024 width)) (height (min 1024 height)) @@ -452,6 +476,7 @@ (defunct screen-to-array (pos width height) (vec pos u16 width u16 height) + (close-quads) (let* ((x (truncate (vx pos))) (y (truncate (vy pos))) (rowsize (* width 4)) @@ -480,7 +505,6 @@ 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) (set-image image) @@ -514,17 +538,19 @@ (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))) + (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 (+ x width) y) + (pal-ffi:gl-vertex2f width y) (pal-ffi:gl-tex-coord2f tx2 ty2) - (pal-ffi:gl-vertex2f (+ x width) (+ y height)) + (pal-ffi:gl-vertex2f width height) (pal-ffi:gl-tex-coord2f 0f0 ty2) - (pal-ffi:gl-vertex2f x (+ y height))))))) + (pal-ffi:gl-vertex2f x height)))))) (defunct draw-image* (image from-pos to-pos width height) @@ -577,6 +603,7 @@ (declaim (inline draw-point)) (defunct draw-point (pos r g b a &key (size 1f0) smoothp) (vec pos u8 r u8 g u8 b u8 a single-float size boolean smoothp) + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (if smoothp @@ -607,6 +634,7 @@ (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) (t + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) (pal-ffi:gl-color4ub r g b a) @@ -617,6 +645,7 @@ (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size) (cond ((image-p fill) + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+)) (set-image fill) (pal-ffi:gl-color4ub r g b a) @@ -643,6 +672,7 @@ (dolist (p points) (pal-ffi:gl-vertex2f (vx p) (vy p)))))) (t + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (pal-ffi:gl-color4ub r g b a) (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+) @@ -653,6 +683,7 @@ (defunct draw-polygon* (points &key image tex-coords colors) (list points list tex-coords list colors (or boolean image) image) + (close-quads) (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+)) (cond ((and image tex-coords)

1 0

[pal-cvs] CVS pal/examples
by tneste 28 Jul '07

28 Jul '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv3114/examples Modified Files: hares.lisp Log Message: --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/21 16:34:16 1.4 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/28 13:13:17 1.5 @@ -71,11 +71,7 @@ (event-loop () - (draw-image* (tag 'bg) - (v 0 0) - (v 0 0) - (get-screen-width) - (get-screen-height)) + (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
by tneste 28 Jul '07

28 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv3114 Modified Files: changes.txt todo.txt Log Message: --- /project/pal/cvsroot/pal/changes.txt 2007/07/03 19:17:57 1.2 +++ /project/pal/cvsroot/pal/changes.txt 2007/07/28 13:13:15 1.3 @@ -1,3 +1,31 @@ +1.0, July 28 2007 + +- Numerous bugfixes and little improvements. + +- Much faster DRAW-TEXT. + +- Removed DRAW-QUAD in favour of DRAW-POLYGON* + +- Added ALIGN arguments to DRAW-IMAGE + +- DRAW-IMAGE-PART renamed to DRAW-IMAGE* + +- Added some examples. + +- Automatic coersion of numeric types. + +- RELT renamed to RANDOM-ELEMENT. + +- Added DRAW-ARROW, DRAW-CIRCLE, LOAD-IMAGE-TO-ARRAY, SCREEN-TO-ARRAY, IMAGE-FROM-FN. + +- Tag thunks must now return only objects of type RESOURCE. + +- Many small and not so small changes in the API. + +- Fixed problems loading the foreign .so's under Linux. + + + Release 3, July 3 2007 - Changed some of the parameters to sound functions. Volume is now defined as a --- /project/pal/cvsroot/pal/todo.txt 2007/07/27 20:12:14 1.14 +++ /project/pal/cvsroot/pal/todo.txt 2007/07/28 13:13:15 1.15 @@ -2,9 +2,7 @@ - Add align, scale and angle options to DRAW-IMAGE*. -- Implement image mirroring. - -- Image tiles and animation. +- Implement image mirroring, tiles and animation. - Add more complex sound/music handling functions, channel set volume/dir, fade/etc. music.

1 0

[pal-cvs] CVS pal
by tneste 28 Jul '07

28 Jul '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv15516 Modified Files: pal.lisp Log Message: Cleaned up and fixed SCREEN-TO-ARRAY --- /project/pal/cvsroot/pal/pal.lisp 2007/07/27 21:25:40 1.21 +++ /project/pal/cvsroot/pal/pal.lisp 2007/07/27 22:48:40 1.22 @@ -452,24 +452,32 @@ (defunct screen-to-array (pos width height) (vec pos u16 width u16 height) - (let ((array (make-array (list width height)))) - (cffi:with-foreign-object (image :unsigned-char (* width height 3)) - (pal-ffi:gl-read-pixels (truncate (vx pos)) - (- *height* (truncate (vy pos)) height) + (let* ((x (truncate (vx pos))) + (y (truncate (vy pos))) + (rowsize (* width 4)) + (array (make-array (list width height)))) + (cffi:with-foreign-object (image :unsigned-char (* (1+ width) (1+ height) 4)) + (pal-ffi:gl-read-pixels x + (- *height* y height) width height - pal-ffi:+gl-rgb+ pal-ffi:+gl-unsigned-byte+ + pal-ffi:+gl-rgba+ pal-ffi:+gl-unsigned-byte+ image) (do-n (x width y height) - (setf (aref array x (- height y 1)) - (list (cffi:mem-aref image :unsigned-char (+ (* y width 3) - (* x 3))) - (cffi:mem-aref image :unsigned-char (+ (* y width 3) - (* x 3) - 1)) - (cffi:mem-aref image :unsigned-char (+ (* y width 3) - (* x 3) - 2)) - 255))) + (let ((yrow (* y rowsize))) + (declare (type fixnum yrow)) + (setf (aref array x (- height y 1)) + (list (cffi:mem-aref image :unsigned-char (+ yrow + (* x 4) + 0)) + (cffi:mem-aref image :unsigned-char (+ yrow + (* x 4) + 1)) + (cffi:mem-aref image :unsigned-char (+ yrow + (* x 4) + 2)) + (cffi:mem-aref image :unsigned-char (+ yrow + (* x 4) + 3)))))) array))) @@ -596,10 +604,7 @@ (with-gl pal-ffi:+gl-line-loop+ (pal-ffi:gl-vertex2f (vx pos) (vy pos)) (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos)) - (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) (pal-ffi:gl-vertex2f (+ (vx pos) width) (+ (vy pos) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)) (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) (t (pal-ffi:gl-push-attrib (logior pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs July 2007