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