Update of /project/pal/cvsroot/pal In directory clnet:/tmp/cvs-serv19772

Modified Files: ffi.lisp package.lisp pal.lisp Log Message: Added glFlush() in IMAGE-FROM-SCREEN

--- /project/pal/cvsroot/pal/ffi.lisp 2007/08/15 14:36:21 1.17 +++ /project/pal/cvsroot/pal/ffi.lisp 2007/08/30 09:22:19 1.18 @@ -718,6 +718,8 @@ (defconstant +gl-point-smooth+ #xB10) (defconstant +gl-point+ #x0)

+(cffi:defcfun ("glFlush" gl-flush) :void) + (cffi:defcfun ("glAlphaFunc" gl-alpha-func) :void (func :int) (ref :float)) --- /project/pal/cvsroot/pal/package.lisp 2007/08/15 14:36:21 1.15 +++ /project/pal/cvsroot/pal/package.lisp 2007/08/30 09:22:19 1.16 @@ -6,6 +6,7 @@ #:+gl-line-smooth+ #:make-font #:+gl-pack-alignment+ + #:gl-flush #:gl-read-pixels #:gl-pixel-store #:+gl-scissor-test+ --- /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:02:24 1.27 +++ /project/pal/cvsroot/pal/pal.lisp 2007/08/30 09:22:19 1.28 @@ -175,11 +175,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)) @@ -215,7 +215,7 @@

(defun draw-messages () (let ((fh (get-font-height)) - (y 0)) + (y 0)) (declare (type u11 y fh)) (dolist (m *messages*) (declare (type simple-string m)) @@ -233,9 +233,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 +257,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 +266,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 +287,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 +321,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 +332,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 +356,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) @@ -474,8 +474,9 @@ 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))) (y (truncate (vy pos))) (rowsize (* width 4)) @@ -506,7 +507,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)) @@ -554,7 +555,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)) @@ -578,33 +579,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+) @@ -618,7 +619,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 @@ -630,11 +631,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+)) @@ -644,7 +645,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) @@ -670,9 +671,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+)) @@ -684,7 +685,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 @@ -723,7 +724,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 @@ -840,7 +841,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 @@ -855,13 +856,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)))))