--- 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)
--- 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
--- 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))
--- 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))
-
--- 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
--- 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))
--- 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)))
--- 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
--- 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)