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

18 Jul 2007

Update of /project/pal/cvsroot/pal/examples
In directory clnet:/tmp/cvs-serv1000/examples
Modified Files:
    hares.lisp images.lisp polygons.lisp 
Log Message:
Added DRAW-POLYGON*

--- /project/pal/cvsroot/pal/examples/hares.lisp	2007/07/13 21:30:58	1.2
+++ /project/pal/cvsroot/pal/examples/hares.lisp	2007/07/18 19:27:22	1.3
@@ -1,6 +1,5 @@
 ;;; Graphics and idea shamelessly ripped from Haaf's Game Engines (http://hge.relishgames.com/) 'Thousands of Hares' demo.
-
 (defpackage :pal-example
   (:use :cl :pal))
 (in-package :pal-example)
@@ -54,7 +53,7 @@
(defun example ()
-  (with-pal (:width 800 :height 600 :fullscreenp nil :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*))
+  (with-pal (:width 800 :height 600 :fullscreenp t :fps 6000 :paths (merge-pathnames "examples/" pal::*pal-directory*))
     (setf *sprites* nil)
     (set-cursor nil)
@@ -72,6 +71,7 @@
                      :angle (random 360f0)))
(event-loop ()
+
       (draw-image* (tag 'bg)
                    (v 0 0)
                    (v 0 0)
@@ -80,8 +80,7 @@
       (with-blend (:mode *blend-mode*)
         (dolist (i *sprites*)
           (draw i)
-          (act i)
-          ))
+          (act i)))
(test-keys
         (:key-1 (setf *blend-mode* nil))
--- /project/pal/cvsroot/pal/examples/images.lisp	2007/07/16 14:44:12	1.1
+++ /project/pal/cvsroot/pal/examples/images.lisp	2007/07/18 19:27:22	1.2
@@ -3,18 +3,43 @@
 (in-package :image-tests)
-(define-tags image-1 (image-from-fn 255 255 t
-                                    (lambda (x y)
-                                      (values x 0 x y)))
-             image-2 (image-from-array nil #2A(((255 255 255 128) (0 0 0) (255 255 255))
-                                               ((255 255 255) (255 255 0) (255 255 255))
-                                               ((255 255 255) (0 0 0) (255 255 255 128)))))
+(define-tags
+  ;; IMAGE-FROM-FN builds and image by calling the FN with x and y coordinates.
+  ;; FN should return at least three VALUES for r, g and b and an optional fourth value for alpha.
+  image-1 (image-from-fn 256 256 nil
+                         (lambda (x y)
+                           (values (truncate (+ 127 (* 128 (sin (/ x 10)))))
+                                   (truncate (+ 127 (* 128 (cos (/ y 10)))))
+                                   (truncate (+ 127 (* 128 (cos (/ (+ x y) 10)))))
+                                   (truncate (+ 127 (* 128 (cos (/ (- x y) 10))))))))
+  ;; IMAGE-FROM-ARRAY builds and image from an 2d array of (list r g b &optional a)
+  ;; Try setting the SMOOTHP parameter to T and see what happens.
+  image-2 (image-from-array nil #2A(((255 255 255 128) (0 0 0) (255 255 255))
+                                    ((255 255 255) (255 255 0) (255 255 255))
+                                    ((255 255 255) (0 0 0) (255 255 255 128)))))
(with-pal ()
-  (set-cursor (tag 'image-1))
-  (event-loop ()
-    (clear-screen 50 100 255)
-    (with-transformation (:scale 100f0)
-      (draw-image (tag 'image-2) (v 0 0)))))
\ No newline at end of file
+  (set-cursor (tag 'image-2)) ;; sets image-2 as a mouse cursor image
+  (let ((a 0f0))
+    (event-loop ()
+      (draw-polygon* (list (v 0 0)
+                           (v 800 0)
+                           (v 800 600)
+                           (v 0 600))
+                     :colors (list (list 255 0 0 255)
+                                   (list 255 0 0 255)
+                                   (list 0 0 255 255)
+                                   (list 0 0 255 255))) ;; just draws a nice gradient background
+
+      ;; And draw a pattern of image-1s on the top of it. Not exactly seamlessly tiled but hey...
+      (draw-rectangle (v 0 0) 800 600 255 255 255 255 :fill (tag 'image-1))
+
+      ;; let's scale up a bit to see what the image-2 looks like.
+      (with-transformation (:pos (v 400 300) :scale a)
+        (draw-image (tag 'image-2)
+                    (v 0 0)
+                    :valign :middle
+                    :halign :middle
+                    :angle (incf a .5f0))))))
\ No newline at end of file
--- /project/pal/cvsroot/pal/examples/polygons.lisp	2007/07/16 20:46:24	1.3
+++ /project/pal/cvsroot/pal/examples/polygons.lisp	2007/07/18 19:27:22	1.4
@@ -4,9 +4,10 @@
(with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*))
-  (let ((grid (load-image "bg2.png"))
+  (let ((angle 0f0)
+        (grid (load-image "bg2.png"))
         (plane (load-image "lego-plane.png" t))
-        (slad (load-image "save_lisp.gif"))
+        (slad (load-image "save_lisp.gif" t))
         (teddy (load-image "yellow-teddy.png")))
     (set-cursor nil)
     (event-loop ()
@@ -70,6 +71,20 @@
                         :absolutep t
                         :fill slad))
+      ;; DRAW-POLYGON* takes a list of vertex coordinates and as keyword arguments a list of texture coordinates(in pixels) for each vertex,
+      ;; an image, and a list of lists of rgba values to use for each vertex.
+
+      (with-transformation (:pos (v 600 100) :angle (incf angle .5f0))
+        (draw-polygon* (list (v 00 10)
+                             (v 100 200)
+                             (v -100 200))
+                       :image slad
+                       :tex-coords (list (v 280 240)
+                                         (v 380 310)
+                                         (v 170 310))
+                       :colors (list (list 255 255 255 255)
+                                     (list 255 0 0 255)
+                                     (list 0 0 255 0))))
;; 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

    