[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Thu Aug 30 21:11:23 UTC 2007
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)))))
More information about the Pal-cvs
mailing list