[pal-cvs] CVS pal/examples

tneste tneste at common-lisp.net
Fri Jul 13 21:30:59 UTC 2007


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

Modified Files:
	hares.lisp hello.lisp polygons.lisp swarm.lisp teddy.lisp 
Log Message:
Rest of the api changes applied.

--- /project/pal/cvsroot/pal/examples/hares.lisp	2007/06/28 20:14:05	1.1
+++ /project/pal/cvsroot/pal/examples/hares.lisp	2007/07/13 21:30:58	1.2
@@ -32,8 +32,10 @@
   (set-blend-color (r-of s) (g-of s) (b-of s) 255)
   (draw-image (image-of s)
               (pos-of s)
-              (angle-of s)
-              (scale-of s)))
+              :halign :middle
+              :valign :middle
+              :angle (angle-of s)
+              :scale (scale-of s)))
 
 (defmethod act ((s sprite))
   (setf (angle-of s) (mod (+ (angle-of s) 1f0) 360))
@@ -52,7 +54,7 @@
 
 
 (defun example ()
-  (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000)
+  (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*))
     (setf *sprites* nil)
     (set-cursor nil)
 
@@ -70,11 +72,11 @@
                      :angle (random 360f0)))
 
     (event-loop ()
-      (draw-image-from (tag 'bg)
-                       (v 0 0)
-                       (v 0 0)
-                       (get-screen-width)
-                       (get-screen-height))
+      (draw-image* (tag 'bg)
+                   (v 0 0)
+                   (v 0 0)
+                   (get-screen-width)
+                   (get-screen-height))
       (with-blend (:mode *blend-mode*)
         (dolist (i *sprites*)
           (draw i)
--- /project/pal/cvsroot/pal/examples/hello.lisp	2007/07/03 18:42:33	1.4
+++ /project/pal/cvsroot/pal/examples/hello.lisp	2007/07/13 21:30:58	1.5
@@ -3,17 +3,22 @@
 
 
 (defun hello-1 ()
-  (pal:with-pal (:paths "/path/to/examples/")
+  (pal:with-pal (:title "Hello!" :paths (merge-pathnames "examples/" pal::*pal-directory*))
     (let ((font (pal:load-font "georgia")))
-      (pal:draw-text "Hello from PAL"
-                     (pal:v-round
-                      (pal:v (/ (- (pal:get-screen-width)
-                                   (pal:get-text-size "Hello from PAL" font))
-                                2)
-                             (/ (- (pal:get-screen-height)
-                                   (pal:get-font-height font))
-                                2)))
-                     font))
+      (loop for y from 0 to 300 by 2 do
+           (pal:draw-line (pal:v 0 (* y 2)) (pal:v 800 (* y 2))
+                          50 50 255 (truncate y 2)))
+      (let ((midpoint (pal:v-round
+                       (pal:v (/ (- (pal:get-screen-width)
+                                    (pal:get-text-size "Hello from PAL" font))
+                                 2)
+                              (/ (- (pal:get-screen-height)
+                                    (pal:get-font-height font))
+                                 2)))))
+        (pal:set-blend-color 0 0 0 255)
+        (pal:draw-text "Hello from PAL" (pal:v+ midpoint (pal:v 5 5)) font)
+        (pal:reset-blend-mode)
+        (pal:draw-text "Hello from PAL" midpoint font)))
     (pal:wait-keypress)))
 
 ;; (hello-1)
--- /project/pal/cvsroot/pal/examples/polygons.lisp	2007/07/13 13:21:04	1.1
+++ /project/pal/cvsroot/pal/examples/polygons.lisp	2007/07/13 21:30:58	1.2
@@ -3,22 +3,34 @@
 (in-package :poly-tests)
 
 
-(with-pal ()
+(with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*))
   (let ((grid (load-image "bg2.png"))
+        (plane (load-image "lego-plane.png" t))
         (slad (load-image "save_lisp.gif"))
         (teddy (load-image "yellow-teddy.png")))
     (event-loop ()
 
-      ;; DRAW-RECTANGLE just draws a filled or wireframe rectangle on screen
-
       (draw-rectangle (v 0 0)
                       800 600
-                      0 0 0 32 :filledp t)
+                      0 0 0 32) ;; Draw a black, transparent rectangle over the scene.
+      ;; (clear-screen 0 0 0) ;; Use this instead if the afterimages give you a headache.
+
+      ;; DRAW-IMAGE draw the whole image at given position. Keyword arguments can be given to define the
+      ;; scale, angle and horizontal and vertical alignment ("hotspot")
+
+      (draw-image plane
+                  (v 700 500)
+                  :halign :middle ;; Possible options are :left, :right and :middle. :left is the default.
+                  :valign :bottom ;; -''- :top, :bottom, :middle. :top is the default.
+                  :angle (v-angle (v-direction (v 700 500) (get-mouse-pos))) ;; angle in degrees
+                  :scale (* (v-distance (v 700 500) (get-mouse-pos)) .01f0))
+
+      (draw-point (v 700 500) 255 0 0 255 :size 10f0) ;; Draw a red point at the hotspot of previous image.
 
       ;; DRAW-POLYGON draw a polygon which vertexes are given as a list of VECs.
-      ;; FILL is either nil, true or image that is used as a pattern. If fill is an image the rgba values are not used.
+      ;; FILL is either nil, t or image that is used as a pattern. If fill is an image the rgba values have no effect.
       ;; When ABSOLUTEP is T image patterns position is decided by screen coordinates.
-
+      ;; Max value of SIZE depends on the OpenGL implementation, you probably shouldn't use values greater than 10f0
 
       (with-transformation (:pos (v 100 100))
         (draw-polygon (list (v -100 0)
@@ -35,34 +47,39 @@
                             (v -50 100)
                             )
                       255 0 0 255
-                      :fill nil :size 5f0
+                      :fill nil :size 4f0
                       :absolutep nil))
 
-      ;; Note: next one doesn't work like you might expect since the image size is rounded up
-      ;; to the nearest power of two and the extra is filled with blank.
-
-      (with-blend (:color '(255 255 255 20))
-        (draw-polygon (list (v+ (get-mouse-pos) (v -100 -100))
-                            (v+ (get-mouse-pos) (v 100 -100))
-                            (v+ (get-mouse-pos) (v 100 100))
-                            (v+ (get-mouse-pos) (v -100 100)))
-                      0 0 0 0
-                      :absolutep t
-                      :fill slad))
 
 
-      ;; DRAW-IMAGE-FROM draws a part of image, defined by a starting point, width and height.
-      ;; If width or height are larger than the source image the image is tiled
+      ;; DRAW-RECTANGLEs arguments are similar to DRAW-POLYGON
+      ;; Notice how the size of the actual SLAD image used is expanded up to the nearest power of two and the extra space is filled with blank,
+      ;; usually this happens transparently to the user (eg. image-width returns the original width of image) but in some cases
+      ;; it can cause some artifacts. In this case if the original image had width and height of power of two it would be seamlessly
+      ;; tiled across the screen.
+      ;; For example, image of size 65x30 will be expanded to the size 128x32, so it is a
+      ;; good idea to try and fit the image sizes inside the nearest power of two to save memory.
+
+      (with-blend (:color '(255 255 255 128))
+        (draw-rectangle (get-mouse-pos)
+                        100 100
+                        0 0 0 0
+                        :absolutep t
+                        :fill slad))
 
-      (draw-image-from teddy (v 0 (get-mouse-y))
-                       (v (get-mouse-x) 0)
-                       (truncate (image-width teddy) 2)
-                       (get-screen-height))
-      (draw-image-from teddy (v (truncate (image-width teddy) 2) (get-mouse-y) )
-                       (v (- (get-screen-width) (get-mouse-x)) 0)
-                       (truncate (image-width teddy) 2)
-                       (get-screen-height))
 
-      ;; (draw-quad ...) to be done
+      ;; DRAW-IMAGE* draws a part of image, defined by a starting point, width and height.
+      ;; If width or height are larger than the source image the image is tiled
+      ;; Like with DRAW-POLYGON non-power-of-two image sizes can give unexpected results.
 
-      )))
\ No newline at end of file
+      (let ((x (abs (- 400 (get-mouse-x)))))
+        (draw-image* teddy
+                     (v 0 (get-mouse-y))
+                     (v x 0)
+                     (truncate (image-width teddy) 2)
+                     (get-screen-height))
+        (draw-image* teddy
+                     (v (truncate (image-width teddy) 2) (get-mouse-y) )
+                     (v (- (get-screen-width) x) 0)
+                     (truncate (image-width teddy) 2)
+                     (get-screen-height))))))
\ No newline at end of file
--- /project/pal/cvsroot/pal/examples/swarm.lisp	2007/07/03 18:42:33	1.2
+++ /project/pal/cvsroot/pal/examples/swarm.lisp	2007/07/13 21:30:58	1.3
@@ -9,13 +9,13 @@
                                         (setf vectors (append vectors (loop repeat 50 collecting (cons (pal:get-mouse-pos)
                                                                                                        (pal:v-random 5f0))))))))
         (pal:draw-rectangle (pal:v 0 0) 1024 768 0 0 0 128)
