--- a/.lispwords Wed May 04 20:05:07 2016 +0000
+++ b/.lispwords Wed May 04 21:36:46 2016 +0000
@@ -1,3 +1,5 @@
(1 scancode-case)
(1 make-sketch)
(2 with-vals)
+(2 with-vec)
+(1 with-vecs)
--- a/package.lisp Wed May 04 20:05:07 2016 +0000
+++ b/package.lisp Wed May 04 21:36:46 2016 +0000
@@ -21,6 +21,7 @@
#:coding-math.utils)
(:export
#:tau
+ #:square
#:distance
#:random-range
#:random-around
@@ -62,6 +63,7 @@
#:make-vec
#:make-vec-md
#:make-vec-ma
+ #:make-random-vec
#:vec-magnitude
#:vec-direction
#:vec-angle
@@ -69,12 +71,15 @@
#:vec-sub
#:vec-mul
#:vec-div
+ #:vec-lerp
#:vec-add!
#:vec-sub!
#:vec-mul!
#:vec-div!
#:vec-to-string
- #:with-vec))
+ #:with-vec
+ #:with-vecs
+ ))
(defpackage #:coding-math.particles
(:use
@@ -106,7 +111,19 @@
#:particle-gravitate-remove!
#:particle-spring-to!
#:particle-spring-add!
- #:particle-spring-remove!
+ #:particle-spring-remove!))
+
+(defpackage #:coding-math.points
+ (:use
+ #:cl
+ #:coding-math.math
+ #:coding-math.vectors
+ #:coding-math.quickutils
+ #:coding-math.utils)
+ (:export
+ #:quadratic-bezier
+ #:fast-quadratic-bezier
+ #:cubic-bezier
))
(defpackage #:coding-math.fps
@@ -128,6 +145,7 @@
#:coding-math.fps
#:coding-math.math
#:coding-math.vectors
+ #:coding-math.points
#:coding-math.particles))
(defpackage #:coding-math.ballistics
--- a/src/main.lisp Wed May 04 20:05:07 2016 +0000
+++ b/src/main.lisp Wed May 04 21:36:46 2016 +0000
@@ -13,17 +13,39 @@
(with-pen pen
(circle (particle-x p) (particle-y p) (particle-radius p))))
+(defun draw-line (p1 p2)
+ (with-vecs ((x1 y1) p1 (x2 y2) p2)
+ (line x1 y1 x2 y2)))
-(defun add-result (results)
- (incf (aref results (floor (random-dist 0 100 4)))))
+(defun draw-circle (p radius)
+ (circle (vec-x p) (vec-y p) radius))
+
+(defun draw-square (p radius)
+ (rect (- (vec-x p) radius)
+ (- (vec-y p) radius)
+ (* 2 radius)
+ (* 2 radius)))
+
+(defun draw-point (p)
+ (point (vec-x p) (vec-y p)))
+
(defsketch cm (:width *width*
:height *height*
:debug :scancode-d)
((ready)
(mouse)
- (graph-pen (make-pen :fill (gray 0.8)))
- (dot-pen (make-pen :fill (gray 0.8)))
+ (p-from)
+ (p-to)
+ (p-c1)
+ (p-c2)
+ (ts)
+ (l0-pen (make-pen :stroke (gray 0) :fill (rgb 0.0 0.0 0.0)))
+ (l1-pen (make-pen :stroke (rgb 0 0 0.5) :fill (rgb 0.0 0.0 1.0)))
+ (l2-pen (make-pen :stroke (rgb 0 0.5 0.0) :fill (rgb 0.0 1.0 0.0)))
+ (lines-pen (make-pen :stroke (gray 0)))
+ (final-pen (make-pen :stroke (rgb 0.5 0 0) :fill (rgb 1.0 0.0 0.0)))
+ (fast-pen (make-pen :fill (rgb 0.0 0.0 1.0)))
(results)
(dots)
)
@@ -32,24 +54,48 @@
;;
(when ready
- (with-pen dot-pen
- (loop :for (x . y) :in dots
- :do (circle x y 2)))
- (add-result results)
- (with-pen graph-pen
- (loop :for r :across results
- :for i :from 0
- :do (rect (map-range 0 100
- 0 *width*
- i)
- 0
- (- (/ *width* 100) 1)
- (map-range 0 200
- 0 *height*
- r))))
+ (incf ts 0.01)
+ (let* ((n (abs (sin ts)))
+ (i1 (vec-lerp p-from p-c1 n))
+ (i2 (vec-lerp p-c1 p-c2 n))
+ (i3 (vec-lerp p-c2 p-to n))
+ (ii1 (vec-lerp i1 i2 n))
+ (ii2 (vec-lerp i2 i3 n))
+ (f (vec-lerp ii1 ii2 n))
+ )
+ (with-pen lines-pen
+ (draw-line p-from p-c1)
+ (draw-line p-c1 p-c2)
+ (draw-line p-c2 p-to))
+ (with-pen l0-pen
+ (draw-circle p-from 10)
+ (draw-circle p-to 10)
+ (draw-square p-c1 6)
+ (draw-square p-c2 6))
+ (with-pen l1-pen
+ (draw-line i1 i2)
+ (draw-line i2 i3)
+ (draw-circle i1 5)
+ (draw-circle i2 5)
+ (draw-circle i3 5))
+ (with-pen l2-pen
+ (draw-line ii1 ii2)
+ (draw-circle ii1 3)
+ (draw-circle ii2 3))
+ (with-pen final-pen
+ (bezier (vec-x p-from) (vec-y p-from)
+ (vec-x p-c1) (vec-y p-c1)
+ (vec-x p-c2) (vec-y p-c2)
+ (vec-x p-to) (vec-y p-to))
+ (loop :for i :from 0.0 :to 1.0 :by 0.01
+ :do (draw-point (cubic-bezier p-from p-to p-c1 p-c2 i)))
+ (draw-circle f 5))
+
+ )
)
+
;;
))
@@ -60,12 +106,20 @@
(defun reset (game)
(setf (slot-value game 'ready) nil)
- (setf (slot-value game 'results)
- (make-array 100 :initial-element 0)
- (slot-value game 'dots)
- (loop :repeat 500
- :collect (cons (random-dist 0 *width* 4)
- (random-dist 0 *height* 4))))
+ (setf (slot-value game 'p-from)
+ (make-vec 20 (random-around *center-y* 50))
+
+ (slot-value game 'p-c1)
+ (make-vec (* *width* 1/3) (random *height*))
+
+ (slot-value game 'p-c2)
+ (make-vec (* *width* 2/3) (random *height*))
+
+ (slot-value game 'p-to)
+ (make-vec (- *width* 20) (random-around *center-y* 50))
+
+ (slot-value game 'ts) 0
+ )
(setf (slot-value game 'ready) t))
--- a/src/math.lisp Wed May 04 20:05:07 2016 +0000
+++ b/src/math.lisp Wed May 04 21:36:46 2016 +0000
@@ -1,12 +1,18 @@
(in-package #:coding-math.math)
-(declaim (inline outsidep insidep wrap-zero wrap-range))
-(declaim (inline norm lerp clamp distance))
+(declaim (inline square outsidep insidep wrap-zero wrap-range
+ norm lerp clamp distance))
+
;;;; Constants
(defparameter tau (* pi 2))
+;; Basics
+(defun square (x)
+ (* x x))
+
+
;; Geometry
(defun distance (x0 y0 x1 y1)
(sqrt (+ (square (- x0 x1))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/points.lisp Wed May 04 21:36:46 2016 +0000
@@ -0,0 +1,31 @@
+(in-package #:coding-math.points)
+
+(defun quadratic-bezier (from to control n)
+ (vec-lerp (vec-lerp from control n)
+ (vec-lerp control to n)
+ n))
+
+(defun fast-quadratic-bezier (from to control n
+ &optional (destination (make-vec)))
+ (with-vecs ((fx fy) from
+ (tx ty) to
+ (cx cy) control)
+ (setf (vec-x destination)
+ (+ (* (square (- 1 n)) fx)
+ (* 2 (- 1 n) n cx)
+ (* n n tx))
+ (vec-y destination)
+ (+ (* (square (- 1 n)) fy)
+ (* 2 (- 1 n) n cy)
+ (* n n ty))))
+ (values))
+
+
+(defun cubic-bezier (from to control-1 control-2 n)
+ (vec-lerp (vec-lerp (vec-lerp from control-1 n)
+ (vec-lerp control-1 control-2 n)
+ n)
+ (vec-lerp (vec-lerp control-1 control-2 n)
+ (vec-lerp control-2 to n)
+ n)
+ n))
--- a/src/vectors.lisp Wed May 04 20:05:07 2016 +0000
+++ b/src/vectors.lisp Wed May 04 21:36:46 2016 +0000
@@ -1,7 +1,12 @@
(in-package #:coding-math.vectors)
-(declaim (inline vec-x vec-y make-vec))
+(declaim (inline vec-x vec-y make-vec
+ vec-magnitude vec-angle vec-direction
+ vec-add vec-sub vec-mul vec-div
+ vec-add! vec-sub! vec-mul! vec-div!
+ vec-lerp
+ ))
(defstruct (vec
(:constructor make-vec
@@ -10,6 +15,9 @@
(x 0 :type real)
(y 0 :type real))
+(defun make-random-vec (max-x max-y)
+ (make-vec (random max-x) (random max-y)))
+
(defun make-vec-md (magnitude angle)
(let ((v (make-vec 0 0)))
@@ -27,6 +35,12 @@
(,(second bindings) (vec-y ,vec)))
,@body)))
+(defmacro with-vecs (bindings &body body)
+ (if (null bindings)
+ `(progn ,@body)
+ (destructuring-bind (vars vec-form . remaining) bindings
+ `(with-vec ,vars ,vec-form (with-vecs ,remaining ,@body)))))
+
(defun vec-magnitude (vec)
(with-vec (x y) vec
@@ -91,6 +105,13 @@
(vec-y v) (/ (vec-y v) s)))
+(defun vec-lerp (v1 v2 n)
+ (with-vecs ((x1 y1) v1
+ (x2 y2) v2)
+ (make-vec (lerp x1 x2 n)
+ (lerp y1 y2 n))))
+
+
(defun vec-to-string (v)
(format nil "[~A ~A]" (vec-x v) (vec-y v)))