pal-cvs

Download

pal-cvs@common-lisp.net

October 2007

1 participants
51 discussions

[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