pal-cvs

pal-cvs@common-lisp.net

127 discussions

[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
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

[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 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/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-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
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

← Newer
1
...
5
6
7
8
9
10
11
12
13
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs