[pal-cvs] CVS pal
tneste
tneste at common-lisp.net
Thu Jul 19 16:37:25 UTC 2007
Update of /project/pal/cvsroot/pal
In directory clnet:/tmp/cvs-serv8793
Modified Files:
ffi.lisp package.lisp pal-macros.lisp pal.lisp todo.txt
Added Files:
readme.txt
Log Message:
Added LOAD-IMAGE-TO-ARRAY, few bug fixes.
--- /project/pal/cvsroot/pal/ffi.lisp 2007/07/18 21:29:56 1.9
+++ /project/pal/cvsroot/pal/ffi.lisp 2007/07/19 16:37:25 1.10
@@ -901,4 +901,8 @@
;; SDL_SysWMinfo wmInfo;
;; SDL_GetWMInfo(&wmInfo);
-;; HWND hWnd = wmInfo.window;
\ No newline at end of file
+;; HWND hWnd = wmInfo.window;
+
+;; image = (GLubyte *) malloc(width * height * sizeof(GLubyte) * 3) ;
+;; glPixelStorei(GL_PACK_ALIGNMENT, 1) ;
+;; glReadPixels(x, y, width, height, GL_RGB, GL_UNSIGNED_BYTE, image) ;
\ No newline at end of file
--- /project/pal/cvsroot/pal/package.lisp 2007/07/18 21:29:56 1.9
+++ /project/pal/cvsroot/pal/package.lisp 2007/07/19 16:37:25 1.10
@@ -6,6 +6,7 @@
#:+gl-line-smooth+
#:make-font
#:+gl-scissor-test+
+ #:free-surface
#:gl-get-integer
#:+gl-max-texture-size+
#:+gl-smooth+
@@ -419,6 +420,7 @@
#:image-from-array
#:image-from-fn
+ #:load-image-to-array
#:load-image
#:image-width
@@ -431,6 +433,7 @@
#:draw-arrow
#:draw-image
#:draw-image*
+ #:draw-circle
#:load-font
#:get-font-height
--- /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/16 20:46:24 1.7
+++ /project/pal/cvsroot/pal/pal-macros.lisp 2007/07/19 16:37:25 1.8
@@ -52,14 +52,16 @@
`(set-blend-mode ,mode))
,(when color
`(set-blend-color (first ,color) (second ,color) (third ,color) (fourth ,color)))
- , at body
- (pal-ffi:gl-pop-attrib)))
+ (prog1 (progn
+ , at body)
+ (pal-ffi:gl-pop-attrib))))
(defmacro with-clipping ((x y width height) &body body)
`(progn
(push-clip ,x ,y ,width ,height)
- , at body
- (pop-clip)))
+ (prog1 (progn
+ , at body)
+ (pop-clip))))
(defmacro with-transformation ((&key pos angle scale) &body body)
`(progn
@@ -72,8 +74,9 @@
(let ((s (gensym)))
`(let ((,s ,scale))
(pal-ffi:gl-scalef ,s ,s 1f0))))
- , at body
- (pal-ffi:gl-pop-matrix)))
+ (prog1 (progn
+ , at body)
+ (pal-ffi:gl-pop-matrix))))
(defmacro with-gl (mode &body body)
`(progn
--- /project/pal/cvsroot/pal/pal.lisp 2007/07/18 21:29:56 1.15
+++ /project/pal/cvsroot/pal/pal.lisp 2007/07/19 16:37:25 1.16
@@ -1,8 +1,9 @@
;; Notes:
;; tags-resources-free?
-;; do absolute paths for data-path work?
-;; box/box/line overlap functions, fast v-dist
-;; load-image-to-array
+;; save-screen
+;; raise on top on windows
+;; smoothed polygons, guess circle segment count
+;; defunct
(declaim (optimize (speed 3)
@@ -57,54 +58,57 @@
(pal-ffi:open-audio 22050 pal-ffi:+audio-s16+ 2 2048)
(pal-ffi:gl-set-attribute pal-ffi:+gl-depth-size+ 0)
(pal-ffi:gl-set-attribute pal-ffi:+gl-doublebuffer+ 1)
- (when (cffi:null-pointer-p (pal-ffi::set-video-mode
- width
- height
- 0
- (logior (if fullscreenp
- pal-ffi::+fullscreen+
- 0)
- pal-ffi:+opengl+)))
- (error "PAL failed to obtain SDL surface"))
- (pal-ffi:set-caption title (cffi:null-pointer))
- (pal-ffi:gl-disable pal-ffi:+gl-cull-face-test+)
- (pal-ffi:gl-enable pal-ffi:+gl-texture-2d+)
- (pal-ffi:gl-shade-model pal-ffi:+gl-flat+)
- (pal-ffi:gl-disable pal-ffi:+gl-scissor-test+)
- (set-blend-mode :blend)
- (pal-ffi:gl-viewport 0 0 width height)
- (pal-ffi:gl-matrix-mode pal-ffi:+gl-projection+)
- (pal-ffi:gl-load-identity)
- (pal-ffi:gl-ortho 0d0 (coerce width 'double-float) (coerce height 'double-float) 0d0 -1d0 1d0)
- (pal-ffi:gl-matrix-mode pal-ffi:+gl-modelview+)
- (pal-ffi:gl-load-identity)
- (clear-screen 0 0 0)
- (reset-tags)
- (define-tags default-font (load-font "default-font"))
- (setf *data-paths* nil
- *max-texture-size* (pal-ffi:gl-get-integer pal-ffi:+gl-max-texture-size+)
- *messages* nil
- *pressed-keys* (make-hash-table :test 'eq)
- *ticks* (get-internal-real-time)
- *title* title
- *current-image* nil
- *max-fps* (truncate 1000 fps)
- *ticks* (pal-ffi:get-tick)
- *clip-stack* nil
- *fps* 1
- *delay* 0
- *new-fps* 0
- *cursor* t
- *cursor-offset* (v 0 0)
- *width* width
- *height* height
- *pal-running* t)
- (add-path *pal-directory*)
- (add-path *default-pathname-defaults*)
- (if (listp paths)
- (dolist (p paths)
- (add-path p))
- (add-path paths)))
+
+ (let ((surface (pal-ffi::set-video-mode
+ width
+ height
+ 0
+ (logior (if fullscreenp
+ pal-ffi::+fullscreen+
+ 0)
+ pal-ffi:+opengl+))))
+ (when (cffi:null-pointer-p surface)
+ (error "PAL failed to obtain SDL surface"))
+ (setf *data-paths* nil
+ *max-texture-size* (pal-ffi:gl-get-integer pal-ffi:+gl-max-texture-size+)
+ *messages* nil
+ *pressed-keys* (make-hash-table :test 'eq)
+ *ticks* (get-internal-real-time)
+ *title* title
+ *current-image* nil
+ *max-fps* (truncate 1000 fps)
+ *ticks* (pal-ffi:get-tick)
+ *clip-stack* nil
+ *fps* 1
+ *delay* 0
+ *new-fps* 0
+ *cursor* t
+ *cursor-offset* (v 0 0)
+ *pal-running* t
+ *width* (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w)
+ *height* (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h))
+ (pal-ffi:set-caption title (cffi:null-pointer))
+ (pal-ffi:gl-disable pal-ffi:+gl-cull-face-test+)
+ (pal-ffi:gl-enable pal-ffi:+gl-texture-2d+)
+ (pal-ffi:gl-shade-model pal-ffi:+gl-flat+)
+ (pal-ffi:gl-disable pal-ffi:+gl-scissor-test+)
+ (set-blend-mode :blend)
+ (pal-ffi:gl-viewport 0 0 *width* *height*)
+ (pal-ffi:gl-matrix-mode pal-ffi:+gl-projection+)
+ (pal-ffi:gl-load-identity)
+ (pal-ffi:gl-ortho 0d0 (coerce *width* 'double-float) (coerce *height* 'double-float) 0d0 -1d0 1d0)
+ (pal-ffi:gl-matrix-mode pal-ffi:+gl-modelview+)
+ (pal-ffi:gl-load-identity)
+ (clear-screen 0 0 0)
+ (reset-tags)
+ (define-tags default-font (load-font "default-font"))
+
+ (add-path *pal-directory*)
+ (add-path *default-pathname-defaults*)
+ (if (listp paths)
+ (dolist (p paths)
+ (add-path p))
+ (add-path paths))))
(declaim (inline clamp))
(defun clamp (min v max)
@@ -367,7 +371,7 @@
(image-from-fn (array-dimension array 0)
(array-dimension array 1)
smoothp
- (lambda (y x)
+ (lambda (x y)
(let ((pixel (aref array x y)))
(values (first pixel)
(second pixel)
@@ -417,11 +421,22 @@
(cffi:foreign-free id)
(pal-ffi:register-resource image))))
+(defun load-image-to-array (file)
+ (let* ((surface (pal-ffi:load-image (data-path file))))
+ (assert (not (cffi:null-pointer-p surface)))
+ (let* ((width (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w))
+ (height (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h))
+ (array (make-array (list width height))))
+ (do-n (x width y height)
+ (setf (aref array x y) (multiple-value-list (surface-get-pixel surface x y))))
+ (pal-ffi:free-surface surface)
+ array)))
+
(defun load-image (file &optional (smoothp nil))
(let* ((surface (pal-ffi:load-image (data-path file)))
(image (progn (assert (not (cffi:null-pointer-p surface)))
(image-from-fn (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w)
- (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:w)
+ (cffi:foreign-slot-value surface 'pal-ffi:surface 'pal-ffi:h)
smoothp
(lambda (x y)
(surface-get-pixel surface x y))))))
--- /project/pal/cvsroot/pal/todo.txt 2007/07/18 21:29:56 1.10
+++ /project/pal/cvsroot/pal/todo.txt 2007/07/19 16:37:25 1.11
@@ -2,6 +2,10 @@
- Add align, scale and angle options to DRAW-IMAGE*.
+- Implement image mirroring.
+
+- Box/box/line/circle etc. overlap functions, faster v-dist
+
- Improved texture handling
- image-to-array/screen-to-array etc.
--- /project/pal/cvsroot/pal/readme.txt 2007/07/19 16:37:25 NONE
+++ /project/pal/cvsroot/pal/readme.txt 2007/07/19 16:37:25 1.1
Linux gfx card problems
It seems that some people (yours truly included, running Ubuntu 7.04 with ATI
X550 and the OSS drivers) are having problems under Linux when trying to run
PAL applications several times in the same Lisp session. I did some testing and
it _looks_ like the problem is in some graphics cards drivers. Of course it is
possible that there is a bug in PAL, but so far I haven't find it.
Running the following function twice after PAL is loaded should trigger the bug,
if present on your system:
-----------
(defun test-open-close ()
(pal-ffi::init pal-ffi::+init-video+)
(pal-ffi::gl-set-attribute pal-ffi::+gl-depth-size+ 0)
(pal-ffi::gl-set-attribute pal-ffi::+gl-doublebuffer+ 1)
(when (cffi:null-pointer-p (pal-ffi::set-video-mode
800
600
0
(logior pal-ffi::+gl-doublebuffer+ pal-ffi::+opengl+)))
(error "PAL failed to obtain SDL surface"))
(pal-ffi::quit))
-----------
This happens on my computer with both SBCL and CLisp, but not with an equivalent
C program or any of the Windows CLs that I have tried. So far I have no idea
what is causing this but if anyone has any clues or more info I'd appreciate
sharing it.
Since this kind of bug causes problems when developing in an incremental, "live"
environment like CL here are some suboptimal workarounds:
- The bug doesn't seem to appear with all drivers/gfx cards. Especially running
X11 without HW acceleration should be safe.
- Never call CLOSE-PAL. I haven't tested it much, but it should be possible to
just call OPEN-PAL when starting your lisp session and never use CLOSE-PAL or
WITH-PAL (which eventually calls CLOSE-PAL). Of course this means that some
parameters like window size can't be changed after initialisation.
- Never return from WITH-PAL. Run your main loop in a separate thread and
install condition handlers that just restart your main loop without closing
down PAL. That way you can incrementally change your functions/classes etc.
while your app is running. I might actually add this as an option to WITH-PAL.
All in all this bug mostly has effect only while developing, applications that
don't need to open/close PAL several times should work fine.
-- tomppa
More information about the Pal-cvs
mailing list