# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1491950325 0
# Node ID 4fce923d387e51060ba65d3de996fbea0c823df4
# Parent  55af36925fd10f09a3a1b271cda6a0c3f8c5d54e
Particles!

diff -r 55af36925fd1 -r 4fce923d387e examples/particles.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples/particles.lisp	Tue Apr 11 22:38:45 2017 +0000
@@ -0,0 +1,171 @@
+(ql:quickload '(:cl-blt :losh :iterate))
+
+(defpackage :cl-blt.examples.particles
+  (:use :cl :losh :iterate))
+
+(in-package :cl-blt.examples.particles)
+
+;;;; Data ---------------------------------------------------------------------
+(defparameter *running* nil)
+(defparameter *mspf* 0)
+(defparameter *mouse* nil)
+(defparameter *particles* nil)
+
+
+;;;; Utils --------------------------------------------------------------------
+(defun noop (particle ms)
+  (declare (ignore particle ms)))
+
+(defun random-glyph ()
+  (random-elt "*!#?.,-:;'"))
+
+(defun random-color ()
+  (let ((v (random-range 0.5 1.0)))
+    (ecase (random 3)
+      (0 (blt:rgba 1.0 v v 1.0))
+      (1 (blt:rgba v 1.0 v 1.0))
+      (2 (blt:rgba v v 1.0 1.0)))))
+
+
+(defstruct mouse
+  (x 0 :type fixnum)
+  (y 0 :type fixnum))
+
+(defstruct particle
+  (x 0.0 :type single-float)
+  (y 0.0 :type single-float)
+  (glyph (random-glyph) :type character)
+  (color (random-color) :type (unsigned-byte 32))
+  (lifetime 1000 :type fixnum)
+  (transformer #'noop :type function))
+
+
+(defun update-particles (ms)
+  (setf *particles*
+        (delete-if (lambda (particle)
+                     (minusp (decf (particle-lifetime particle) ms)))
+                   *particles*))
+  (mapc (lambda (particle)
+          (funcall (particle-transformer particle) particle ms))
+        *particles*)
+  'ok)
+
+(defun transform-drop (ms-per-cell particle ms)
+  (incf (particle-y particle)
+        (/ ms ms-per-cell)))
+
+
+(defun clear-layer (layer)
+  (setf (blt:layer) layer)
+  (blt:clear-area 0 0 (blt:width) (blt:height)))
+
+
+(defun update-mouse-location ()
+  (multiple-value-bind (x y)
+      (blt:mouse)
+    (setf (mouse-x *mouse*) (* 2 (truncate x 2))
+          (mouse-y *mouse*) (* 2 (truncate y 2)))))
+
+
+(defun make-drop-particle (x y)
+  (make-particle
+    :x x
+    :y y
+    :lifetime (random-range 600 2000)
+    :transformer (losh::curry #'transform-drop (random-range 15 50))))
+
+
+(defun add-particle ()
+  (let ((x (coerce (mouse-x *mouse*) 'single-float))
+        (y (coerce (mouse-y *mouse*) 'single-float)))
+    (iterate (repeat (random-range 10 30))
+             (push (make-drop-particle (+ x (random-range-inclusive -4.0 4.0))
+                                       (+ y (random-range-inclusive -4.0 4.0)))
+                   *particles*))))
+
+
+;;;; Drawing ------------------------------------------------------------------
+(defun draw-mspf ()
+  (clear-layer 5)
+  (blt:print 0 0 (format nil "MSPF: ~D" *mspf*)))
+
+(defun draw-cursor ()
+  (clear-layer 2)
+  (setf (blt:cell-char (mouse-x *mouse*)
+                       (mouse-y *mouse*))
+        #\@))
+
+(defun draw-particles ()
+  (clear-layer 1)
+  (iterate
+    (for particle :in *particles*)
+    (setf
+      (blt:color)
+      (particle-color particle)
+
+      (blt:cell-char (truncate (particle-x particle))
+                     (truncate (particle-y particle)))
+      (particle-glyph particle))))
+
+(defun draw ()
+  (setf (blt:color) (blt:rgba 1.0 1.0 1.0 1.0))
+  (draw-mspf)
+  (draw-cursor)
+  (draw-particles)
+  (blt:refresh))
+
+
+;;;; Config -------------------------------------------------------------------
+(defun config ()
+  (blt:set "font: ./examples/ProggySquare/ProggySquare.ttf, size=20x20, spacing=2x2, align=dead-center;")
+  (blt:set "input.filter = keyboard, mouse")
+  (blt:set "output.vsync = false")
+  (blt:set "window.resizeable = true")
+  (blt:set "window.cellsize = 10x10")
+  (blt:set "window.size = 80x50")
+  (blt:set "window.title = Particle Demo"))
+
+
+;;;; Input --------------------------------------------------------------------
+(defun event ()
+  (if (blt:has-input-p)
+    (blt:key-case (blt:read)
+      ;; (:space (draw-background))
+      (:mouse-move :mouse-move)
+      (:mouse-left :add-particle)
+      (:escape :quit)
+      (:close :quit))
+    :done))
+
+(defun handle-event (event)
+  (ecase event
+    (:mouse-move (update-mouse-location))
+    (:add-particle (add-particle))
+    (:quit (setf *running* nil))))
+
+(defun handle-events ()
+  (iterate
+    (for event = (event))
+    (until (eql event :done))
+    (when event
+      (handle-event event))))
+
+
+;;;; Main ---------------------------------------------------------------------
+(defun main ()
+  (setf *running* t
+        *mouse* (make-mouse)
+        *particles* '())
+  (blt:with-terminal
+    (config)
+    (iterate
+      (while *running*)
+      (for time = (get-internal-real-time))
+      (for prev-time :previous time :initially 0)
+      (for frame-time = (* 1000 (/ (- time prev-time)
+                                   internal-time-units-per-second)))
+      (setf *mspf* frame-time)
+      (update-particles frame-time)
+      (draw)
+      (handle-events))))
+
diff -r 55af36925fd1 -r 4fce923d387e package.lisp
--- a/package.lisp	Fri Apr 07 20:26:10 2017 +0000
+++ b/package.lisp	Tue Apr 11 22:38:45 2017 +0000
@@ -20,6 +20,9 @@
     :close
     :color
     :color-name
+    :mouse
+    :mouse-x
+    :mouse-y
     :composition
     :crop
     :has-input-p
diff -r 55af36925fd1 -r 4fce923d387e src/high-level/bearlibterminal.lisp
--- a/src/high-level/bearlibterminal.lisp	Fri Apr 07 20:26:10 2017 +0000
+++ b/src/high-level/bearlibterminal.lisp	Tue Apr 11 22:38:45 2017 +0000
@@ -206,6 +206,16 @@
   new-value)
 
 
+(defun mouse-x ()
+  (blt/ll:terminal-state blt/ll:+tk-mouse-x+))
+
+(defun mouse-y ()
+  (blt/ll:terminal-state blt/ll:+tk-mouse-y+))
+
+(defun mouse ()
+  (values (blt/ll:terminal-state blt/ll:+tk-mouse-x+)
+          (blt/ll:terminal-state blt/ll:+tk-mouse-y+)))
+
 (defun has-input-p ()
   (int-to-boolean (blt/ll:terminal-has-input)))