[pal-cvs] CVS pal-gui/examples
tneste
tneste at common-lisp.net
Thu Jan 3 21:42:48 UTC 2008
Update of /project/pal/cvsroot/pal-gui/examples
In directory clnet:/tmp/cvs-serv7580/examples
Modified Files:
colors.lisp files.lisp packing.lisp test.lisp
Log Message:
Fixed some widget rendering problems. Updated the examples.
--- /project/pal/cvsroot/pal-gui/examples/colors.lisp 2007/10/30 20:44:45 1.2
+++ /project/pal/cvsroot/pal-gui/examples/colors.lisp 2008/01/03 21:42:48 1.3
@@ -1,7 +1,7 @@
(in-package :pal-gui)
-(defparameter *bg* (color 0 0 0 255))
+(defparameter *bg* (color 0 0 0))
(defmethod present ((c color) w width height)
(with-blend (:color c)
@@ -12,7 +12,7 @@
(defun test ()
- (with-gui (:paths (merge-pathnames "examples/" pal::*pal-directory*))
+ (with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*))
(let* ((window (make-instance 'window :pos (v 200 200) :width 200 :height 230 :label "Select color"))
(button (make-instance 'button :value ""
:parent window))
@@ -24,7 +24,7 @@
(setf (on-select-of button) (lambda (g)
(setf *bg* (selected-of list))))
- (gui-loop ()
- (clear-screen (color-r *bg*) (color-g *bg*) (color-b *bg*))))))
+ (event-loop ()
+ (clear-screen *bg*)))))
;; (test)
\ No newline at end of file
--- /project/pal/cvsroot/pal-gui/examples/files.lisp 2007/10/31 12:50:42 1.3
+++ /project/pal/cvsroot/pal-gui/examples/files.lisp 2008/01/03 21:42:48 1.4
@@ -20,19 +20,19 @@
(defmethod update-view ((g file-widget))
(setf (items-of (list-widget-of g)) (mapcar (lambda (f)
- (if (pathname-name f)
- (pathname-name f)
- (concatenate 'string (first (last (pathname-directory f))) "/")))
- (directory "*"))))
+ (if (pathname-name f)
+ (pathname-name f)
+ (concatenate 'string (first (last (pathname-directory f))) "/")))
+ (directory "*"))))
(defun test ()
- (with-gui ()
+ (with-pal ()
(let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200))
(hbox (make-instance 'file-widget :parent window :label "Choose")))
- (gui-loop ()
- (clear-screen 150 150 150)))))
+ (event-loop ()
+ (clear-screen (color 150 150 150))))))
;; (test)
\ No newline at end of file
--- /project/pal/cvsroot/pal-gui/examples/packing.lisp 2007/10/31 12:50:42 1.4
+++ /project/pal/cvsroot/pal-gui/examples/packing.lisp 2008/01/03 21:42:48 1.5
@@ -4,7 +4,7 @@
(defun test ()
- (with-gui ()
+ (with-pal ()
(let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 240))
(hbox (make-instance 'h-box :parent window))
@@ -19,29 +19,29 @@
(e (make-instance 'button :value "Button" :parent bottom-box))
(f (make-instance 'button :value "a Button" :parent left-box)))
- (gui-loop ()
- (clear-screen 50 50 255))))))
+ (event-loop ()
+ (clear-screen (color 50 50 255)))))))
;; (test)
(defun test ()
- (with-gui ()
+ (with-pal ()
(let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200)))
(let ((a (make-instance 'button :value "Button" :parent window :y-expand-p t))
(b (make-instance 'button :value "Button" :parent window))
(c (make-instance 'button :value "Foo" :parent window :y-expand-p t)))
- (gui-loop ()
- (clear-screen 50 50 255))))))
+ (event-loop ()
+ (clear-screen (color 50 50 255)))))))
;; (test)
(defun test ()
- (with-gui ()
+ (with-pal ()
(let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200)))
(let* ((hbox (make-instance 'h-box :parent window))
(box (make-instance 'box :label "Box" :parent window))
@@ -54,7 +54,7 @@
(loop repeat 10 do (make-instance 'pin :value "Foo" :b 0 :pos (v (random 800) (random 600))))
- (gui-loop ()
- (clear-screen 50 50 255))))))
+ (event-loop ()
+ (clear-screen (color 50 50 255)))))))
;; (test)
\ No newline at end of file
--- /project/pal/cvsroot/pal-gui/examples/test.lisp 2007/10/31 12:50:42 1.14
+++ /project/pal/cvsroot/pal-gui/examples/test.lisp 2008/01/03 21:42:48 1.15
@@ -11,7 +11,7 @@
(defun test ()
- (with-gui (:paths (merge-pathnames "examples/" pal::*pal-directory*))
+ (with-pal (:paths (list "C:/Documents and Settings/tomppa/Omat tiedostot/" (merge-pathnames "examples/" pal::*pal-directory*)))
(let* ((plane (load-image "lego-plane.png"))
(tile (load-image "ground.png"))
@@ -47,11 +47,11 @@
(pin (make-instance 'pin :value "Plane" :pos (v 400 300)))
(text (make-instance 'text-widget :text "Text" :parent bottom-box)))
- (gui-loop ()
- (draw-image* tile (v 0 0) (v 0 0) 800 600)
- (with-blend (:color (color 0 0 0 64))
- (draw-image plane (pos-of pin)))
- (with-blend (:color (color (value-of rg) (value-of gg) (value-of bg) (value-of ag)))
- (draw-image plane (v- (pos-of pin) (v 10 10))))))))
+ (event-loop ()
+ (draw-image* tile (v 0 0) (v 0 0) 800 600)
+ (with-blend (:color (color 0 0 0 64))
+ (draw-image plane (pos-of pin)))
+ (with-blend (:color (color (value-of rg) (value-of gg) (value-of bg) (value-of ag)))
+ (draw-image plane (v- (pos-of pin) (v 10 10))))))))
;; (test)
\ No newline at end of file
More information about the Pal-cvs
mailing list