# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463246240 0
# Node ID 8547dda4da61b70aab3034780b8e1723555402dd
# Parent  675cba1dba019bb5ebf432549f7db67719e1874e
Episode 24: 3D Points and Lines

diff -r 675cba1dba01 -r 8547dda4da61 .lispwords
--- a/.lispwords	Wed May 11 00:24:58 2016 +0000
+++ b/.lispwords	Sat May 14 17:17:20 2016 +0000
@@ -2,6 +2,7 @@
 (1 make-sketch)
 (2 with-vals)
 (2 with-vec with-vec3)
-(1 with-vecs with-vec3s)
-(1 with-setup)
+(1 with-vecs with-vec3s with-vec3-slots)
+(2 with-shape-perspective)
 (1 setf-slots)
+(2 with-cga)
diff -r 675cba1dba01 -r 8547dda4da61 package.lisp
--- a/package.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/package.lisp	Sat May 14 17:17:20 2016 +0000
@@ -6,7 +6,6 @@
     #:coding-math.quickutils)
   (:export
     #:in-context
-    #:make-sketch
     #:scancode-case
     #:with-vals
     #:zap%
@@ -205,7 +204,13 @@
     #:vec3-div #:vec3-div!
     #:vec3-lerp
     #:with-vec3
-    #:with-vec3s))
+    #:with-vec3s
+    #:with-vec3-slots
+    #:vec3-dot
+    #:vec3-cross
+    #:vec3-angle-between
+    #:vec3-normalized
+    ))
 
 (defpackage #:coding-math.3d.coordinates
   (:use
@@ -217,6 +222,7 @@
   (:export
     #:cartesian-to-cylindrical
     #:cylindrical-to-cartesian
+    #:cylindrical-to-cartesian-cga
     ))
 
 (defpackage #:coding-math.3d.demo
diff -r 675cba1dba01 -r 8547dda4da61 src/2d/ballistics.lisp
--- a/src/2d/ballistics.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/2d/ballistics.lisp	Sat May 14 17:17:20 2016 +0000
@@ -83,10 +83,10 @@
         :radius (random-range 10 40)))
 
 
