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