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

Modified Files: images.lisp Log Message: Added LOAD-IMAGE-TO-ARRAY, few bug fixes.

--- /project/pal/cvsroot/pal/examples/images.lisp 2007/07/18 19:27:22 1.2 +++ /project/pal/cvsroot/pal/examples/images.lisp 2007/07/19 16:37:25 1.3 @@ -2,11 +2,12 @@ (:use :cl :pal)) (in-package :image-tests)

+(defparameter *foo* nil)

(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 + image-1 (image-from-fn 255 255 nil (lambda (x y) (values (truncate (+ 127 (* 128 (sin (/ x 10))))) (truncate (+ 127 (* 128 (cos (/ y 10))))) @@ -16,12 +17,20 @@ ;; 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))))) + ((255 255 255) (0 0 0) (255 255 255 128))))

+ ;; LOAD-IMAGE-TO-ARRAY does exactly what it says. Let's load the plane image and randomize the alpha values a bit. + image-3 (image-from-array nil + (let ((image (load-image-to-array "lego-plane.png"))) + (do-n (x (array-dimension image 0) y (array-dimension image 1)) + (when (> (fourth (aref image x y)) 200) + (setf (fourth (aref image x y)) (+ (random 128) 127)))) + image)))

-(with-pal () - (set-cursor (tag 'image-2)) ;; sets image-2 as a mouse cursor image + +(with-pal (:paths (merge-pathnames "examples/" pal::*pal-directory*)) + (set-cursor (tag 'image-3)) ;; sets image-3 as a mouse cursor image (let ((a 0f0)) (event-loop () (draw-polygon* (list (v 0 0) @@ -33,7 +42,7 @@ (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... + ;; And draw a pattern of image-1s on the top of it. Not exactly seamless tiles 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.