Add: scrolling star background naive implementation

4 files changed, 96 insertions, 0 deletions

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..6b136bc
--- /dev/null
+++ b/README.md
@@ -0,0 +1,9 @@
+# gridrunner-cl
+### _Your Name <your.name@example.com>_
+
+This is a project to do ... something.
+
+## License
+
+Specify license here
+
diff --git a/gridrunner-cl.asd b/gridrunner-cl.asd
new file mode 100644
index 0000000..e150b96
--- /dev/null
+++ b/gridrunner-cl.asd
@@ -0,0 +1,12 @@
+;;;; gridrunner-cl.asd
+
+(asdf:defsystem #:gridrunner-cl
+  :description "Describe gridrunner-cl here"
+  :author "Your Name <your.name@example.com>"
+  :license  "Specify license here"
+  :version "0.0.1"
+  :serial t
+  :depends-on (#:wheelwork
+	       #:defclass-std)
+  :components ((:file "package")
+               (:file "gridrunner-cl")))
diff --git a/gridrunner-cl.lisp b/gridrunner-cl.lisp
new file mode 100644
index 0000000..b9d2d20
--- /dev/null
+++ b/gridrunner-cl.lisp
@@ -0,0 +1,70 @@
+;;;; gridrunner-cl.lisp
+
+(in-package #:gridrunner-cl)
+
+(defclass/std gridrunner-cl (ww:application)
+  ((stars)))
+
+(defclass/std mobile ()
+  ((dx dy dr :std 0)))
+
+(defclass/std star-strip (mobile)
+  ((y canvas)))
+
+(defun make-star-strip (width height pos)
+  (let ((canvas (make-instance 'ww:canvas
+                              :pixel-width width
+                              :pixel-height height
+			      :y pos)))
+    
+    (setf (ww:width canvas) width
+          (ww:height canvas) height)
+    
+    (loop
+      for x from 0 below width
+      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)))))
+    canvas))
+
+
+(defun update-star-strip (ss)
+  (incf (ww::y ss) 3)
+  (when (> (ww::y ss) 1600)
+      (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)))))
+
+(defmethod ww::boot ((app gridrunner-cl))
+  (let* ((width (ww::application-width app))
+	 (height (ww::application-height app))
+	 (qht (/ height 4)))
+
+    (dotimes (n 5)
+      (push (make-star-strip width qht (float (* qht n))) (stars app)))
+    
+    (mapc #'ww:add-unit (stars app))
+    (ww:add-handler app #'run)))
+
+(defun start (&key (side 800))
+  (ww::start
+   (make-instance
+    'gridrunner-cl
+    :fps 60
+    :width side
+    :height (* side 2)
+    :refocus-on-mousedown-p nil
+    :title "GRIDRUNNER-CL"
+    :asset-root (merge-pathnames
+		 "assets/"
+		 (asdf:system-source-directory :gridrunner-cl)))))
+
diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..23da9c0
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,5 @@
+;;;; package.lisp
+
+(defpackage #:gridrunner-cl
+  (:use #:cl)
+  (:import-from #:defclass-std #:defclass/std))