-        (pal:with-blend (:r 255 :g 128 :b 128 :a 255)
+        (pal:with-blend (:color '(255 128 128 255))
           (pal:draw-text "Use left mousekey to add particles." (pal:v 0 0)))
 
         (let ((midpoint (pal:v/ (reduce 'pal:v+ vectors :initial-value (pal:v 0 0) :key 'car)
                                 (max 1f0
                                      (coerce (length vectors) 'single-float)))))
-          (pal:draw-point midpoint 255 0 0 255 10f0)
+          (pal:draw-point midpoint 255 0 0 255 :size 10f0)
           (setf vectors (mapcar (lambda (v)
                                   (cons (pal:v+ (car v) (cdr v))
                                         (pal:v* (pal:v+ (cdr v)
@@ -31,6 +31,6 @@
             (pal:draw-arrow (car v)
                             (pal:v+ (car v) (cdr v))
                             10 7 0 255
-                            10f0)))))))
+                            :size 10f0)))))))
 
 ;; (swarm)
\ No newline at end of file
--- /project/pal/cvsroot/pal/examples/teddy.lisp	2007/07/01 22:49:25	1.2
+++ /project/pal/cvsroot/pal/examples/teddy.lisp	2007/07/13 21:30:58	1.3
@@ -22,6 +22,7 @@
 (defclass sprite ()
   ((pos :accessor pos-of :initarg :pos :initform (v 0 0))
    (vel :accessor vel-of :initarg :vel :initform (v 0 0))
+   (alt :accessor alt-of :initarg :alt :initform 10)
    (image :accessor image-of :initarg :image)
    (angle :accessor angle-of :initarg :angle :initform 0f0)))
 
@@ -36,7 +37,9 @@
 (defmethod draw ((s sprite))
   (draw-image (image-of s)
               (pos-of s)
-              (angle-of s)))
+              :valign :middle
+              :halign :middle
+              :angle (angle-of s)))
 
 
 