-(defsketch game (:width *width*
-                 :height *height*
-                 :debug :scancode-d)
-    ((aiming)
+(defsketch game
+    ((width *width*)
+     (height *height*)
+     (aiming)
      (gun)
      (cannonball)
      (can-shoot-p)
@@ -122,21 +122,6 @@
     ))
 
 
-(defun make-game ()
-  (make-sketch 'game
-    (aiming nil)
-    (firedp nil)
-    (gun `(x 40
-           y ,*height*
-           angle ,(- (/ tau 8))))
-    (cannonball (make-particle (getf gun 'x)
-                               (getf gun 'y)
-                               :speed 15
-                               :direction (getf gun 'angle)
-                               :radius 7
-                               :gravity 0.2))))
-
-
 ;;;; Mouse
 (defmethod kit.sdl2:mousebutton-event
     ((game game) state timestamp button x y)
@@ -177,4 +162,4 @@
 
 
 ;;;; Run
-; (defparameter *demo* (make-game))
+; (defparameter *demo* (make-instance 'game))
diff -r 675cba1dba01 -r 8547dda4da61 src/2d/demo.lisp
--- a/src/2d/demo.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/2d/demo.lisp	Sat May 14 17:17:20 2016 +0000
@@ -35,17 +35,16 @@
       (outsidep (- 0 r) (+ *height* r) (vec-y p))))
 
 
-(defsketch cm (:width *width*
-               :height *height*
-               :debug :scancode-d)
-    ((ready)
-     (mouse)
+(defsketch cm
+    ((mouse (make-vec 0 0))
+     (width *width*)
+     (height *height*)
      (dragging)
-     (p1)
-     (c1)
-     (c2)
-     (p2)
-     (handles)
+     (p1 (make-particle (random *width*) (random *height*) :radius 10))
+     (c1 (make-particle (random *width*) (random *height*) :radius 8))
+     (c2 (make-particle (random *width*) (random *height*) :radius 8))
+     (p2 (make-particle (random *width*) (random *height*) :radius 10))
+     (handles (list p1 c1 c2 p2))
      (control-pen (make-pen :stroke (gray 0.1)
                             :weight 1
                             :fill (rgb 0.5 0.5 0.9)))
@@ -58,54 +57,30 @@
   (with-fps
     (background (gray 1))
     ;;
-    (when ready
-
-      (with-pen line-pen
-        (draw-line (particle-pos p1)
-                   (particle-pos c1))
-        (draw-line (particle-pos c1)
-                   (particle-pos c2))
-        (draw-line (particle-pos c2)
-                   (particle-pos p2)))
-      (with-pen end-pen
-        (draw-particle p1)
-        (draw-particle p2))
-      (with-pen control-pen
-        (draw-particle c1)
-        (draw-particle c2))
-      (with-pen curve-pen
-        (with-vecs ((p1x p1y) (particle-pos p1)
-                    (c1x c1y) (particle-pos c1)
-                    (c2x c2y) (particle-pos c2)
-                    (p2x p2y) (particle-pos p2))
-          (bezier p1x p1y c1x c1y c2x c2y p2x p2y))
-        )
-
+    (with-pen line-pen
+      (draw-line (particle-pos p1)
+                 (particle-pos c1))
+      (draw-line (particle-pos c1)
+                 (particle-pos c2))
+      (draw-line (particle-pos c2)
+                 (particle-pos p2)))
+    (with-pen end-pen
+      (draw-particle p1)
+      (draw-particle p2))
+    (with-pen control-pen
+      (draw-particle c1)
+      (draw-particle c2))
+    (with-pen curve-pen
+      (with-vecs ((p1x p1y) (particle-pos p1)
+                  (c1x c1y) (particle-pos c1)
+                  (c2x c2y) (particle-pos c2)
+                  (p2x p2y) (particle-pos p2))
+        (bezier p1x p1y c1x c1y c2x c2y p2x p2y))
       )
-
     ;;
     ))
 
 
-(defun reset (game)
-  (setf (slot-value game 'ready) nil)
-  ;;
-  (let ((p1 (make-particle (random *width*) (random *height*) :radius 10))
-        (c1 (make-particle (random *width*) (random *height*) :radius 8))
-        (c2 (make-particle (random *width*) (random *height*) :radius 8))
-        (p2 (make-particle (random *width*) (random *height*) :radius 10)))
-    (setf
-      (slot-value game 'p1) p1
-      (slot-value game 'c1) c1
-      (slot-value game 'c2) c2
-      (slot-value game 'p2) p2
-      (slot-value game 'handles) (list p1 c1 c2 p2)
-      )
-    )
-  ;;
-  (setf (slot-value game 'ready) t))
-
-
 ;;;; Mouse
 (defun mousemove (instance x y)
   (with-slots (dragging mouse) instance
@@ -168,7 +143,7 @@
 (defun keydown (instance scancode)
   (declare (ignorable instance))
   (scancode-case scancode
-    (:scancode-space (reset instance))))
+    (:scancode-space (sketch::prepare instance))))
 
 (defun keyup (instance scancode)
   (declare (ignorable instance))
@@ -186,10 +161,5 @@
 
 
 ;;;; Run
-(defun make-cm ()
-  (make-sketch 'cm
-    (mouse (make-vec))))
+; (defparameter *demo* (make-instance 'cm))
 
-
-; (defparameter *demo* (make-cm))
-
diff -r 675cba1dba01 -r 8547dda4da61 src/3d/coordinates.lisp
--- a/src/3d/coordinates.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/3d/coordinates.lisp	Sat May 14 17:17:20 2016 +0000
@@ -27,3 +27,16 @@
                (atan z x) ; a
                y))) ; h
 
+
+(defmacro with-cga (bindings vec &body body)
+  (once-only (vec)
+    `(let ((,(first bindings) (aref ,vec 0))
+           (,(second bindings) (aref ,vec 1))
+           (,(third bindings) (aref ,vec 2)))
+       ,@body)))
+
+(defun cylindrical-to-cartesian-cga (coords)
+  (with-cga (radius azimuth height) coords
+    (sb-cga:vec (* radius (cos azimuth)) ; x
+                height ; y
+                (* radius (sin azimuth))))) ; z
diff -r 675cba1dba01 -r 8547dda4da61 src/3d/demo.lisp
--- a/src/3d/demo.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/3d/demo.lisp	Sat May 14 17:17:20 2016 +0000
@@ -15,87 +15,93 @@
      (translate *center-x* *center-y*)
      ,@body))
 
-(defmacro with-setup (ready-form &body body)
+(defmacro with-setup (&body body)
   `(with-fps
     (background (gray 1))
-    (when ,ready-form
-      (with-centered-coords
-        ,@body))))
+    (with-centered-coords
+      ,@body)))
 
 
 ;;;; Draw
+(declaim (inline perspective apply-perspective))
 (defun perspective (focal-length z)
   (/ focal-length (+ focal-length z)))
 
-(defun draw-shape (shape focal-length size)
-  (in-context
-    (scale (perspective focal-length (getf shape :z)))
-    (translate (getf shape :x)
-               (getf shape :y))
-    ; (rect (- size) (- size) (* 2 size) (* 2 size))
-    (circle 0 0 size)
-    ))
+(defun apply-perspective (vec focal-length)
+  (let ((p (perspective focal-length (aref vec 2))))
+    (sb-cga:transform-point vec (sb-cga:scale* p p p))))
+
+(defun draw-point (point focal-length size)
+  (let ((p (apply-perspective point focal-length)))
+    (in-context
+      (translate (aref p 0) (aref p 1))
+      (circle 0 0 size))))
+
+(defun draw-line (p1 p2 focal-length)
+  (let ((p1 (apply-perspective p1 focal-length))
+        (p2 (apply-perspective p2 focal-length)))
+    (line (aref p1 0) (aref p1 1)
+          (aref p2 0) (aref p2 1))))
 
 
 ;;;; Sketch
-(defsketch demo (:width *width*
-                 :height *height*
-                 :debug :scancode-d)
-    ((ready)
-     (mouse)
-     (fl)
-     (shapes)
-     (cz)
-     (radius)
-     (base-angle)
-     (angle-speed)
-     (y-speed)
-     ; (simple-pen (make-pen :weight 4 :stroke (gray 0.0) :fill (gray 0.6)))
+(defsketch demo
+    ((width *width*)
+     (height *height*)
+     (mouse (cons 0 0))
+     (fl 300.0)
+     (cz 700.0)
+     (radius 400.0)
+     (cyl-height 380.0)
+     (wraps 6)
+     (base-angle 0.0)
+     (angle-speed -0.02)
+     (circle-size 3)
+     (y-speed -0.5)
+     (shapes (loop
+               :with nshapes = 400
+               :for i :from 0 :to nshapes
+               :collect
+               (sb-cga:vec radius
+                           (* i (/ (* wraps tau) (1+ nshapes)))
+                           (+ #+no (random-around 0.0 50.0)
+                              (map-range 0.0 nshapes cyl-height (- cyl-height) i)))))
+     (model-to-world (sb-cga:translate* 0.0 0.0 cz))
+     ;;
      (simple-pen (make-pen :fill (gray 0.1)))
+     (line-pen (make-pen :stroke (gray 0.1) :weight 2))
      )
-  (with-setup ready
-    ;;
-    (setf angle-speed (map-range 0 *height* -0.08 0.08 (cdr mouse)))
-    (incf base-angle angle-speed)
-    (setf shapes (sort shapes #'> :key (rcurry #'getf :z)))
+  (with-setup
+    ; (setf angle-speed (map-range 0 *height* -0.08 0.08 (cdr mouse)))
+    ; (setf shapes (sort shapes #'> :key (rcurry #'getf :z)))
     (with-pen simple-pen
       (loop :for shape :in shapes
-            :for angle = (getf shape :angle)
             :do
-            (setf (getf shape :x)
-                  (* (car mouse) (cos (+ base-angle angle)))
-                  (getf shape :z)
-                  (+ cz (* radius (sin (+ base-angle angle)))))
-            (incf (getf shape :y) y-speed)
-            (wrapf (getf shape :y) (* *height* -1/2) (* *height* 1/2))
-            (draw-shape shape fl 5)))
+            (setf (aref shape 0) (map-range 0.0 *width* 10 600 (car mouse)))
+            (incf (aref shape 1) angle-speed)
+            (incf (aref shape 2) (random-around 0.0 0.2))
+            ; (incf (aref shape 2) y-speed)
+            ; (wrapf (aref shape 2) (- cyl-height) cyl-height)
+            #+debug (draw-point
+                   (sb-cga:transform-point
+                     (cylindrical-to-cartesian-cga shape)
+                     model-to-world)
+                   fl
+                   circle-size))
+      )
+    (with-pen line-pen
+      (loop :for (a b) :in (n-grams 2 shapes) :do
+            (draw-line (sb-cga:transform-point
+                         (cylindrical-to-cartesian-cga a)
+                         model-to-world)
+                       (sb-cga:transform-point
+                         (cylindrical-to-cartesian-cga b)
+                         model-to-world)
+                       fl)))
     ;;
     ))
 
 
-(defun reset (game)
-  (setf-slots game
-    ready nil
-    ;;
-    fl 300
-    cz 200
-    radius 50
-    base-angle 0.0
-    angle-speed 0.01
-    y-speed 0.5
-    shapes (loop
-             :with nshapes = 200
-             :for i :from 0 :to nshapes
-             :collect
-             (list :x nil
-                   :y (- (* i (/ *height* nshapes))
-                         (/ *height* 2))
-                   :z 0
-                   :angle (* i (/ (* 6 tau) nshapes))))
-    ;;
-    ready t))
-
-
 ;;;; Mouse
 (defun mousemove (instance x y)
   (with-slots (mouse) instance
@@ -145,7 +151,7 @@
 (defun keydown (instance scancode)
   (declare (ignorable instance))
   (scancode-case scancode
-    (:scancode-space (reset instance))))
+    (:scancode-space (sketch::prepare instance))))
 
 (defun keyup (instance scancode)
   (declare (ignorable instance))
@@ -162,11 +168,5 @@
     (t nil)))
 
 
-;;;; Make
-(defun make-demo ()
-  (make-sketch 'demo
-    (mouse (cons nil nil))))
-
-
 ;;;; Run
-; (defparameter *demo* (make-demo))
+; (defparameter *demo* (make-instance 'demo))
diff -r 675cba1dba01 -r 8547dda4da61 src/3d/vectors.lisp
--- a/src/3d/vectors.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/3d/vectors.lisp	Sat May 14 17:17:20 2016 +0000
@@ -15,6 +15,16 @@
   (y 0 :type real)
   (z 0 :type real))
 
+(defun vec3-radius (v)
+  (vec3-x v))
+
+(defun vec3-angle (v)
+  (vec3-y v))
+
+(defun vec3-height (v)
+  (vec3-z v))
+
+
 (defun make-random-vec3 (max-x max-y max-z)
   (make-vec3 (random max-x) (random max-y) (random max-z)))
 
@@ -32,6 +42,13 @@
     (destructuring-bind (vars vec-form . remaining) bindings
       `(with-vec3 ,vars ,vec-form (with-vec3s ,remaining ,@body)))))
 
