[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Fri Jul 13 13:21:04 UTC 2007
Update of /project/pal/cvsroot/pal
In directory clnet:/tmp/cvs-serv16987
Modified Files:
ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt
Log Message:
Changes in the API, especially in the various DRAW-* functions. Most examples still not updated, polygon examples added.
--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/09 18:17:44 1.4
+++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/13 13:21:04 1.5
@@ -464,6 +464,9 @@
(push resource *resources*)
resource)
+(defmethod free-resource :before (resource)
+ (assert (typep resource 'resource)))
+
(defmethod free-resource :after (resource)
(setf *resources* (remove resource *resources*)))
@@ -860,4 +863,6 @@
(cffi:defcfun "calloc" :pointer (nelem :uint) (elsize :uint))
(cffi:defcfun "free" :void (ptr :pointer))
-
+;; SDL_SysWMinfo wmInfo;
+;; SDL_GetWMInfo(&wmInfo);
+;; HWND hWnd = wmInfo.window;
\ No newline at end of file
--- /project/pal/cvsroot/pal/package.lisp 2007/07/09 18:17:44 1.3
+++ /project/pal/cvsroot/pal/package.lisp 2007/07/13 13:21:04 1.4
@@ -371,7 +371,6 @@
#:get-application-file
#:data-path
#:with-resource
- #:with-clipping
#:randomly
#:relt
@@ -403,6 +402,10 @@
#:reset-blend-mode
#:set-blend-color
#:with-blend
+ #:with-clipping
+ #:push-clip
+ #:pop-clip
+ #:update-screen
#:load-image
#:image-width
--- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/09 18:17:44 1.5
+++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/13 13:21:04 1.6
@@ -41,17 +41,18 @@
(defmacro with-default-settings (&body body)
`(with-transformation ()
- (with-blend (:mode :blend :r 255 :g 255 :b 255 :a 255)
+ (with-blend (:mode :blend :color '(255 255 255 255))
(pal-ffi:gl-load-identity)
, at body)))
-(defmacro with-blend ((&key (mode t) r g b a) &body body)
+
+(defmacro with-blend ((&key (mode t) color) &body body)
`(progn
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
,(unless (eq mode t)
`(set-blend-mode ,mode))
- ,(when (and r g b a)
- `(set-blend-color ,r ,g ,b ,a))
+ ,(when color
+ `(set-blend-color (first ,color) (second ,color) (third ,color) (fourth ,color)))
, at body
(pal-ffi:gl-pop-attrib)))
@@ -112,8 +113,10 @@
args)))
(defmacro funcall? (fn &rest args)
- `(when ,fn
- (funcall ,fn , at args)))
+ (if (null fn)
+ nil
+ `(funcall ,fn , at args)))
+
(defmacro do-event (event key-up-fn key-down-fn mouse-motion-fn quit-fn)
`(loop while (pal-ffi:poll-event ,event)
@@ -169,7 +172,7 @@
(defmacro event-loop ((&key key-up-fn key-down-fn mouse-motion-fn quit-fn) &body redraw)
(let ((event (gensym)))
`(block event-loop
- (cffi:with-foreign-object (,event :char 1000)
+ (cffi:with-foreign-object (,event :char 500)
(loop
(do-event ,event ,key-up-fn ,key-down-fn ,mouse-motion-fn ,quit-fn)
, at redraw
--- /project/pal/cvsroot/pal/pal.lisp 2007/07/09 18:17:44 1.8
+++ /project/pal/cvsroot/pal/pal.lisp 2007/07/13 13:21:04 1.9
@@ -1,9 +1,10 @@
-;; are the texture options sane for draw-poly etc.
+;; Urgent:
;; tags-resources-free?
-;; animations
-;; circle/box/point overlap functions
+;; circle/box/point overlap functions, fast v-dist
;; resources should check for void when freeing
-;; sdl window not on top?
+;; sdl window not always on top on windows?
+;; do absolute paths for data-path work?
+;; draw-image aligns, draw-quad! abs.
(declaim (optimize (speed 3)
(safety 3)))
@@ -186,7 +187,7 @@
(defun dispatch-event (&key key-up-fn key-down-fn mouse-motion-fn quit-fn)
(block event-loop
- (cffi:with-foreign-object (event :char 100)
+ (cffi:with-foreign-object (event :char 500)
(do-event event key-up-fn key-down-fn mouse-motion-fn quit-fn))))
(defun wait-keypress ()
@@ -251,9 +252,9 @@
(declaim (inline clear-screen))
(defun clear-screen (r g b)
(declare (type u8 r g b))
- (pal-ffi:gl-clear-color (coerce (/ r 255f0) 'single-float)
- (coerce (/ g 255f0) 'single-float)
- (coerce (/ b 255f0) 'single-float)
+ (pal-ffi:gl-clear-color (/ r 255f0)
+ (/ g 255f0)
+ (/ b 255f0)
1f0)
(pal-ffi:gl-clear pal-ffi:+gl-color-buffer-bit+))
@@ -415,8 +416,8 @@
(pal-ffi::free-surface surface)
image))
-(defun draw-image (image pos &optional angle scale)
- (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale))
+(defun draw-image (image pos &key angle scale (valign :left) (halign :top))
+ (declare (type image image) (type vec pos) (type (or boolean single-float) angle scale) (type symbol halign valign))
(set-image image)
(let ((width (image-width image))
(height (image-height image))
@@ -449,7 +450,7 @@
(pal-ffi:gl-tex-coord2f 0f0 ty2)
(pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height))))))
-(defun draw-quad (image a b c d)
+(defun draw-quad (image a b c d &key absolutep)
(declare (type image image) (type vec a b c d))
(set-image image)
(let ((tx2 (pal-ffi:image-tx2 image))
@@ -486,12 +487,12 @@
(pal-ffi:gl-vertex2f vx-to (+ vy-to height)))))
(declaim (inline draw-line))
-(defun draw-line (la lb r g b a &optional (width 1.0f0))
- (declare (type vec la lb) (type u8 r g b a) (type single-float width))
+(defun draw-line (la lb r g b a &key (size 1.0f0))
+ (declare (type vec la lb) (type u8 r g b a) (type single-float size))
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(set-blend-color r g b a)
- (pal-ffi:gl-line-width width)
+ (pal-ffi:gl-line-width size)
(pal-ffi:gl-enable pal-ffi:+gl-line-smooth+)
(with-gl pal-ffi:+gl-lines+
(pal-ffi:gl-vertex2f (vx la) (vy la))
@@ -500,14 +501,14 @@
(declaim (inline draw-arrow))
-(defun draw-arrow (la lb r g b a &optional (width 1.0f0))
- (declare (type vec la lb) (type u8 r g b a) (type single-float width))
+(defun draw-arrow (la lb r g b a &key (size 1.0f0))
+ (declare (type vec la lb) (type u8 r g b a) (type single-float size))
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(set-blend-color r g b a)
- (pal-ffi:gl-line-width width)
+ (pal-ffi:gl-line-width size)
(pal-ffi:gl-enable pal-ffi:+gl-line-smooth+)
- (let ((d (v* (v-direction la lb) (+ width 8f0))))
+ (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))
@@ -522,7 +523,7 @@
(declaim (inline draw-point))
-(defun draw-point (pos r g b a &optional (size 1f0))
+(defun draw-point (pos r g b a &key (size 1f0))
(declare (type vec pos) (type u8 r g b a) (type single-float size))
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
@@ -533,8 +534,8 @@
(pal-ffi:gl-vertex2f (vx pos) (vy pos)))
(pal-ffi:gl-pop-attrib))
-(defun draw-rectangle (pos width height r g b a &optional (filledp t))
- (declare (type vec pos) (type u11 width height) (type u8 r g b a) (type boolean filledp))
+(defun draw-rectangle (pos width height r g b a &key (filledp t) (size 1f0))
+ (declare (type vec pos) (type float size) (type u11 width height) (type u8 r g b a) (type boolean filledp))
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+))
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(set-blend-color r g b a)
@@ -543,6 +544,7 @@
(pal-ffi:gl-rectf (vx pos) (vy pos) (+ (vx pos) width) (+ (vy pos) height)))
(t
(pal-ffi:gl-enable pal-ffi:+gl-line-smooth+)
+ (pal-ffi:gl-line-width size)
(with-gl pal-ffi:+gl-line-loop+
(pal-ffi:gl-vertex2f (vx pos) (vy pos))
(pal-ffi:gl-vertex2f (+ (vx pos) width) (vy pos))
@@ -553,23 +555,30 @@
(pal-ffi:gl-vertex2f (vx pos) (+ (vy pos) height)))))
(pal-ffi:gl-pop-attrib))
-(defun draw-polygon (points r g b a &optional (fill t) image)
- (declare (type list points) (type u8 r g b a) (type symbol fill) (type (or image boolean) image))
+(defun draw-polygon (points r g b a &key fill absolutep (size 1f0))
+ (declare (type list points) (type u8 r g b a) (type (or image boolean) fill))
(cond
- ((and (eq fill t) image)
- (set-image image)
+ ((image-p fill)
+ (set-image fill)
(with-gl pal-ffi:+gl-polygon+
(let ((dx (vx (first points)))
(dy (vy (first points))))
(dolist (p points)
(let* ((x (vx p))
(y (vy p))
- (tx (/ (- x dx) (pal-ffi:image-texture-width image)))
- (ty (/ (- y dy) (pal-ffi:image-texture-height image))))
+ (tx (/ (if absolutep
+ x
+ (- x dx))
+ (pal-ffi:image-texture-width fill)))
+ (ty (/ (if absolutep
+ y
+ (- y dy))
+ (pal-ffi:image-texture-height fill))))
(pal-ffi:gl-tex-coord2f tx ty)
(pal-ffi:gl-vertex2f x y))))))
((eq nil fill)
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+))
+ (pal-ffi:gl-line-width size)
(set-blend-color r g b a)
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(pal-ffi:gl-enable pal-ffi:+gl-line-smooth+)
@@ -577,18 +586,15 @@
(dolist (p points)
(pal-ffi:gl-vertex2f (vx p) (vy p))))
(pal-ffi:gl-pop-attrib))
- ((eq t fill)
+ (t
(pal-ffi:gl-push-attrib (logior pal-ffi:+gl-color-buffer-bit+ pal-ffi:+gl-current-bit+ pal-ffi:+gl-line-bit+ pal-ffi:+gl-enable-bit+))
(set-blend-color r g b a)
(pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(pal-ffi:gl-enable pal-ffi:+gl-line-smooth+)
- (pal-ffi:gl-disable pal-ffi:+gl-texture-2d+)
(with-gl pal-ffi:+gl-polygon+
(dolist (p points)
(pal-ffi:gl-vertex2f (vx p) (vy p))))
- (pal-ffi:gl-pop-attrib))
- (t
- (set-image image))))
+ (pal-ffi:gl-pop-attrib))))
@@ -621,7 +627,7 @@
(defun load-music (file)
(pal-ffi:load-music (data-path file)))
-(defun play-music (music &optional (loops t) (volume 255))
+(defun play-music (music &key (loops t) (volume 255))
"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)
--- /project/pal/cvsroot/pal/todo.txt 2007/07/03 18:42:35 1.4
+++ /project/pal/cvsroot/pal/todo.txt 2007/07/13 13:21:04 1.5
@@ -17,8 +17,10 @@
- CL native font resource builder.
-- Fix with-blend (r g b a), see that things work on Allegro CL.
+- Fix with-blend (r g b a).
- Make it run on OS X.
- TrueType font support.
+
+- Simple animation system for images.
More information about the Pal-cvs
mailing list