[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