@@ -64,15 +67,19 @@
 
 
 (defun example ()
-  (with-pal (:width 800 :height 600 :fullscreenp nil :fps 60)
+  (with-pal (:width 800 :height 600 :fullscreenp nil :fps 60 :paths (merge-pathnames "examples/" pal::*pal-directory*))
     ;; inits PAL, the args used are the default values.
-    ;; NOTE: fix the PATHS to point to the location of the resource files
-    ;; PATHS is a pathname or list of pathnames that defines paths that the LOAD-* functions use for finding resources.
+    ;; PATHS is a pathname or list of pathnames that PAL uses to find the resource files loaded with LOAD-* functions.
+    ;; By default PATHS contains the PAL source directory and value of *default-pathname-defaults*
     ;; only call PAL functions (with the expection of DEFINE-TAGS forms) inside WITH-PAL or between OPEN-PAL and CLOSE-PAL
 
     (setf *sprites* nil)
+
+    ;; Hide the mouse cursor and use cursor.png instead. 18,18 is the offset ("hotspot") for the cursor image
+    ;; Other possible options to cursor are: t - show the default cursor, nil - hide all cursors
     (set-cursor (tag 'cursor) (v 18 18))
-    (make-instance 'plane)
+
+    (make-instance 'plane :alt 20)
     (dotimes (i 20)
       (make-instance 'mutant-teddy
                      :pos (v (random (get-screen-width))
@@ -82,35 +89,47 @@
 
     (event-loop ()
       ;; simple event loop, no mouse-move, key-down etc. handlers defined, we'll handle input explicitly with TEST-KEYS.
-      ;; the default key-down handler quits the event-loop when ESC is pressed.
-      ;; to define e.g. a key-handler use a form like (event-loop (:key-down-handler (lambda (key) ...)) ...)
+      ;; The default key-down handler quits the event-loop when ESC is pressed, if you define your own key-down-handler
+      ;; don't forget to make sure there is a way to quit pal (especially when in fullscreen).
+      ;; to define e.g. a key-handler use a form like (event-loop (:key-down-fn (lambda (key) ...)) ...)
       ;; you can quit the event loop with (return-from event-loop)
 
       ;; first, draw a scrolling tiled background
-      (draw-image-from (tag 'tile)
-                       (v 0 0)
-                       (v 0 (- *y-scroll* 64))
-                       (get-screen-width)
-                       (+ (get-screen-height) 64))
+      (draw-image* (tag 'tile)
+                   (v 0 0)
+                   (v 0 (- *y-scroll* 64))
+                   (get-screen-width)
+                   (+ (get-screen-height) 64))
       (setf *y-scroll* (mod (+ *y-scroll* 1) 64))
 
-      ;; then the sprites
+      ;; then the sprites, first the shadows
+      ;; sorting the sprites and their shadows according to their altitude is left as an exercise to the reader
+
+      (with-blend (:color '(0 0 0 128))
+        (dolist (i *sprites*)
+          (with-transformation (:pos (v (alt-of i) (alt-of i)))
+            (draw i))))
+
       (with-blend (:mode *blend-mode*)
         (dolist (i *sprites*)
           (draw i)
+
+          ;; Let's do this for CLisp or we might a get nasty floating-point-undereflow error in the vector operations.
           #+CLISP (ext:without-floating-point-underflow
                       (act i))
           #-CLISP (act i)))
 
+      ;; TEST-KEYS is used to check if some key is currently pressed, _all_ the matching forms are evaluated.
       (test-keys
         (:key-1 (setf *blend-mode* nil)
                 (message *blend-mode*))
         (:key-2 (setf *blend-mode* :blend)
                 (message *blend-mode*))
-        (:key-3 (setf *blend-mode* :additive)
-                (message *blend-mode*)))
+        ;; We can also test for several keys at once:
+        ((:key-3 :key-space :key-mouse-1) (setf *blend-mode* :additive)
+         (message *blend-mode*)))
 
-      (draw-fps)
+      (draw-fps) ;; Draw the frames/second counter to the top left corner.
       (draw-text "Press key to select blend-mode:" (v 200 (* 0 (get-font-height))))
       (draw-text "1=nil 2=:blend 3=:additive" (v 200 (* 1 (get-font-height)))))))
 




More information about the Pal-cvs mailing list