pal-cvs

pal-cvs@common-lisp.net

127 discussions

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

15 Oct '07

Update of /project/pal/cvsroot/pal-gui/examples In directory clnet:/tmp/cvs-serv26366/examples Added Files: test.lisp Log Message: Project created. --- /project/pal/cvsroot/pal-gui/examples/test.lisp 2007/10/15 19:14:36 NONE +++ /project/pal/cvsroot/pal-gui/examples/test.lisp 2007/10/15 19:14:36 1.1 (in-package :pal-gui) (define-tags plane (load-image "lego-plane.png") tile (load-image "ground.png")) (defun test () (with-gui (:paths (merge-pathnames "examples/" pal::*pal-directory*)) (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200)) (slider (make-instance 'v-slider :pos (v 250 20) :height 150 :parent window :max-value 200 :page-size 100)) (meter (make-instance 'h-meter :pos (v 30 50) :width 150 :parent window :max-value 80 :display-fn (lambda (v) (format nil "FPS: ~a" v)))) (gauge (make-instance 'h-gauge :pos (v 30 20) :width 150 :parent window :min-value 0 :max-value 255 :value 0 :display-fn (lambda (v) (format nil "R: ~a" v)))) (button (make-instance 'button :pos (v 100 100) :value "FooBar!" :parent window))) (gui-loop () (setf (value-of button) (value-of slider)) (setf (value-of meter) (get-fps)) (draw-image* (tag 'tile) (v 0 0) (v 0 0) 800 600) (with-blend (:color (list (value-of gauge) 0 0 64)) (draw-image (tag 'plane) (v 320 220))) (draw-image (tag 'plane) (v 300 200)))))) ;; (test)

1 0

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

15 Oct '07

Update of /project/pal/cvsroot/pal-gui/examples In directory clnet:/tmp/cvs-serv26339/examples Log Message: Directory /project/pal/cvsroot/pal-gui/examples added to the repository

1 0

[pal-cvs] CVS pal-gui
by tneste 15 Oct '07

15 Oct '07

Update of /project/pal/cvsroot/pal-gui In directory clnet:/tmp/cvs-serv26295 Log Message: Status: Vendor Tag: tcvs-vendor Release Tags: tcvs-release No conflicts created by this import

1 0

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

15 Oct '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv26106 Added Files: ground.png Log Message:

1 0

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

15 Oct '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv25911 Modified Files: default-font.fnt default-font.png pal.lisp Log Message: --- /project/pal/cvsroot/pal/default-font.fnt 2007/06/28 20:14:05 1.1 +++ /project/pal/cvsroot/pal/default-font.fnt 2007/10/15 19:04:55 1.2 @@ -2,98 +2,98 @@ Bitmap=default-font.png -Char=" ",1,1,3,13,-1,2 -Char="!",5,1,4,13,1,0 -Char=""",10,1,5,13,0,1 -Char="#",16,1,10,13,0,-1 -Char="$",27,1,9,13,-1,0 -Char="%",37,1,12,13,0,-1 -Char="&",50,1,10,13,0,0 -Char="'",61,1,3,13,0,0 -Char="(",65,1,5,13,0,0 -Char=")",71,1,5,13,0,0 -Char="*",77,1,7,13,-1,0 -Char="+",85,1,9,13,0,0 -Char=",",95,1,5,13,-1,0 -Char="-",101,1,5,13,0,0 -Char=".",107,1,4,13,0,0 -Char="/",112,1,6,13,-1,-1 -Char="0",1,15,8,13,0,0 -Char="1",10,15,8,13,0,0 -Char="2",19,15,8,13,0,0 -Char="3",28,15,8,13,0,0 -Char="4",37,15,9,13,0,-1 -Char="5",47,15,8,13,0,0 -Char="6",56,15,8,13,0,0 -Char="7",65,15,8,13,0,0 -Char="8",74,15,8,13,0,0 -Char="9",83,15,8,13,0,0 -Char=":",92,15,4,13,0,0 -Char=";",97,15,5,13,-1,0 -Char="<",103,15,9,13,0,0 -Char="=",113,15,9,13,0,0 -Char=">",1,29,9,13,0,0 -Char="?",11,29,7,13,0,-1 -Char="@",19,29,12,13,0,-1 -Char="A",32,29,10,13,-1,-1 -Char="B",43,29,9,13,0,0 -Char="C",53,29,9,13,0,0 -Char="D",63,29,9,13,0,0 -Char="E",73,29,8,13,0,0 -Char="F",82,29,8,13,0,0 -Char="G",91,29,9,13,0,0 -Char="H",101,29,9,13,0,0 -Char="I",111,29,4,13,0,0 -Char="J",116,29,6,13,-2,0 -Char="K",1,43,10,13,0,-1 -Char="L",12,43,8,13,0,-1 -Char="M",21,43,11,13,0,0 -Char="N",33,43,9,13,0,0 -Char="O",43,43,10,13,0,0 -Char="P",54,43,9,13,0,-1 -Char="Q",64,43,10,13,0,0 -Char="R",75,43,9,13,0,-1 -Char="S",85,43,8,13,0,0 -Char="T",94,43,10,13,-1,-1 -Char="U",105,43,9,13,0,0 -Char="V",115,43,10,13,-1,-1 -Char="W",1,57,13,13,0,0 -Char="X",15,57,10,13,-1,-1 -Char="Y",26,57,10,13,-1,-1 -Char="Z",37,57,9,13,0,-1 -Char="[",47,57,6,13,0,-1 -Char="\",54,57,6,13,-1,-1 -Char="]",61,57,6,13,-1,0 -Char="^",68,57,9,13,0,0 -Char="_",78,57,8,13,-1,-1 -Char="`",87,57,5,13,0,1 -Char="a",93,57,8,13,0,0 -Char="b",102,57,8,13,0,0 -Char="c",111,57,7,13,0,0 -Char="d",1,71,8,13,0,0 -Char="e",10,71,8,13,0,0 -Char="f",19,71,7,13,-1,-1 -Char="g",27,71,8,13,0,0 -Char="h",36,71,8,13,0,0 -Char="i",45,71,4,13,0,0 -Char="j",50,71,5,13,-1,0 -Char="k",56,71,9,13,0,-2 -Char="l",66,71,4,13,0,0 -Char="m",71,71,12,13,0,-1 -Char="n",84,71,8,13,0,0 -Char="o",93,71,8,13,0,0 -Char="p",102,71,8,13,0,0 -Char="q",111,71,8,13,0,0 -Char="r",120,71,6,13,0,-1 -Char="s",1,85,7,13,0,0 -Char="t",9,85,7,13,-1,-1 -Char="u",17,85,8,13,0,0 -Char="v",26,85,9,13,-1,-1 -Char="w",36,85,11,13,0,0 -Char="x",48,85,9,13,-1,-1 -Char="y",58,85,9,13,-1,-1 -Char="z",68,85,7,13,0,0 -Char="{",76,85,8,13,0,0 -Char="|",85,85,3,13,0,1 -Char="}",89,85,8,13,0,0 -Char="~",98,85,9,13,0,0 +Char=" ",1,1,3,15,-1,1 +Char="!",5,1,3,15,0,0 +Char=""",9,1,5,15,-1,0 +Char="#",15,1,9,15,-1,-1 +Char="$",25,1,7,15,0,0 +Char="%",33,1,11,15,0,0 +Char="&",45,1,9,15,0,-1 +Char="'",55,1,3,15,0,-1 +Char="(",59,1,5,15,0,-1 +Char=")",65,1,5,15,-1,0 +Char="*",71,1,7,15,-1,-1 +Char="+",79,1,7,15,0,0 +Char=",",87,1,3,15,0,0 +Char="-",91,1,5,15,-1,0 +Char=".",97,1,3,15,0,0 +Char="/",101,1,5,15,-1,-1 +Char="0",107,1,7,15,0,0 +Char="1",115,1,5,15,0,2 +Char="2",1,17,7,15,0,0 +Char="3",9,17,7,15,0,0 +Char="4",17,17,7,15,0,0 +Char="5",25,17,7,15,0,0 +Char="6",33,17,7,15,0,0 +Char="7",41,17,7,15,0,0 +Char="8",49,17,7,15,0,0 +Char="9",57,17,7,15,0,0 +Char=":",65,17,3,15,0,0 +Char=";",69,17,3,15,0,0 +Char="<",73,17,7,15,0,0 +Char="=",81,17,8,15,-1,0 +Char=">",90,17,7,15,0,0 +Char="?",98,17,7,15,0,0 +Char="@",106,17,13,15,0,-1 +Char="A",1,33,9,15,-1,-1 +Char="B",11,33,8,15,0,0 +Char="C",20,33,9,15,0,0 +Char="D",30,33,9,15,0,0 +Char="E",40,33,8,15,0,0 +Char="F",49,33,7,15,0,0 +Char="G",57,33,9,15,0,0 +Char="H",67,33,9,15,0,0 +Char="I",77,33,3,15,0,0 +Char="J",81,33,7,15,-1,0 +Char="K",89,33,9,15,0,-1 +Char="L",99,33,8,15,0,-1 +Char="M",108,33,9,15,0,0 +Char="N",1,49,9,15,0,0 +Char="O",11,49,9,15,0,0 +Char="P",21,49,8,15,0,0 +Char="Q",30,49,9,15,0,0 +Char="R",40,49,9,15,0,0 +Char="S",50,49,8,15,0,0 +Char="T",59,49,9,15,-1,-1 +Char="U",69,49,9,15,0,0 +Char="V",79,49,9,15,-1,-1 +Char="W",89,49,13,15,-1,-1 +Char="X",103,49,9,15,-1,-1 +Char="Y",113,49,9,15,-1,-1 +Char="Z",1,65,9,15,-1,-1 +Char="[",11,65,4,15,0,-1 +Char="\",16,65,5,15,-1,-1 +Char="]",22,65,4,15,-1,0 +Char="^",27,65,7,15,-1,-1 +Char="_",35,65,9,15,-1,-1 +Char="`",45,65,4,15,0,0 +Char="a",50,65,7,15,0,0 +Char="b",58,65,7,15,0,0 +Char="c",66,65,6,15,0,0 +Char="d",73,65,7,15,0,0 +Char="e",81,65,7,15,0,0 +Char="f",89,65,6,15,-1,-2 +Char="g",96,65,7,15,0,0 +Char="h",104,65,7,15,0,0 +Char="i",112,65,3,15,0,0 +Char="j",116,65,5,15,-2,0 +Char="k",1,81,7,15,0,-1 +Char="l",9,81,3,15,0,0 +Char="m",13,81,11,15,0,0 +Char="n",25,81,7,15,0,0 +Char="o",33,81,7,15,0,0 +Char="p",41,81,7,15,0,0 +Char="q",49,81,7,15,0,0 +Char="r",57,81,5,15,0,-1 +Char="s",63,81,7,15,0,0 +Char="t",71,81,5,15,-1,-1 +Char="u",77,81,7,15,0,0 +Char="v",85,81,7,15,-1,-1 +Char="w",93,81,11,15,-1,-1 +Char="x",105,81,7,15,-1,-1 +Char="y",113,81,7,15,-1,-1 +Char="z",1,97,7,15,-1,-1 +Char="{",9,97,5,15,-1,0 +Char="|",15,97,3,15,0,0 +Char="}",19,97,5,15,0,-1 +Char="~",25,97,8,15,0,-1 Binary files /project/pal/cvsroot/pal/default-font.png 2007/06/28 20:14:05 1.1 and /project/pal/cvsroot/pal/default-font.png 2007/10/15 19:04:55 1.2 differ --- /project/pal/cvsroot/pal/pal.lisp 2007/10/11 19:26:23 1.31 +++ /project/pal/cvsroot/pal/pal.lisp 2007/10/15 19:04:55 1.32 @@ -728,7 +728,8 @@ (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

1 0

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

15 Oct '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv25911/examples Removed Files: ground.png Log Message:

1 0

[pal-cvs] CVS pal
by tneste 11 Oct '07

11 Oct '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13992 Modified Files: ffi.lisp pal-macros.lisp pal.lisp vector.lisp Log Message: Added some comments and docstrings. --- /project/pal/cvsroot/pal/ffi.lisp 2007/09/07 07:55:16 1.20 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/10/11 19:26:23 1.21 @@ -21,9 +21,10 @@ (:unix (:or "libGL.so"))) #+win32 (cffi:define-foreign-library shell32 - (:windows "shell32.dll")) + (:windows "shell32.dll")) ;; We use a function from shell32.dll to find the users application data directory. (defun load-foreign-libraries () + "Load all the foreing libs. Useful when dumping and restarting images with CLisp." (cffi:use-foreign-library sdl) (cffi:use-foreign-library sdl-mixer) (cffi:use-foreign-library sdl-image) @@ -38,6 +39,9 @@ (deftype u16 () '(unsigned-byte 16)) + +;; Basic SDL ffi definitions + (defconstant +init-audio+ #x00000010) (defconstant +init-video+ #x00000020) (defconstant +fullscreen+ #x80000000) @@ -168,6 +172,9 @@ (defconstant +resize-event+ 16) (defconstant +expose-event+ 17) + +;; Keycodes used by PAL. +;; In addition to these :KEY-MOUSE-n are used for mousekeys. (cffi:defcenum sdl-key (:key-unknown 0) (:key-first 0) @@ -424,16 +431,17 @@ ;; Resources -(defvar *resources* ()) + +(defvar *resources* () "List of currently loaded resources.") (defstruct image - (texture 0 :type u11) - (texture-width 0 :type u11) - (texture-height 0 :type u11) - (tx2 0 :type single-float) - (ty2 0 :type single-float) - (height 0 :type u11) - (width 0 :type u11)) + (texture 0 :type u11) ; "GL texture id for image." + (texture-width 0 :type u11) ; "Actual (rounded up to power of two) width of texture." + (texture-height 0 :type u11) ; "Actual (rounded up to power of two) height of texture." + (tx2 0 :type single-float) ; "tx2 = width / texture-width" + (ty2 0 :type single-float) ; "ty2 = height / texture-width" + (height 0 :type u11) ; "Height of textures visible part." + (width 0 :type u11)) ; "Width of textures visible part." (defstruct font (image nil :type (or boolean image)) @@ -454,8 +462,13 @@ -(defgeneric register-resource (resource)) -(defgeneric free-resource (resource)) +(defgeneric register-resource (resource) + (:documentation "Add RESOURCE to *RESOURCES*")) + +;; NOTE: Does not free the resource if it is held by some other resource. +(defgeneric free-resource (resource) + (:documentation "Free the RESOURCE and all system resources used by it. Also resets the TAGs related to the resource.")) + (defgeneric holdsp (holder resource)) @@ -496,7 +509,7 @@ (free-resource image))) (defmethod holdsp ((font font) (image image)) - (eq (font-image font) image)) + (eq (font-image font) image)) ;; Font resources need to hold the image they are using for the glyphs. @@ -515,12 +528,13 @@ (defun free-all-resources () + "Free all loaded resources and reset the TAGS" (loop while *resources* do (free-resource (first *resources*))) (assert (null *resources*))) -;; Main SDL +;; Main SDL functions (cffi:defcfun ("SDL_Init" init) :int (flags :uint)) @@ -903,6 +917,7 @@ (value :int)) +;; Used to get the application data folder. #+win32 (cffi:defcfun "SHGetFolderPathA" :int (owner :pointer) (folder :int) (handle :pointer) (flags :int) (path :pointer)) #+win32 (defun get-application-folder () @@ -910,5 +925,9 @@ (shgetfolderpatha (cffi:null-pointer) #x001a (cffi:null-pointer) 0 path) (concatenate 'string (cffi:foreign-string-to-lisp path) "/"))) + +;; Used to allocate zeroed memory. (cffi:defcfun "calloc" :pointer (nelem :uint) (elsize :uint)) + +;; Can we just use cffi:foreign-free? Just in case... (cffi:defcfun "free" :void (ptr :pointer)) \ No newline at end of file --- /project/pal/cvsroot/pal/pal-macros.lisp 2007/08/15 14:36:21 1.13 +++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/10/11 19:26:23 1.14 @@ -4,7 +4,13 @@ (in-package :pal) -(defvar *tags* (make-hash-table :test 'eq)) +;; TAGs are lazily evaluated thunks that load some resource (image, font etc.) when called with (TAG tag-name). +;; Their values are cached and automatically cleaned when resource is freed. +;; NOTE: Once defined the TAG definitions persist thru the whole Lisp session. Only the result values get initialized. + + +(defvar *tags* (make-hash-table :test 'eq) + "*TAGS* is a hashtable of TAG-NAME -> (FUNCTION . RESOURCE) we use to hold TAGS.") (defmacro define-tags (&body tags) `(progn @@ -18,6 +24,8 @@ (setf (gethash tag *tags*) (cons fn nil))) + +;; Clean all the values from tag table. Internal use only! (defun reset-tags (&key resource) (maphash (if resource (lambda (k v) @@ -29,6 +37,8 @@ (setf (cdr v) nil))) *tags*)) + + (defun tag (name) (declare (type symbol name)) (let ((resource (gethash name *tags*))) @@ -49,6 +59,7 @@ (float `(coerce ,value 'float))))) +;; Messy. Like DEFUN but automatically coerce some types (defined up there -^ ) and declare their types. (defmacro defunct (name lambda-list declarations &body body) (let* ((decls (loop for (a b) on declarations by #'cddr collecting `(type ,a ,b))) @@ -66,9 +77,10 @@ (declare ,@decls) ,@body)))) -;; (declaim (ftype (function (double-float double-float) double-float) sss)) + (defmacro with-resource ((resource init-form) &body body) + "Bind the result of INIT-FORM to RESOURCE, evaluate the BODY and free the RESOURCE." `(let ((,resource ,init-form)) (prog1 (progn ,@body) @@ -76,6 +88,7 @@ (defmacro with-default-settings (&body body) + "Evaluate BODY with default transformations and blend settings." `(with-transformation () (with-blend (:mode :blend :color '(255 255 255 255)) (pal-ffi:gl-load-identity) @@ -83,6 +96,7 @@ (defmacro with-blend ((&key (mode t) color) &body body) + "Evaluate BODY with blend options set to MODE and COLOR. Color is a list of (r g b a) values." `(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+)) @@ -96,6 +110,7 @@ (pal-ffi:gl-pop-attrib)))) (defmacro with-clipping ((x y width height) &body body) + "Evaluate BODY with clipping. Only the window area defined by X, Y, WIDTH and HEIGHT is affected by drawing primitives." `(progn (push-clip ,x ,y ,width ,height) (prog1 (progn @@ -103,6 +118,7 @@ (pop-clip)))) (defmacro with-transformation ((&key pos angle scale) &body body) + "Evaluate BODY with translation POS, rotation ANGLE and scaling SCALE. Transformations are applied in that order." `(progn (close-quads) (pal-ffi:gl-push-matrix) @@ -120,6 +136,7 @@ (pal-ffi:gl-pop-matrix)))) (defmacro with-gl (mode &body body) + "Wrap BODY between (gl-begin MODE) and (gl-end). When used with +GL-QUADS+ gl-begin/end are possibly completely left out." (if (eq mode 'pal-ffi:+gl-quads+) `(progn (open-quads) @@ -144,6 +161,7 @@ (pal-ffi:gl-pop-attrib))) (defmacro randomly (p &body body) + "There is a 1/P chance of the BODY to be evaluated." `(when (= (random ,p) 0) ,@body)) @@ -180,6 +198,7 @@ nil (apply fn args))) +;; Messy... (defmacro do-event (event key-up-fn key-down-fn mouse-motion-fn quit-fn) `(loop while (pal-ffi:poll-event ,event) do @@ -210,7 +229,7 @@ ((= type pal-ffi:+mouse-button-up-event+) (let* ((button (cffi:foreign-slot-value ,event 'pal-ffi:mouse-button-event 'pal-ffi:button)) - (keysym (read-from-string (format nil ":key-mouse-~a" button)))) + (keysym (read-from-string (format nil ":key-mouse-~a" button)))) ;; Mousekeys are handled as keycodes :KEY-MOUSE-n (setf (gethash keysym *pressed-keys*) nil) (funcall? ,key-up-fn keysym))) @@ -240,6 +259,7 @@ (defmacro with-pal (args &body body) + "Open PAL and evaluate BODY. After BODY returns call CLOSE-PAL." `(progn (apply 'open-pal (list ,@args)) (unwind-protect --- /project/pal/cvsroot/pal/pal.lisp 2007/09/07 07:55:16 1.30 +++ /project/pal/cvsroot/pal/pal.lisp 2007/10/11 19:26:23 1.31 @@ -12,9 +12,10 @@ (defparameter *pal-directory* (make-pathname :directory (pathname-directory *load-pathname*) :host (pathname-host *load-pathname*) :device (pathname-device *load-pathname*))) -(defvar *messages* nil) -(defvar *pal-running* nil) -(defvar *title* "") + +(defvar *messages* nil "List of messages draw on screen with MESSAGE.") +(defvar *pal-running* nil "T if PAL is already running.") +(defvar *title* "" "PAL windows title. Also used for creating the path to applications data directory.") (defvar *ticks* 0) (defvar *clip-stack* nil) (defvar *fps* 0) @@ -29,9 +30,9 @@ (defvar *cursor-offset* (v 0 0)) (defvar *mouse-x* 0) (defvar *mouse-y* 0) -(defvar *current-image* nil) -(defvar *max-texture-size* 0) -(defvar *quads-open* nil) +(defvar *current-image* nil "Currently set OpenGL texture.") +(defvar *max-texture-size* 0 "Maximum size of OpenGL texture supported by system.") +(defvar *quads-open* nil "T if (GL-BEGIN +GL-QUADS+) is already in effect.") (declaim (type list *messages*) @@ -136,6 +137,7 @@ (setf *pal-running* nil))) (defun get-application-folder () + "Return the application data directory to be used for saving user specific data. PAL windows title is used when forming the directory pathname. Actual behaviour depends on the operating system." (assert (> (length *title* ) 0)) #-win32 (ensure-directories-exist (merge-pathnames (make-pathname :directory (list :relative (concatenate 'string "." *title*))) (user-homedir-pathname))) @@ -143,15 +145,18 @@ (parse-namestring (pal-ffi:get-application-folder))))) (defun get-application-file (file) + "Return a full path to a FILE in the application data directory. PAL windows title is used when forming the directory pathname. Actual behaviour depends on the operating system." (merge-pathnames file (get-application-folder))) (defun add-path (path) + "Add PATH to the list of paths that are searched when loading resources." (if #-:clisp (probe-file path) #+:clisp (ext:probe-directory path) (pushnew path *data-paths*) (format *debug-io* "Illegal data path: ~a" path))) (defun data-path (file) + "Find a FILE from the search paths." (let ((result nil)) (dolist (i *data-paths* result) (when (probe-file (merge-pathnames file i)) @@ -161,6 +166,7 @@ (error "Data file not found: ~a" file)))) (defun get-gl-info () + "Return some information about systems OpenGL implementation." (list :vendor (pal-ffi:gl-get-string pal-ffi:+gl-vendor+) :rendered (pal-ffi:gl-get-string pal-ffi:+gl-renderer+) :version (pal-ffi:gl-get-string pal-ffi:+gl-version+) @@ -174,6 +180,7 @@ (declaim (inline key-pressed-p)) (defunct key-pressed-p (keysym) (symbol keysym) + "Return T if key KEYSYM is currently pressed down." (gethash keysym *pressed-keys*)) (defunct keysym-char (keysym) @@ -198,6 +205,7 @@ (do-event event key-up-fn key-down-fn mouse-motion-fn quit-fn)))) (defun wait-keypress () + "Wait until some key is pressed down and released." (let ((key nil)) (event-loop (:key-down-fn (lambda (k) (setf key k) @@ -220,6 +228,7 @@ (draw-text m (v 0 (incf y fh)))))) (defun update-screen () + "Updates PAL window." (setf *new-fps* (max 1 (the fixnum (- (pal-ffi:get-tick) *ticks*)))) (setf *fps* (truncate (+ *fps* *new-fps*) 2)) (if (> *delay* 0) @@ -270,6 +279,7 @@ *mouse-y* y)) (defun set-cursor (image &optional offset) + "Sets the state of mouse cursor. When IMAGE is NIL hide the cursor, when T show it. If IMAGE is an image resource use that as mouse cursor. OFFSET is a vector that sets the offset of custom cursor image." (assert (and (or (null offset) (vec-p offset)) (or (image-p image) (typep image 'boolean)))) (when offset --- /project/pal/cvsroot/pal/vector.lisp 2007/08/15 14:36:21 1.8 +++ /project/pal/cvsroot/pal/vector.lisp 2007/10/11 19:26:23 1.9 @@ -44,7 +44,7 @@ (component angle) (v (sin (rad angle)) (- (cos (rad angle))))) -(declaim (inline vec-angle)) +(declaim (inline v-angle)) (defunct v-angle (vec) (vec vec) (mod (deg (atan (vx vec)

1 0

[pal-cvs] CVS pal
by tneste 07 Sep '07

07 Sep '07

Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv13419 Modified Files: ffi.lisp package.lisp pal.lisp todo.txt Log Message: Added fading arguments to play-music/halt-music. --- /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 21:11:23 1.19 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/09/07 07:55:16 1.20 @@ -639,9 +639,15 @@ (cffi:defcfun ("Mix_HaltMusic" halt-music) :int) +(cffi:defcfun ("Mix_FadeOutMusic" fade-out-music) :int + (fade :int)) + (cffi:defcfun ("Mix_LoadMUS" load-music) :pointer (file :string)) +(cffi:defcfun ("Mix_FadeInMusic" fade-in-music) :int + (music :pointer) (loops :int) (fade :int)) + (cffi:defcfun ("Mix_PlayMusic" play-music) :int (music :pointer) (loops :int)) --- /project/pal/cvsroot/pal/package.lisp 2007/08/30 09:22:19 1.16 +++ /project/pal/cvsroot/pal/package.lisp 2007/09/07 07:55:16 1.17 @@ -4,6 +4,8 @@ (:use :common-lisp) (:export #:+NO-EVENT+ #:+gl-line-smooth+ + #:fade-out-music + #:fade-in-music #:make-font #:+gl-pack-alignment+ #:gl-flush --- /project/pal/cvsroot/pal/pal.lisp 2007/08/30 21:11:23 1.29 +++ /project/pal/cvsroot/pal/pal.lisp 2007/09/07 07:55:16 1.30 @@ -56,7 +56,7 @@ (when *pal-running* (close-pal)) (pal-ffi:init (logior pal-ffi:+init-video+ pal-ffi:+init-audio+)) - (pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 0 2048) + (pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 0 1024) (pal-ffi:gl-set-attribute pal-ffi:+gl-depth-size+ 0) (pal-ffi:gl-set-attribute pal-ffi:+gl-doublebuffer+ 1) (let ((surface (pal-ffi::set-video-mode @@ -762,19 +762,26 @@ (let ((music (pal-ffi::make-music :music music))) (pal-ffi:register-resource music)))) -(defun play-music (music &key (loops t) (volume 255)) +(defun play-music (music &key (loops t) (volume 255) (fade 0)) "Volume 0-255. Loops is: t = forever, nil = once, number = number of loops" (pal-ffi:volume-music (1+ (truncate volume 2))) - (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1) - ((null loops) 0) - (t (truncate loops))))) + (if (> fade 0) + (pal-ffi:fade-in-music (pal-ffi:music-music music) (cond ((eq loops t) -1) + ((null loops) 0) + (t (truncate loops))) + fade) + (pal-ffi:play-music (pal-ffi:music-music music) (cond ((eq loops t) -1) + ((null loops) 0) + (t (truncate loops)))))) (defun set-music-volume (volume) "Volume 0-255" (pal-ffi:volume-music (1+ (truncate volume 2)))) -(defun halt-music () - (pal-ffi:halt-music)) +(defun halt-music (&optional fade) + (if fade + (pal-ffi:fade-out-music fade) + (pal-ffi:halt-music))) --- /project/pal/cvsroot/pal/todo.txt 2007/08/30 09:02:24 1.17 +++ /project/pal/cvsroot/pal/todo.txt 2007/09/07 07:55:16 1.18 @@ -4,9 +4,6 @@ - Implement image mirroring, tiles and animation. -- Add more complex sound/music handling functions, channel set volume/dir, - fade/etc. music. - - Box/box/line/circle etc. overlap functions, faster v-dist. - Correct aspect ratio when fullscreen on widescreen displays.

1 0

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

07 Sep '07

Update of /project/pal/cvsroot/pal/examples In directory clnet:/tmp/cvs-serv13419/examples Modified Files: images.lisp teddy.lisp Log Message: Added fading arguments to play-music/halt-music. --- /project/pal/cvsroot/pal/examples/images.lisp 2007/07/29 19:11:44 1.7 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/09/07 07:55:15 1.8 @@ -4,7 +4,7 @@ (define-tags - ;; IMAGE-FROM-FN builds and image by calling the FN with x and y coordinates. + ;; IMAGE-FROM-FN builds an image by calling the FN with x and y coordinates. ;; FN should return at least three VALUES for r, g and b and an optional fourth value for alpha. image-1 (image-from-fn 255 255 nil (lambda (x y) @@ -12,7 +12,7 @@ (truncate (+ 127 (* 128 (cos (/ y 10))))) (truncate (+ 127 (* 128 (cos (/ (+ x y) 10))))) (truncate (+ 127 (* 128 (cos (/ (- x y) 10)))))))) - ;; IMAGE-FROM-ARRAY builds and image from an 2d array of (list r g b &optional a) + ;; IMAGE-FROM-ARRAY builds an image from a 2d array of (list r g b &optional a) ;; Try setting the SMOOTHP parameter to T and see what happens. image-2 (image-from-array nil #2A(((255 255 255 128) (0 0 0) (255 255 255)) ((255 255 255) (255 255 0) (255 255 255)) @@ -55,7 +55,9 @@ :angle (incf a .1))) - ;; Press left mousebutton to capture part of the screen as a new cursor + ;; Press left mousebutton to capture part of the screen as a new cursor. + ;; Note that altough the allocated images are released when PAL is closed we really should manually release + ;; the old cursor image with FREE-RESOURCE if we keep allocating lots of new images. (when (key-pressed-p :key-mouse-1) (set-cursor (image-from-array nil --- /project/pal/cvsroot/pal/examples/teddy.lisp 2007/08/30 09:02:23 1.9 +++ /project/pal/cvsroot/pal/examples/teddy.lisp 2007/09/07 07:55:15 1.10 @@ -92,7 +92,7 @@ ;; Other possible options to cursor are: t - show the default cursor, nil - hide all cursors (set-cursor (tag 'cursor) (v 18 18)) - (play-music (tag 'music)) + (play-music (tag 'music) :fade 10000) (play-sample (tag 'engine) :loops t :volume 50) (make-instance 'plane :alt 20) @@ -137,6 +137,7 @@ ;; TEST-KEYS is used to check if some key is currently pressed, _all_ the matching forms are evaluated. (test-keys + (:key-f (halt-music 10000)) (:key-1 (setf *blend-mode* nil) (message *blend-mode*)) (:key-2 (setf *blend-mode* :blend)

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

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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

pal-cvs