diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | star-sprites.lisp | 37 |
2 files changed, 38 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..aeaec0f --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/*~ diff --git a/star-sprites.lisp b/star-sprites.lisp new file mode 100644 index 0000000..5aa4ec9 --- /dev/null +++ b/star-sprites.lisp @@ -0,0 +1,37 @@ +;;; sprite based star experiment + +(in-package #:gridrunner-cl) + +(defun update-star (s) + (incf (ww::y s) (random 3)) + (incf (ww::x s) 0) + (when (> (ww::y s) 1600) + (setf (ww::y s) -3))) + +(defun star-canvas (s) + (with-slots (color x y) s + (destructuring-bind (red green blue) color + (let ((canvas (make-instance 'ww:canvas :pixel-width 3 :pixel-height 3 :x x :y y))) + (loop for (x y) in '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2) (2 0) (2 1) (2 2)) + do (ww::with-pixel (r g b a) (ww::pixel canvas x y nil) + (setf r red g green b blue))) + canvas)))) + +(ww:defhandler run-with-stars + (ww::on-perframe (app ticks) + (with-slots (stars) app + (mapc #'update-star stars)))) + +(defclass/std star (mobile) + ((x y :std 0) + (color :std (rand-color)))) + +(defun make-stars (width height app) + (loop + for x from 0 to width + do (loop + for y from 0 to height + do (when (< 0.999 (random 1.0)) + (push (make-instance 'star :x x :y y) (stars app)))))) +; (make-stars width height app) +; (setf (stars app) (mapcar #'star-canvas (stars app))) |