+(defmacro with-vec3-slots (bindings vec &body body)
+  `(with-accessors ((,(first bindings) vec3-x)
+                    (,(second bindings) vec3-y)
+                    (,(third bindings) vec3-z))
+    ,vec
+    ,@body))
+
 
 (defun vec3-magnitude (vec)
   (with-vec3 (x y z) vec
@@ -64,22 +81,26 @@
 (defun vec3-add! (v1 v2)
   (incf (vec3-x v1) (vec3-x v2))
   (incf (vec3-y v1) (vec3-y v2))
-  (incf (vec3-z v1) (vec3-z v2)))
+  (incf (vec3-z v1) (vec3-z v2))
+  v1)
 
 (defun vec3-sub! (v1 v2)
   (decf (vec3-x v1) (vec3-x v2))
   (decf (vec3-y v1) (vec3-y v2))
-  (decf (vec3-z v1) (vec3-z v2)))
+  (decf (vec3-z v1) (vec3-z v2))
+  v1)
 
 (defun vec3-mul! (v s)
   (setf (vec3-x v) (* (vec3-x v) s)
         (vec3-y v) (* (vec3-y v) s)
-        (vec3-z v) (* (vec3-z v) s)))
+        (vec3-z v) (* (vec3-z v) s))
+  v)
 
 (defun vec3-div! (v s)
   (setf (vec3-x v) (/ (vec3-x v) s)
         (vec3-y v) (/ (vec3-y v) s)
-        (vec3-z v) (/ (vec3-z v) s)))
+        (vec3-z v) (/ (vec3-z v) s))
+  v)
 
 
 (defun vec3-lerp (v1 v2 n)
@@ -90,3 +111,33 @@
                (lerp z1 z2 n))))
 
 
+(defun vec3-normalized (vec)
+  (vec3-div vec (vec3-magnitude vec)))
+
+
+(defun vec3-dot (v1 v2)
+  (+ (* (vec3-x v1) (vec3-x v2))
+     (* (vec3-y v1) (vec3-y v2))
+     (* (vec3-z v1) (vec3-z v2))))
+
+
+(defun vec3-angle-between (v1 v2)
+  (acos (/ (vec3-dot v1 v2)
+           (* (vec3-magnitude v1)
+              (vec3-magnitude v2)))))
+
+
+(defun vec3-cross (v1 v2)
+  (with-vec3s ((ax ay az) v1
+               (bx by bz) v2)
+    (make-vec3 (- (* ay bz) (* az by))
+               (- (* az bx) (* ax bz))
+               (- (* ax by) (* ay bx)))))
+
+
+(defmacro with-vec (bindings vec &body)
+  (once-only (vec)
+    `(symbol-macrolet ((,(first bindings) (aref ,vec 0))
+                       (,(second bindings) (aref ,vec 1))
+                       (,(third bindings) (aref ,vec 2)))
+      ,@body)))
diff -r 675cba1dba01 -r 8547dda4da61 src/math.lisp
--- a/src/math.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/math.lisp	Sat May 14 17:17:20 2016 +0000
@@ -5,7 +5,7 @@
 
 
 ;;;; Constants
-(defparameter tau (* pi 2))
+(defparameter tau (coerce (* pi 2) 'single-float))
 
 
 ;; Basics
diff -r 675cba1dba01 -r 8547dda4da61 src/utils.lisp
--- a/src/utils.lisp	Wed May 11 00:24:58 2016 +0000
+++ b/src/utils.lisp	Sat May 14 17:17:20 2016 +0000
@@ -32,14 +32,6 @@
     (progn ,@body)
     (pop-matrix)))
 
-(defmacro make-sketch (class &rest bindings)
-  `(let*
-    (,@(loop :for (k v) :in bindings
-             :collect (list k v)))
-    (make-instance
-      ,class
-      ,@(loop :for (k) :in bindings
-              :append (list (alexandria:make-keyword k) k)))))
 
 (defmacro scancode-case (scancode-form &rest pairs)
   (with-gensyms (scancode)