Add: scrolling star-strip frameset implementation

1 files changed, 43 insertions, 26 deletions

diff --git a/gridrunner-cl.lisp b/gridrunner-cl.lisp
index b9d2d20..e43571a 100644
--- a/gridrunner-cl.lisp
+++ b/gridrunner-cl.lisp
@@ -8,50 +8,68 @@
 (defclass/std mobile ()
   ((dx dy dr :std 0)))
 
-(defclass/std star-strip (mobile)
-  ((y canvas)))
+(defun rand-color ()
+  (list (random 256) (random 256) (random 256)))
 
-(defun make-star-strip (width height pos)
+(defun black ()
+  (list 0 0 0))
+
+(defun trans-canvas (width height)
   (let ((canvas (make-instance 'ww:canvas
-                              :pixel-width width
-                              :pixel-height height
-			      :y pos)))
-    
-    (setf (ww:width canvas) width
-          (ww:height canvas) height)
-    
+			       :pixel-width width
+			       :pixel-height height)))
+    (ww::clear-canvas canvas :a 0)
+    canvas))
+
+(defun fill-with-stars (canvas)
+  (let ((w (ww::pixel-width canvas))
+	(h (ww::pixel-height canvas)))
     (loop
-      for x from 0 below width
+      for x from 0 to w
       do (loop
-	   for y from 0 below height
-	   do (if (< 0.999 (random 1.0))
-		  (ww::with-pixel (r g b a) (ww::pixel canvas x y nil)
-		    (setf r (random 256)
-			  g (random 256)
-			  b (random 256)))
-		  (ww::with-pixel (r g b a) (ww::pixel canvas x y nil) (setf r 0 g 0 b 0)))))
+	   for y from 0 to h
+	   do (when (< 0.999 (random 1.0))
+		(ww::with-pixels-rect
+		    (_x _y r g b a)
+		    (canvas :left (max 0 (1- x)) :right (min w (1+ x))
+			    :top (min h (1+ y)) :bottom (max 0 (1- y)))
+		  (setf r (random 256)
+			g (random 256)
+			b (random 256)
+			a 255)))))
+    (ww:blit canvas)
     canvas))
 
+(defun make-star-strip (width height pos)
+  (let ((strip (make-instance
+		'ww:frameset
+		:frames (make-array
+			 2
+			 :initial-contents
+			 (loop repeat 2
+			       collect (fill-with-stars (trans-canvas width height))))
+		:sequence #(0 1))))
+    (setf (ww::y strip) pos)
+    strip))
 
 (defun update-star-strip (ss)
-  (incf (ww::y ss) 3)
+  (incf (ww::y ss) 2)
   (when (> (ww::y ss) 1600)
-      (setf (ww::y ss) -400)))
+    (setf (ww::y ss) -400)))
 
 (ww:defhandler run
     (ww::on-perframe (app ticks)
       (with-slots (stars) app
-	(mapc #'update-star-strip stars)
-	(mapc #'ww:blit (stars app)))))
+	(mapc #'update-star-strip stars))))
 
 (defmethod ww::boot ((app gridrunner-cl))
   (let* ((width (ww::application-width app))
 	 (height (ww::application-height app))
-	 (qht (/ height 4)))
+	 (one-fourth (/ height 4)))
 
     (dotimes (n 5)
-      (push (make-star-strip width qht (float (* qht n))) (stars app)))
-    
+      (push (make-star-strip width one-fourth (* n one-fourth)) (stars app)))
+
     (mapc #'ww:add-unit (stars app))
     (ww:add-handler app #'run)))
 
@@ -67,4 +85,3 @@
     :asset-root (merge-pathnames
 		 "assets/"
 		 (asdf:system-source-directory :gridrunner-cl)))))
-