Episode 26: 2D and 3D Coordinate Rotation
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Thu, 19 May 2016 21:38:29 +0000 |
| parents |
f5e42ff3a78c
|
| children |
9ad941538426
|
| branches/tags |
(none) |
| files |
src/2d/demo.lisp src/3d/demo.lisp |
Changes
--- 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))
-
--- 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)