[pal-cvs] CVS pal-gui/examples

tneste tneste at common-lisp.net
Tue Oct 30 20:44:45 UTC 2007


Update of /project/pal/cvsroot/pal-gui/examples
In directory clnet:/tmp/cvs-serv32566/examples

Modified Files:
	colors.lisp packing.lisp test.lisp 
Log Message:
GET-MIN-HEIGHT/WIDTH didn't work under CLisp, fixed.
Widgets now use PAL:COLOR structure where appropriate.

--- /project/pal/cvsroot/pal-gui/examples/colors.lisp	2007/10/29 20:06:01	1.1
+++ /project/pal/cvsroot/pal-gui/examples/colors.lisp	2007/10/30 20:44:45	1.2
@@ -1,13 +1,11 @@
 (in-package :pal-gui)
 
 
-(defstruct color r g b)
-
-(defparameter *bg* (make-color :r 0 :g 0 :b 0))
+(defparameter *bg* (color 0 0 0 255))
 
 (defmethod present ((c color) w width height)
-  (with-blend (:color (list (color-r c) (color-g c) (color-b c) 255))
-    (draw-text (format nil "#~16R~16R~16R" (color-r c) (color-g c) (color-b c)) (get-text-offset))))
+  (with-blend (:color c)
+    (draw-text (format nil "#~16R~16R~16R" (color-r c) (color-g c) (color-b c)) *text-offset*)))
 
 (defmethod present ((c color) (w list-view) width height)
   (draw-rectangle (v 0 0) width height (color-r c) (color-g c) (color-b c) 255))
@@ -21,9 +19,7 @@
            (list (make-instance 'list-widget :parent window
                                              :on-select (lambda (g)
                                                           (setf (value-of button) (selected-of g)))
-                                             :items (loop repeat 100 collecting (make-color :r (random 255)
-                                                                                            :g (random 255)
-                                                                                            :b (random 255))))))
+                                             :items (loop repeat 100 collecting (random-color)))))
 
       (setf (on-select-of button) (lambda (g)
                                     (setf *bg* (selected-of list))))
--- /project/pal/cvsroot/pal-gui/examples/packing.lisp	2007/10/29 21:09:20	1.2
+++ /project/pal/cvsroot/pal-gui/examples/packing.lisp	2007/10/30 20:44:45	1.3
@@ -20,12 +20,11 @@
             (f (make-instance 'button :value "a Button" :parent left-box)))
 
         (gui-loop ()
-          (clear-screen 50 50 255))))))
+                  (clear-screen 50 50 255))))))
 
 ;; (test)
 
 
-
 (defun test ()
   (with-gui ()
     (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200)))
@@ -35,7 +34,7 @@
             (c (make-instance 'button :value "Foo" :parent window :y-expand-p t)))
 
         (gui-loop ()
-          (clear-screen 50 50 255))))))
+                  (clear-screen 50 50 255))))))
 
 ;; (test)
 
@@ -56,6 +55,6 @@
         (loop repeat 10 do (make-instance 'pin :value "Foo" :b 0 :pos (v (random 800) (random 600))))
 
         (gui-loop ()
-          (clear-screen 50 50 255))))))
+                  (clear-screen 50 50 255))))))
 
 ;; (test)
\ No newline at end of file
--- /project/pal/cvsroot/pal-gui/examples/test.lisp	2007/10/30 00:20:40	1.12
+++ /project/pal/cvsroot/pal-gui/examples/test.lisp	2007/10/30 20:44:45	1.13
@@ -1,8 +1,8 @@
 ;; TODO:
 ;;
-;; window sizing, dialogs, menus, keyboard control, scrollwheel, fix pal's clipping
+;; window sizing, dialogs, menus, keyboard control, scrollwheel
 ;; debugging utils, scrolling mixin
-;; joystick, scroll box, paragraph, text box, simple editor, combo box, tree view, gridbox, property list
+;; scroll box, paragraph, text box, simple editor, combo box, tree view, gridbox, property list
 ;; File open/save, choose directory, yes/no dialogs
 
 (defpackage :test
@@ -34,7 +34,7 @@
            (ag (make-instance 'h-gauge :parent left-box
                                        :min-value 0 :max-value 255 :value 0))
            (list (make-instance 'list-widget :parent window-2
-                                             :item-height 64
+                                             :item-height 48
                                              :items (loop for i from 0 to 50 collect (format nil "FooBar ~a" i))
                                              :multip nil
                                              :on-select (lambda (g)
@@ -44,14 +44,14 @@
                                                  :parent window-2
                                                  :on-select (lambda (g) (setf (items-of list) (remove-if-not 'image-p pal-ffi::*resources*)))))
            (choice (make-instance 'choice-widget :label "Foo" :parent window-2 :items '("First" "Second" "and Third")))
-           (pin (make-instance 'pin :value "Plane" :pos (v 400 300) :a 128))
+           (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 '(0 0 0 64))
+        (with-blend (:color (color 0 0 0 64))
           (draw-image plane (pos-of pin)))
-        (with-blend (:color (list (value-of rg) (value-of gg) (value-of bg) (value-of ag)))
+        (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