# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463693909 0
# Node ID 281946a2189735dc5a41b32b47efaca25863b515
# Parent  f5e42ff3a78c755fe8855933f63fb89cac4fa646
Episode 26: 2D and 3D Coordinate Rotation

diff -r f5e42ff3a78c -r 281946a21897 src/2d/demo.lisp
--- a/src/2d/demo.lisp	Thu May 19 20:29:50 2016 +0000
+++ b/src/2d/demo.lisp	Thu May 19 21:38:29 2016 +0000
@@ -8,6 +8,13 @@
 (defparameter *center-y* (/ *height* 2))
 
 
+;;;; Utils
+(defmacro with-setup (&body body)
+  `(with-fps
+    (background (gray 1))
+    ,@body))
+
+
 ;;;; Sketch
 (defun draw-particle (p)
   (circle (particle-x p) (particle-y p) (particle-radius p)))
@@ -36,75 +43,49 @@
 
 
 (defsketch cm
-    ((mouse (make-vec 0 0))
-     (width *width*)
-     (height *height*)
-     (dragging)
-     (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)))
-     (end-pen (make-pen :stroke (gray 0.1)
-                        :weight 1
-                        :fill (gray 0.5)))
+    ((width *width*) (height *height*) (y-axis :down) (title "Coding Math 2D")
+     (mouse (cons 0 0))
+     ;; Data
+     (o (make-particle 0 0 :radius 5))
+     (p (make-particle 150.0 40.0 :radius 10))
+     (delta -0.05)
+     ;; Pens
+     (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4)))
      (line-pen (make-pen :stroke (gray 0.7)))
-     (curve-pen (make-pen :stroke (rgb 0.7 0.2 0.2)))
      )
-  (with-fps
-    (background (gray 1))
+  (with-setup
     ;;
-    (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))
-      )
+    (in-context
+      (translate (/ *width* 2) (/ *height* 2))
+      (with-pen particle-pen
+        (draw-particle o)
+        (draw-particle p))
+      (let ((sin (sin delta))
+            (cos (cos delta)))
+        (psetf (particle-x p)
+               (- (* (particle-x p) cos)
+                  (* (particle-y p) sin))
+               (particle-y p)
+               (+ (* (particle-y p) cos)
+                  (* (particle-x p) sin)))))
     ;;
-    ))
+    )
+  )
 
 
 ;;;; Mouse
 (defun mousemove (instance x y)
   (with-slots (dragging mouse) instance
-    (setf (vec-x mouse) x)
-    (setf (vec-y mouse) y)
+    (setf (car mouse) x)
+    (setf (cdr mouse) y)
     ;;
-    (when dragging
-      (destructuring-bind (thing . offset) dragging
-        (setf (drag-location-vec thing)
-              (vec-add mouse offset)))
-      )
     ;;
     )
   )
 
+
 (defun mousedown-left (instance x y)
   (declare (ignorable instance x y))
-  (with-slots (dragging mouse handles) instance
-    (loop :for handle :in handles
-          :when (drag-requested-p handle (make-vec x y))
-          :do (setf dragging
-                    (cons handle
-                          (vec-sub (drag-location-vec handle)
-                                   mouse)))))
   )
 
 (defun mousedown-right (instance x y)
@@ -113,7 +94,6 @@
 
 (defun mouseup-left (instance x y)
   (declare (ignorable instance x y))
-  (setf (slot-value instance 'dragging) nil)
   )
 
 (defun mouseup-right (instance x y)
@@ -162,4 +142,3 @@
 
 ;;;; Run
 ; (defparameter *demo* (make-instance 'cm))
-
diff -r f5e42ff3a78c -r 281946a21897 src/3d/demo.lisp
--- a/src/3d/demo.lisp	Thu May 19 20:29:50 2016 +0000
+++ b/src/3d/demo.lisp	Thu May 19 21:38:29 2016 +0000
@@ -33,13 +33,42 @@
   world screen)
 
 
+;;;; Functions
+(defun rotate-x (angle points)
+  (let ((s (sin angle))
+        (c (cos angle)))
+    (map nil (lambda (p)
+               (with-vec (p (point-world p))
+                 (psetf p.y (- (* p.y c) (* p.z s))
+                        p.z (+ (* p.z c) (* p.y s)))))
+         points)))
+
+(defun rotate-y (angle points)
+  (let ((s (sin angle))
+        (c (cos angle)))
+    (map nil (lambda (p)
+               (with-vec (p (point-world p))
+                 (psetf p.x (- (* p.x c) (* p.z s))
+                        p.z (+ (* p.z c) (* p.x s)))))
+         points)))
+
+(defun rotate-z (angle points)
+  (let ((s (sin angle))
+        (c (cos angle)))
+    (map nil (lambda (p)
+               (with-vec (p (point-world p))
+                 (psetf p.x (- (* p.x c) (* p.y s))
+                        p.y (+ (* p.y c) (* p.x s)))))
+         points)))
+
+
 ;;;; Sketch
-(defun project (points focal-length)
+(defun project (points focal-length center-z)
   (map nil
        (lambda (p)
          (with-vecs ((screen (point-screen p))
                      (world (point-world p)))
-           (let ((scale (/ focal-length (+ focal-length world.z))))
+           (let ((scale (/ focal-length (+ focal-length world.z center-z))))
              (setf screen.x (* scale world.x)
                    screen.y (* scale world.y)))))
        points))
@@ -52,25 +81,26 @@
                (incf p.z z)))
        points))
 
+
 (defsketch demo
     ((width *width*) (height *height*) (y-axis :up) (title "Coding Math")
      (mouse (cons 0 0))
      ;; variables
      (fl 300.0)
      (r 200.0)
+     (center-z 1500.0)
      (points
        (make-array 8
          :initial-contents
          (list
-           (make-point (vec (- r) (- r) 1000.0) (zero-vec))
-           (make-point (vec     r (- r) 1000.0) (zero-vec))
-           (make-point (vec     r (- r)  500.0) (zero-vec))
-           (make-point (vec (- r) (- r)  500.0) (zero-vec))
-           (make-point (vec (- r)     r 1000.0) (zero-vec))
-           (make-point (vec     r     r 1000.0) (zero-vec))
-           (make-point (vec     r     r  500.0) (zero-vec))
-           (make-point (vec (- r)     r  500.0) (zero-vec)))))
-     (dirty t)
+           (make-point (vec (- r) (- r)     r) (zero-vec))
+           (make-point (vec     r (- r)     r) (zero-vec))
+           (make-point (vec     r (- r) (- r)) (zero-vec))
+           (make-point (vec (- r) (- r) (- r)) (zero-vec))
+           (make-point (vec (- r)     r     r) (zero-vec))
+           (make-point (vec     r     r     r) (zero-vec))
+           (make-point (vec     r     r (- r)) (zero-vec))
+           (make-point (vec (- r)     r (- r)) (zero-vec)))))
      ;; pens
      (simple-pen (make-pen :fill (gray 0.1)))
      (line-pen (make-pen :stroke (gray 0.1) :weight 1))
@@ -83,9 +113,9 @@
                  :do (with-vecs ((a (point-screen (aref points a)))
                                  (b (point-screen (aref points b))))
                        (line a.x a.y b.x b.y)))))
-      (when dirty
-        (setf dirty nil)
-        (project points fl))
+      (project points fl center-z)
+      (when *shift* (text "shift!" 100 100))
+      (when *control* (text "control!" 100 120))
       (with-pen simple-pen
         ; (loop :for p :across points
         ;       :do (draw-point (point-screen p) 5))
@@ -147,26 +177,50 @@
 
 
 ;;;; Keyboard
+(defvar *shift* nil)
+(defvar *control* nil)
+(defvar *command* nil)
+(defvar *option* nil)
+
+
 (defun keydown (instance scancode)
   (declare (ignorable instance))
-  (setf (slot-value instance 'dirty) t)
   (scancode-case scancode
     (:scancode-space (sketch::prepare instance))
+    (:scancode-lshift (setf *shift* t))
+    (:scancode-lctrl (setf *control* t))
+    (:scancode-lgui (setf *command* t))
+    (:scancode-lalt (setf *option* t))
     ;;
-    (:scancode-left  (translate-model (slot-value instance 'points) -15 0 0))
-    (:scancode-right (translate-model (slot-value instance 'points) 15 0 0))
-    (:scancode-up    (translate-model (slot-value instance 'points) 0 -15 0))
-    (:scancode-down  (translate-model (slot-value instance 'points) 0 15 0))
-    (:scancode-s    (translate-model (slot-value instance 'points) 0 0 -15))
-    (:scancode-w  (translate-model (slot-value instance 'points) 0 0 15))
+    (:scancode-left  (if *shift*
+                       (rotate-y -0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) -15 0 0)))
+    (:scancode-right (if *shift*
+                       (rotate-y 0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) 15 0 0)))
+    (:scancode-up    (if *shift*
+                       (rotate-x -0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) 0 15 0)))
+    (:scancode-down  (if *shift*
+                       (rotate-x 0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) 0 -15 0)))
+    (:scancode-s     (if *shift*
+                       (rotate-z -0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) 0 0 -15)))
+    (:scancode-w     (if *shift*
+                       (rotate-z 0.05 (demo-points instance))
+                       (translate-model (slot-value instance 'points) 0 0 15)))
     ;;
     ))
 
 (defun keyup (instance scancode)
   (declare (ignorable instance))
   (scancode-case scancode
-    (:scancode-space
-     nil)))
+    (:scancode-lshift (setf *shift* nil))
+    (:scancode-lctrl (setf *control* nil))
+    (:scancode-lgui (setf *command* nil))
+    (:scancode-lalt (setf *option* nil))
+    (:scancode-space nil)))
 
 
 (defmethod kit.sdl2:keyboard-event ((instance demo) state timestamp repeatp keysym)