[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