pal-cvs August 2007

pal-cvs@common-lisp.net

1 participants
6 discussions

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

30 Aug '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv18735 Modified Files: ffi.lisp pal.lisp Log Message: Fixed handling of texture sizes. Changed the application data folder on windows. --- /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 09:22:19 1.18 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 21:11:23 1.19 @@ -901,7 +901,7 @@ #+win32 (defun get-application-folder () (cffi:with-foreign-object (path :char 4096) - (shgetfolderpatha (cffi:null-pointer) #x001c (cffi:null-pointer) 0 path) + (shgetfolderpatha (cffi:null-pointer) #x001a (cffi:null-pointer) 0 path) (concatenate 'string (cffi:foreign-string-to-lisp path) "/"))) (cffi:defcfun "calloc" :pointer (nelem :uint) (elsize :uint)) --- /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:22:19 1.28 +++ /project/pal/cvsroot/pal/pal.lisp 2007/08/30 21:11:23 1.29 @@ -1,9 +1,7 @@ ;; Notes: -;; calculate circle segment count, add start/end args to draw-circle, use triangle-fan for circles -;; calculate max-texture-size -;; check for redundant close-quads, make sure rotations etc. are optimised. -;; newline support for draw-text -;; optimise gl state handling +;; add start/end args to draw-circle, use triangle-fan for circles +;; check for redundant close-quads, optimise rotations/offsets etc. in draw-image +;; newline support for draw-text, optimise gl state handling (declaim (optimize (speed 3) @@ -175,11 +173,11 @@ (declaim (inline key-pressed-p)) (defunct key-pressed-p (keysym) - (symbol keysym) + (symbol keysym) (gethash keysym *pressed-keys*)) (defunct keysym-char (keysym) - (symbol keysym) + (symbol keysym) (code-char (cffi:foreign-enum-value 'pal-ffi:sdl-key keysym))) (declaim (inline get-mouse-pos)) @@ -233,9 +231,9 @@ (if (or (eq t *cursor*) (eq nil *cursor*)) (when *messages* (with-default-settings - (draw-messages))) + (draw-messages))) (with-default-settings - (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) + (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) (draw-messages))) (close-quads) (pal-ffi:gl-swap-buffers) @@ -257,7 +255,7 @@ (declaim (inline clear-screen)) (defunct clear-screen (r g b) - (u8 r u8 g u8 b) + (u8 r u8 g u8 b) (close-quads) (pal-ffi:gl-clear-color (/ r 255f0) (/ g 255f0) @@ -266,7 +264,7 @@ (pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+)) (defunct set-mouse-pos (x y) - (u16 x u16 y) + (u16 x u16 y) (pal-ffi:warp-mouse x y) (setf *mouse-x* x *mouse-y* y)) @@ -287,7 +285,7 @@ image) (defunct push-clip (x y width height) - (u16 x u16 y u16 width u16 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+) @@ -321,7 +319,7 @@ (declaim (inline set-blend-mode)) (defunct set-blend-mode (mode) - (symbol mode) + (symbol mode) (close-quads) (case mode ((nil) (pal-ffi:gl-disable pal-ffi:+gl-blend+)) @@ -332,19 +330,19 @@ (declaim (inline rotate)) (defunct rotate (angle) - (single-float 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) + (single-float x single-float y) (close-quads) (pal-ffi:gl-scalef x y 1f0)) (declaim (inline translate)) (defunct translate (vec) - (vec vec) + (vec vec) (close-quads) (pal-ffi:gl-translatef (vx vec) (vy vec) 0f0)) @@ -356,12 +354,12 @@ (declaim (inline set-blend-color)) (defunct set-blend-color (r g b a) - (u8 r u8 g u8 b u8 a) + (u8 r u8 g u8 b u8 a) (pal-ffi:gl-color4ub r g b a)) (declaim (inline set-image)) (defunct set-image (image) - (image image) + (image image) (unless (eq image *current-image*) (close-quads) (setf *current-image* image) @@ -409,16 +407,12 @@ (defun image-from-fn (width height smoothp fn) (close-quads) (let* ((mode pal-ffi:+gl-rgb+) - (width (min 1024 width)) - (height (min 1024 height)) - (texture-width (expt 2 (or (find-if (lambda (x) - (> (expt 2 x) - (1- width))) - '(6 7 8 9 10)) 10))) - (texture-height (expt 2 (or (find-if (lambda (x) - (> (expt 2 x) - (1- height))) - '(6 7 8 9 10)) 10))) + (width (min *max-texture-size* width)) + (height (min *max-texture-size* height)) + (texture-width (expt 2 (ceiling (/ (log width) + (log 2))))) + (texture-height (expt 2 (ceiling (/ (log height) + (log 2))))) (id (cffi:foreign-alloc :uint :count 1))) (with-foreign-vector (tdata (* texture-width texture-height) 4) (do-n (x width y height) @@ -474,7 +468,7 @@ image)) (defunct screen-to-array (pos width height) - (vec pos u16 width u16 height) + (vec pos u16 width u16 height) (close-quads) (pal-ffi:gl-flush) (let* ((x (truncate (vx pos))) @@ -507,7 +501,7 @@ (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) + (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign) (set-image image) (let ((width (image-width image)) (height (image-height image)) @@ -555,7 +549,7 @@ (defunct draw-image* (image from-pos to-pos width height) - (image image vec from-pos vec to-pos u11 width u11 height) + (image image vec from-pos vec to-pos u11 width u11 height) (set-image image) (let* ((vx (vx from-pos)) (vy (vy from-pos)) @@ -579,33 +573,33 @@ (declaim (inline draw-line)) (defunct draw-line (la lb r g b a &key (size 1.0f0) (smoothp)) - (vec la vec lb single-float size u8 r u8 g u8 b u8 a boolean smoothp) + (vec la vec lb single-float size u8 r u8 g u8 b u8 a boolean smoothp) (with-line-settings smoothp size r g b a - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb))))) + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb))))) (declaim (inline draw-arrow)) (defunct draw-arrow (la lb r g b a &key (size 1.0f0) smoothp) - (vec la vec lb u8 r u8 g u8 b u8 a single-float size boolean smoothp) + (vec la vec lb u8 r u8 g u8 b u8 a single-float size boolean smoothp) (with-line-settings smoothp size r g b a - (let ((d (v* (v-direction la lb) (+ size 8f0)))) - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) - (vy (v+ lb (v-rotate d 140f0)))) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) - (vy (v+ lb (v-rotate d -140f0)))))))) + (let ((d (v* (v-direction la lb) (+ size 8f0)))) + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) + (vy (v+ lb (v-rotate d 140f0)))) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) + (vy (v+ lb (v-rotate d -140f0)))))))) (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) + (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+) @@ -619,7 +613,7 @@ (pal-ffi:gl-pop-attrib)) (defunct draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep smoothp) - (vec pos u16 width u16 height u8 r u8 g u8 b u8 a (or symbol image) fill single-float size boolean absolutep boolean smoothp) + (vec pos u16 width u16 height u8 r u8 g u8 b u8 a (or symbol image) fill single-float size boolean absolutep boolean smoothp) (cond ((image-p fill) (draw-polygon (list pos @@ -631,11 +625,11 @@ :absolutep absolutep)) ((eq nil fill) (with-line-settings smoothp size r g b a - (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) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) + (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) 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+)) @@ -645,7 +639,7 @@ (pal-ffi:gl-pop-attrib)))) (defunct draw-polygon (points r g b a &key (fill t) absolutep (size 1f0) smoothp) - (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size) + (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size) (cond ((image-p fill) (close-quads) @@ -671,9 +665,9 @@ (pal-ffi:gl-pop-attrib)) ((eq nil fill) (with-line-settings smoothp size r g b a - (with-gl pal-ffi:+gl-line-loop+ - (dolist (p points) - (pal-ffi:gl-vertex2f (vx p) (vy p)))))) + (with-gl pal-ffi:+gl-line-loop+ + (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+)) @@ -685,7 +679,7 @@ (pal-ffi:gl-pop-attrib)))) (defunct draw-polygon* (points &key image tex-coords colors) - (list points list tex-coords list colors (or boolean image) image) + (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 @@ -724,7 +718,7 @@ (pal-ffi:gl-pop-attrib)) (defunct draw-circle (pos radius r g b a &key (fill t) absolutep (size 1f0) smoothp (segments 30)) - (vec pos single-float radius u8 r u8 g u8 b u8 a (or image symbol) fill boolean absolutep single-float size boolean smoothp fixnum segments) + (vec pos single-float radius u8 r u8 g u8 b u8 a (or image symbol) fill boolean absolutep single-float size boolean smoothp fixnum segments) (declare (type vec pos) (type fixnum segments)) (draw-polygon (loop for a from 0 to (* 2 pi) by (/ (* 2 pi) segments) collecting (v+ pos @@ -841,7 +835,7 @@ (+ (glyph-width g) (glyph-xoff g)))) (defunct draw-text (text pos &optional font) - (vec pos simple-string text (or font boolean) font) + (vec pos simple-string text (or font boolean) font) (with-transformation (:pos pos) (let* ((dx 0f0) (font (if font @@ -856,13 +850,13 @@ (declaim (inline get-font-height)) (defunct get-font-height (&optional font) - ((or font boolean) font) + ((or font boolean) font) (pal-ffi:font-height (if font font (tag 'default-font)))) (defunct get-text-size (text &optional font) - ((or font boolean) font simple-string text) + ((or font boolean) font simple-string text) (values (let ((glyphs (pal-ffi:font-glyphs (if font font (tag 'default-font)))))

1 0

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

30 Aug '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv19772 Modified Files: ffi.lisp package.lisp pal.lisp Log Message: Added glFlush() in IMAGE-FROM-SCREEN --- /project/pal/cvsroot/pal/ffi.lisp 2007/08/15 14:36:21 1.17 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 09:22:19 1.18 @@ -718,6 +718,8 @@ (defconstant +gl-point-smooth+ #xB10) (defconstant +gl-point+ #x0) +(cffi:defcfun ("glFlush" gl-flush) :void) + (cffi:defcfun ("glAlphaFunc" gl-alpha-func) :void (func :int) (ref :float)) --- /project/pal/cvsroot/pal/package.lisp 2007/08/15 14:36:21 1.15 +++ /project/pal/cvsroot/pal/package.lisp 2007/08/30 09:22:19 1.16 @@ -6,6 +6,7 @@ #:+gl-line-smooth+ #:make-font #:+gl-pack-alignment+ + #:gl-flush #:gl-read-pixels #:gl-pixel-store #:+gl-scissor-test+ --- /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:02:24 1.27 +++ /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:22:19 1.28 @@ -175,11 +175,11 @@ (declaim (inline key-pressed-p)) (defunct key-pressed-p (keysym) - (symbol keysym) + (symbol keysym) (gethash keysym *pressed-keys*)) (defunct keysym-char (keysym) - (symbol keysym) + (symbol keysym) (code-char (cffi:foreign-enum-value 'pal-ffi:sdl-key keysym))) (declaim (inline get-mouse-pos)) @@ -215,7 +215,7 @@ (defun draw-messages () (let ((fh (get-font-height)) - (y 0)) + (y 0)) (declare (type u11 y fh)) (dolist (m *messages*) (declare (type simple-string m)) @@ -233,9 +233,9 @@ (if (or (eq t *cursor*) (eq nil *cursor*)) (when *messages* (with-default-settings - (draw-messages))) + (draw-messages))) (with-default-settings - (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) + (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) (draw-messages))) (close-quads) (pal-ffi:gl-swap-buffers) @@ -257,7 +257,7 @@ (declaim (inline clear-screen)) (defunct clear-screen (r g b) - (u8 r u8 g u8 b) + (u8 r u8 g u8 b) (close-quads) (pal-ffi:gl-clear-color (/ r 255f0) (/ g 255f0) @@ -266,7 +266,7 @@ (pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+)) (defunct set-mouse-pos (x y) - (u16 x u16 y) + (u16 x u16 y) (pal-ffi:warp-mouse x y) (setf *mouse-x* x *mouse-y* y)) @@ -287,7 +287,7 @@ image) (defunct push-clip (x y width height) - (u16 x u16 y u16 width u16 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+) @@ -321,7 +321,7 @@ (declaim (inline set-blend-mode)) (defunct set-blend-mode (mode) - (symbol mode) + (symbol mode) (close-quads) (case mode ((nil) (pal-ffi:gl-disable pal-ffi:+gl-blend+)) @@ -332,19 +332,19 @@ (declaim (inline rotate)) (defunct rotate (angle) - (single-float 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) + (single-float x single-float y) (close-quads) (pal-ffi:gl-scalef x y 1f0)) (declaim (inline translate)) (defunct translate (vec) - (vec vec) + (vec vec) (close-quads) (pal-ffi:gl-translatef (vx vec) (vy vec) 0f0)) @@ -356,12 +356,12 @@ (declaim (inline set-blend-color)) (defunct set-blend-color (r g b a) - (u8 r u8 g u8 b u8 a) + (u8 r u8 g u8 b u8 a) (pal-ffi:gl-color4ub r g b a)) (declaim (inline set-image)) (defunct set-image (image) - (image image) + (image image) (unless (eq image *current-image*) (close-quads) (setf *current-image* image) @@ -474,8 +474,9 @@ image)) (defunct screen-to-array (pos width height) - (vec pos u16 width u16 height) + (vec pos u16 width u16 height) (close-quads) + (pal-ffi:gl-flush) (let* ((x (truncate (vx pos))) (y (truncate (vy pos))) (rowsize (* width 4)) @@ -506,7 +507,7 @@ (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) + (image image vec pos (or boolean number) angle (or boolean number) scale symbol halign symbol valign) (set-image image) (let ((width (image-width image)) (height (image-height image)) @@ -554,7 +555,7 @@ (defunct draw-image* (image from-pos to-pos width height) - (image image vec from-pos vec to-pos u11 width u11 height) + (image image vec from-pos vec to-pos u11 width u11 height) (set-image image) (let* ((vx (vx from-pos)) (vy (vy from-pos)) @@ -578,33 +579,33 @@ (declaim (inline draw-line)) (defunct draw-line (la lb r g b a &key (size 1.0f0) (smoothp)) - (vec la vec lb single-float size u8 r u8 g u8 b u8 a boolean smoothp) + (vec la vec lb single-float size u8 r u8 g u8 b u8 a boolean smoothp) (with-line-settings smoothp size r g b a - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb))))) + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb))))) (declaim (inline draw-arrow)) (defunct draw-arrow (la lb r g b a &key (size 1.0f0) smoothp) - (vec la vec lb u8 r u8 g u8 b u8 a single-float size boolean smoothp) + (vec la vec lb u8 r u8 g u8 b u8 a single-float size boolean smoothp) (with-line-settings smoothp size r g b a - (let ((d (v* (v-direction la lb) (+ size 8f0)))) - (with-gl pal-ffi:+gl-lines+ - (pal-ffi:gl-vertex2f (vx la) (vy la)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) - (vy (v+ lb (v-rotate d 140f0)))) - (pal-ffi:gl-vertex2f (vx lb) (vy lb)) - (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) - (vy (v+ lb (v-rotate d -140f0)))))))) + (let ((d (v* (v-direction la lb) (+ size 8f0)))) + (with-gl pal-ffi:+gl-lines+ + (pal-ffi:gl-vertex2f (vx la) (vy la)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d 140f0))) + (vy (v+ lb (v-rotate d 140f0)))) + (pal-ffi:gl-vertex2f (vx lb) (vy lb)) + (pal-ffi:gl-vertex2f (vx (v+ lb (v-rotate d -140f0))) + (vy (v+ lb (v-rotate d -140f0)))))))) (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) + (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+) @@ -618,7 +619,7 @@ (pal-ffi:gl-pop-attrib)) (defunct draw-rectangle (pos width height r g b a &key (fill t) (size 1f0) absolutep smoothp) - (vec pos u16 width u16 height u8 r u8 g u8 b u8 a (or symbol image) fill single-float size boolean absolutep boolean smoothp) + (vec pos u16 width u16 height u8 r u8 g u8 b u8 a (or symbol image) fill single-float size boolean absolutep boolean smoothp) (cond ((image-p fill) (draw-polygon (list pos @@ -630,11 +631,11 @@ :absolutep absolutep)) ((eq nil fill) (with-line-settings smoothp size r g b a - (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) height)) - (pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))) + (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) 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+)) @@ -644,7 +645,7 @@ (pal-ffi:gl-pop-attrib)))) (defunct draw-polygon (points r g b a &key (fill t) absolutep (size 1f0) smoothp) - (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size) + (list points u8 r u8 g u8 b u8 a (or image boolean) fill single-float size) (cond ((image-p fill) (close-quads) @@ -670,9 +671,9 @@ (pal-ffi:gl-pop-attrib)) ((eq nil fill) (with-line-settings smoothp size r g b a - (with-gl pal-ffi:+gl-line-loop+ - (dolist (p points) - (pal-ffi:gl-vertex2f (vx p) (vy p)))))) + (with-gl pal-ffi:+gl-line-loop+ + (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+)) @@ -684,7 +685,7 @@ (pal-ffi:gl-pop-attrib)))) (defunct draw-polygon* (points &key image tex-coords colors) - (list points list tex-coords list colors (or boolean image) image) + (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 @@ -723,7 +724,7 @@ (pal-ffi:gl-pop-attrib)) (defunct draw-circle (pos radius r g b a &key (fill t) absolutep (size 1f0) smoothp (segments 30)) - (vec pos single-float radius u8 r u8 g u8 b u8 a (or image symbol) fill boolean absolutep single-float size boolean smoothp fixnum segments) + (vec pos single-float radius u8 r u8 g u8 b u8 a (or image symbol) fill boolean absolutep single-float size boolean smoothp fixnum segments) (declare (type vec pos) (type fixnum segments)) (draw-polygon (loop for a from 0 to (* 2 pi) by (/ (* 2 pi) segments) collecting (v+ pos @@ -840,7 +841,7 @@ (+ (glyph-width g) (glyph-xoff g)))) (defunct draw-text (text pos &optional font) - (vec pos simple-string text (or font boolean) font) + (vec pos simple-string text (or font boolean) font) (with-transformation (:pos pos) (let* ((dx 0f0) (font (if font @@ -855,13 +856,13 @@ (declaim (inline get-font-height)) (defunct get-font-height (&optional font) - ((or font boolean) font) + ((or font boolean) font) (pal-ffi:font-height (if font font (tag 'default-font)))) (defunct get-text-size (text &optional font) - ((or font boolean) font simple-string text) + ((or font boolean) font simple-string text) (values (let ((glyphs (pal-ffi:font-glyphs (if font font (tag 'default-font)))))

1 0

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

30 Aug '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv16401 Modified Files: pal.lisp todo.txt Log Message: Improved FPS limiter --- /project/pal/cvsroot/pal/pal.lisp 2007/08/15 14:36:21 1.26 +++ /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:02:24 1.27 @@ -1,7 +1,6 @@ ;; Notes: -;; smoothed polygons, guess circle segment count, add start/end args to draw-circle, use triangle-fan +;; calculate circle segment count, add start/end args to draw-circle, use triangle-fan for circles ;; calculate max-texture-size -;; fix the fps ;; check for redundant close-quads, make sure rotations etc. are optimised. ;; newline support for draw-text ;; optimise gl state handling @@ -225,10 +224,10 @@ (defun update-screen () (setf *new-fps* (max 1 (the fixnum (- (pal-ffi:get-tick) *ticks*)))) (setf *fps* (truncate (+ *fps* *new-fps*) 2)) - (if (> *delay* 1) + (if (> *delay* 0) (decf *delay*)) (when (< *fps* *max-fps*) - (incf *delay* 2)) + (incf *delay* (- *max-fps* *fps*))) (setf *ticks* (pal-ffi:get-tick)) (pal-ffi:delay *delay*) (if (or (eq t *cursor*) (eq nil *cursor*)) --- /project/pal/cvsroot/pal/todo.txt 2007/08/15 14:36:21 1.16 +++ /project/pal/cvsroot/pal/todo.txt 2007/08/30 09:02:24 1.17 @@ -9,8 +9,6 @@ - Box/box/line/circle etc. overlap functions, faster v-dist. -- Fix the FPS limiter, the results could be a lot smoother. - - Correct aspect ratio when fullscreen on widescreen displays. - I would really like to see it run on OS X.

1 0

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

30 Aug '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv16401/examples Modified Files: hares.lisp teddy.lisp Log Message: Improved FPS limiter --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/08/15 14:36:21 1.8 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/08/30 09:02:23 1.9 @@ -84,4 +84,4 @@ (draw-fps)))) -;; (example) +;; (example) \ No newline at end of file --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/08/15 14:36:21 1.8 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/08/30 09:02:23 1.9 @@ -93,7 +93,7 @@ (set-cursor (tag 'cursor) (v 18 18)) (play-music (tag 'music)) - (play-sample (tag 'engine) :loops t :volume 30) + (play-sample (tag 'engine) :loops t :volume 50) (make-instance 'plane :alt 20) (dotimes (i 20)

1 0

[pal-cvs] CVS pal/examples
by tneste 15 Aug '07

15 Aug '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv13046/examples Modified Files: hares.lisp teddy.lisp Log Message: Minor fixes. Added HANDLE-EVENTS --- /project/pal/cvsroot/pal/examples/hares.lisp 2007/07/30 10:38:11 1.7 +++ /project/pal/cvsroot/pal/examples/hares.lisp 2007/08/15 14:36:21 1.8 @@ -70,7 +70,7 @@ :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*) @@ -84,4 +84,4 @@ (draw-fps)))) -;; (example) \ No newline at end of file +;; (example) --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/07/29 21:55:23 1.7 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/08/15 14:36:21 1.8 @@ -88,7 +88,6 @@ (setf *sprites* nil) - ;; Hide the mouse cursor and use cursor.png instead. 18,18 is the offset ("hotspot") for the cursor image ;; Other possible options to cursor are: t - show the default cursor, nil - hide all cursors (set-cursor (tag 'cursor) (v 18 18))

1 0

[pal-cvs] CVS pal
by tneste 15 Aug '07

15 Aug '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13046 Modified Files: ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt vector.lisp Log Message: Minor fixes. Added HANDLE-EVENTS --- /project/pal/cvsroot/pal/ffi.lisp 2007/07/30 10:38:12 1.16 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/08/15 14:36:21 1.17 @@ -1,5 +1,5 @@ (declaim (optimize (speed 3) - (safety 0))) + (safety 1))) (in-package :pal-ffi) @@ -456,42 +456,67 @@ (defgeneric register-resource (resource)) (defgeneric free-resource (resource)) +(defgeneric holdsp (holder resource)) + + + +(defmethod holdsp (holder resource) + nil) + +(defun heldp (resource) + (find-if (lambda (holder) (holdsp holder resource)) *resources*)) (defmethod register-resource (resource) (assert (resource-p resource)) (push resource *resources*) resource) -(defmethod free-resource :before (resource) - (assert (typep resource 'resource))) -(defmethod free-resource :after (resource) - (pal::reset-tags :resource resource) - (setf *resources* (remove resource *resources*))) + +(defmethod free-resource :around (resource) + (assert (typep resource 'resource)) + (when (and (not (heldp resource)) (find resource *resources*)) + (call-next-method) + (pal::reset-tags :resource resource) + (setf *resources* (remove resource *resources*)))) + + (defmethod free-resource ((resource music)) - (when (music-music resource) - (free-music (music-music resource)) - (setf (music-music resource) nil))) + (assert (music-music resource)) + (free-music (music-music resource)) + (setf (music-music resource) nil)) + + (defmethod free-resource ((resource font)) - (when (font-image resource) - (free-resource (font-image resource)) - (setf (font-image resource) nil))) + (assert (font-image resource)) + (let ((image (font-image resource))) + (setf (font-image resource) nil) + (free-resource image))) + +(defmethod holdsp ((font font) (image image)) + (eq (font-image font) image)) + + (defmethod free-resource ((resource image)) - (when (> (image-texture resource) 0) - (gl-delete-texture (image-texture resource)) - (setf (image-texture resource) 0))) + (assert (> (image-texture resource) 0)) + (gl-delete-texture (image-texture resource)) + (setf (image-texture resource) 0)) + + (defmethod free-resource ((resource sample)) - (when (sample-chunk resource) - (free-chunk (sample-chunk resource)) - (setf (sample-chunk resource) nil))) + (assert (sample-chunk resource)) + (free-chunk (sample-chunk resource)) + (setf (sample-chunk resource) nil)) + + (defun free-all-resources () - (dolist (r *resources*) - (free-resource r)) + (loop while *resources* do + (free-resource (first *resources*))) (assert (null *resources*))) --- /project/pal/cvsroot/pal/package.lisp 2007/07/29 21:53:52 1.14 +++ /project/pal/cvsroot/pal/package.lisp 2007/08/15 14:36:21 1.15 @@ -367,6 +367,7 @@ #:free-resource #:free-all-resources #:define-tags + #:add-tag #:tag #:sample #:music @@ -386,6 +387,7 @@ #:do-n #:curry + #:handle-events #:key-pressed-p #:keysym-char #:test-keys --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/30 10:38:12 1.12 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/08/15 14:36:21 1.13 @@ -1,5 +1,5 @@ (declaim (optimize (speed 3) - (safety 2))) + (safety 1))) (in-package :pal) @@ -9,10 +9,15 @@ (defmacro define-tags (&body tags) `(progn ,@(mapcar (lambda (r) - `(setf (gethash ',(first r) *tags*) - (cons (lambda () ,(second r)) nil))) + `(add-tag ',(first r) (lambda () ,(second r)))) (loop for (a b) on tags by #'cddr collect (list a b))))) + +(defun add-tag (tag fn) + (assert (and (symbolp tag) (functionp fn))) + (setf (gethash tag *tags*) + (cons fn nil))) + (defun reset-tags (&key resource) (maphash (if resource (lambda (k v) @@ -61,7 +66,7 @@ (declare ,@decls) ,@body)))) - +;; (declaim (ftype (function (double-float double-float) double-float) sss)) (defmacro with-resource ((resource init-form) &body body) `(let ((,resource ,init-form)) @@ -170,6 +175,7 @@ (declaim (inline funcall?)) (defun funcall? (fn &rest args) + (declare (type (or function symbol) fn) (dynamic-extent args)) (if (null fn) nil (apply fn args))) --- /project/pal/cvsroot/pal/pal.lisp 2007/07/30 10:38:12 1.25 +++ /project/pal/cvsroot/pal/pal.lisp 2007/08/15 14:36:21 1.26 @@ -2,13 +2,13 @@ ;; 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. ;; newline support for draw-text +;; optimise gl state handling (declaim (optimize (speed 3) - (safety 2))) + (safety 1))) (in-package :pal) @@ -62,7 +62,6 @@ (pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 0 2048) (pal-ffi:gl-set-attribute pal-ffi:+gl-depth-size+ 0) (pal-ffi:gl-set-attribute pal-ffi:+gl-doublebuffer+ 1) - (pal-ffi:gl-pixel-store pal-ffi:+gl-pack-alignment+ 1) (let ((surface (pal-ffi::set-video-mode width height @@ -104,6 +103,7 @@ (pal-ffi:gl-ortho 0d0 (coerce *width* 'double-float) (coerce *height* 'double-float) 0d0 -1d0 1d0) (pal-ffi:gl-matrix-mode pal-ffi:+gl-modelview+) (pal-ffi:gl-load-identity) + (pal-ffi:gl-pixel-store pal-ffi:+gl-pack-alignment+ 1) (clear-screen 0 0 0) (reset-tags) (define-tags default-font (load-font "default-font")) @@ -195,7 +195,7 @@ (defun get-mouse-y () *mouse-y*) -(defun dispatch-event (&key key-up-fn key-down-fn mouse-motion-fn quit-fn) +(defun handle-events (&key key-up-fn key-down-fn mouse-motion-fn quit-fn) (block event-loop (cffi:with-foreign-object (event :char 500) (do-event event key-up-fn key-down-fn mouse-motion-fn quit-fn)))) @@ -214,20 +214,15 @@ ;; Screen -(declaim (inline draw-messages)) (defun draw-messages () - (let ((y 0) - (fh (get-font-height))) + (let ((fh (get-font-height)) + (y 0)) (declare (type u11 y fh)) (dolist (m *messages*) (declare (type simple-string m)) (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) @@ -243,7 +238,11 @@ (with-default-settings (draw-image *cursor* (v- (get-mouse-pos) *cursor-offset*)) (draw-messages))) - (pal-ffi:gl-swap-buffers)) + (close-quads) + (pal-ffi:gl-swap-buffers) + (let ((e (pal-ffi:gl-get-error))) + (unless (= e 0) + (error "GL error ~a" e)))) (declaim (inline get-screen-width)) (defun get-screen-width () @@ -879,5 +878,5 @@ (defun message (object) (setf *messages* (append *messages* (list (prin1-to-string object)))) - (when (> (length *messages*) (- (truncate (get-screen-height) (get-font-height)) 2)) + (when (> (length *messages*) (- (truncate (get-screen-height) (get-font-height)) 1)) (pop *messages*))) \ No newline at end of file --- /project/pal/cvsroot/pal/todo.txt 2007/07/28 13:13:15 1.15 +++ /project/pal/cvsroot/pal/todo.txt 2007/08/15 14:36:21 1.16 @@ -9,8 +9,6 @@ - Box/box/line/circle etc. overlap functions, faster v-dist. -- Improved texture handling. - - Fix the FPS limiter, the results could be a lot smoother. - Correct aspect ratio when fullscreen on widescreen displays. --- /project/pal/cvsroot/pal/vector.lisp 2007/07/30 10:38:12 1.7 +++ /project/pal/cvsroot/pal/vector.lisp 2007/08/15 14:36:21 1.8 @@ -1,5 +1,5 @@ (declaim (optimize (speed 3) - (safety 2))) + (safety 1))) (in-package :pal)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs August 2007