Update of /project/pal/cvsroot/pal-gui/examples In directory clnet:/tmp/cvs-serv701/examples Modified Files: test.lisp Added Files: colors.lisp files.lisp packing.lisp Log Message: Added more examples. Numerous other improvements. Nearing v 0.1 --- /project/pal/cvsroot/pal-gui/examples/test.lisp 2007/10/24 19:59:56 1.9 +++ /project/pal/cvsroot/pal-gui/examples/test.lisp 2007/10/29 20:06:01 1.10 @@ -1,25 +1,28 @@ ;; TODO: ;; -;; Exports, window sizing, box labels, dialogs, menus, tooltips, keyboard control, scrollwheel, fix pal's clipping -;; label, radio box, check box, joystick, scroll box, paragraph, text box, simple editor, drop box, tree view, gridbox +;; Exports, window sizing dialogs, menus, tooltips, keyboard control, scrollwheel, fix pal's clipping +;; radio box, check box, joystick, scroll box, paragraph, text box, simple editor, combo box, tree view, gridbox, property list ;; File open/save, directory, yes/no dialogs -(in-package :pal-gui) +(defpackage :test + (:use :cl :pal :pal-gui)) +(in-package :test) -(define-tags plane (load-image "lego-plane.png") - tile (load-image "ground.png")) (defun test () - (with-gui (:fps 200 :paths (merge-pathnames "examples/" pal::*pal-directory*)) - (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 350)) + (with-gui (:paths (merge-pathnames "examples/" pal::*pal-directory*)) + (let* ((plane (load-image "lego-plane.png")) + (tile (load-image "ground.png")) + + (window (make-instance 'window :pos (v 200 200) :width 300 :height 240)) (window-2 (make-instance 'window :width 200 :height 300)) (box (make-instance 'h-box :parent window)) (left-box (make-instance 'v-box :parent box :label "RGBA")) (right-box (make-instance 'v-box :parent box :label "Current FPS")) - (bottom-box (make-instance 'v-box :parent window :label "Bar")) + (bottom-box (make-instance 'v-box :parent window :label "Bar" :y-expand-p nil)) - (meter (make-instance 'h-meter :parent right-box :max-value 100)) + (meter (make-instance 'h-meter :parent right-box :max-value 100 :on-repaint (lambda (g) (setf (value-of g) (get-fps)) nil))) (rg (make-instance 'h-gauge :parent left-box :min-value 0 :max-value 255 :value 0)) (gg (make-instance 'h-gauge :parent left-box @@ -28,20 +31,24 @@ :min-value 0 :max-value 255 :value 0)) (ag (make-instance 'h-gauge :parent left-box :min-value 0 :max-value 255 :value 0)) - (list (make-instance 'list-box :parent window-2 :items (loop for i from 0 to 30 collect (format nil "FooBar ~a" i)) - :multip nil - :on-select (lambda (g) - (message (value-of g))))) - (button (make-instance 'button :value "FooBar!" :parent window-2 :on-select (lambda (g) (message 'foo) (setf (parent-of g) nil)))) - (choice (make-instance 'choice-box :label "Foo" :parent window-2 :items '(Foo Bar Bazzo)))) + (list (make-instance 'list-widget :parent window-2 + :item-height 64 + :items (loop for i from 0 to 50 collect (format nil "FooBar ~a" i)) + :multip nil + :on-select (lambda (g) + (message (selected-of g))))) + (button (make-instance 'button :value :circle + :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 '(Foo Bar Baz))) + (pin (make-instance 'pin :value "Plane" :pos (v 400 300) :a 128)) + (text (make-instance 'text-widget :text "Text" :parent bottom-box))) - (make-instance 'button :value "Button" :parent bottom-box) (gui-loop () - (setf (value-of meter) (get-fps)) - (draw-image* (tag 'tile) (v 0 0) (v 0 0) 800 600) + (draw-image* tile (v 0 0) (v 0 0) 800 600) (with-blend (:color '(0 0 0 64)) - (draw-image (tag 'plane) (v 320 220))) + (draw-image plane (pos-of pin))) (with-blend (:color (list (value-of rg) (value-of gg) (value-of bg) (value-of ag))) - (draw-image (tag 'plane) (v 300 200))))))) + (draw-image plane (v- (pos-of pin) (v 10 10)))))))) ;; (test) \ No newline at end of file --- /project/pal/cvsroot/pal-gui/examples/colors.lisp 2007/10/29 20:06:01 NONE +++ /project/pal/cvsroot/pal-gui/examples/colors.lisp 2007/10/29 20:06:01 1.1 (in-package :pal-gui) (defstruct color r g b) (defparameter *bg* (make-color :r 0 :g 0 :b 0)) (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)))) (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)) (defun test () (with-gui (: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)) (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)))))) (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*)))))) ;; (test)--- /project/pal/cvsroot/pal-gui/examples/files.lisp 2007/10/29 20:06:01 NONE +++ /project/pal/cvsroot/pal-gui/examples/files.lisp 2007/10/29 20:06:01 1.1 (in-package :pal-gui) (defclass file-list (v-box) ((list-widget :accessor list-widget-of) (text-widget :accessor text-widget-of) (select :accessor select-of)) (:default-initargs :gap 2)) (defmethod initialize-instance :after ((g file-list) &key &allow-other-keys) (setf (list-widget-of g) (make-instance 'list-widget :parent g :on-select (lambda (lg) (setf (text-of (text-widget-of g)) (selected-of lg))))) (let ((hbox (make-instance 'h-box :parent g :gap 2 :y-expand-p nil))) (setf (text-widget-of g) (make-instance 'text-widget :parent hbox)) (setf (select-of g) (make-instance 'button :x-expand-p nil :width (get-m) :value :box :parent hbox))) (update-view g)) (defmethod update-view ((g file-list)) (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 "*")))) (defun test () (with-gui () (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200)) (hbox (make-instance 'file-list :parent window :label "Choose"))) (gui-loop () (clear-screen 150 150 150))))) ;; (test)--- /project/pal/cvsroot/pal-gui/examples/packing.lisp 2007/10/29 20:06:01 NONE +++ /project/pal/cvsroot/pal-gui/examples/packing.lisp 2007/10/29 20:06:01 1.1 (in-package :pal-gui) (defun test () (with-gui () (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 240)) (hbox (make-instance 'h-box :parent window)) (left-box (make-instance 'v-box :parent hbox :label "Left")) (right-box (make-instance 'v-box :parent hbox :label "Right")) (bottom-box (make-instance 'v-box :parent window :label "Bottom" :y-expand-p nil))) (let ((a (make-instance 'button :value "Button" :parent right-box)) (b (make-instance 'button :value "Button" :parent right-box)) (c (make-instance 'button :value "Button" :parent right-box)) (d (make-instance 'button :value "Button" :parent right-box)) (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)))))) ;; (test) (defun test () (with-gui () (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)))))) ;; (test) (defun test () (with-gui () (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)) (pin (make-instance 'pin :value "Foo" :g 30 :b 30 :parent box :pos (v 100 30))) (a (make-instance 'button :value "Button" :parent hbox)) (f (make-instance 'filler :parent hbox)) (b (make-instance 'button :value "Button" :parent hbox)) (vbox (make-instance 'v-box :label "foo" :parent hbox :width 30 :x-expand-p nil)) (c (make-instance 'button :value "Foo" :parent vbox))) (loop repeat 10 do (make-instance 'pin :value "Foo" :b 0 :pos (v (random 800) (random 600)))) (gui-loop () (clear-screen 50 50 255)))))) ;; (test)