[pal-cvs] CVS pal-gui/examples - pal-cvs@common-lisp.net - mailman3.common-lisp.net

15 Oct 2007


      Update of /project/pal/cvsroot/pal-gui/examples
In directory clnet:/tmp/cvs-serv26366/examples
Added Files:
    test.lisp 
Log Message:
Project created.
--- /project/pal/cvsroot/pal-gui/examples/test.lisp	2007/10/15 19:14:36	NONE
+++ /project/pal/cvsroot/pal-gui/examples/test.lisp	2007/10/15 19:14:36	1.1
(in-package :pal-gui)
(define-tags plane (load-image "lego-plane.png")
             tile (load-image "ground.png"))
(defun test ()
  (with-gui (:paths (merge-pathnames "examples/" pal::*pal-directory*))
    (let* ((window (make-instance 'window :pos (v 200 200) :width 300 :height 200))
           (slider (make-instance 'v-slider :pos (v 250 20) :height 150 :parent window :max-value 200 :page-size 100))
           (meter (make-instance 'h-meter :pos (v 30 50) :width 150 :parent window :max-value 80 :display-fn (lambda (v) (format nil "FPS: ~a" v))))
           (gauge (make-instance 'h-gauge :pos (v 30 20)
                                          :width 150
                                          :parent window
                                          :min-value 0 :max-value 255 :value 0 :display-fn (lambda (v) (format nil "R: ~a" v))))
           (button (make-instance 'button :pos (v 100 100) :value "FooBar!"  :parent window)))
(gui-loop ()
        (setf (value-of button) (value-of slider))
        (setf (value-of meter) (get-fps))
        (draw-image* (tag 'tile) (v 0 0) (v 0 0) 800 600)
        (with-blend (:color (list (value-of gauge) 0 0 64))
          (draw-image (tag 'plane) (v 320 220)))
        (draw-image (tag 'plane) (v 300 200))))))
;; (test)