--- a/flax.asd Wed Apr 04 23:37:07 2018 -0400
+++ b/flax.asd Fri Apr 06 23:37:30 2018 -0400
@@ -30,7 +30,6 @@
(:module "src" :serial t
:components
((:file "base")
- (:file "coordinates")
(:file "colors")
(:module "drawing" :serial t
:components ((:file "api")
--- a/package.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/package.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -7,16 +7,6 @@
:randomly-initialize
:round-to))
-(defpackage :flax.coordinates
- (:use :cl :iterate :losh :flax.base :flax.quickutils)
- (:export
- :coord :x :y
- :radial
- :distance
- :coord+
- :clerp
- :coord-to-cons))
-
(defpackage :flax.colors
(:use :cl :iterate :losh :flax.base :flax.quickutils)
(:export
@@ -28,7 +18,7 @@
(defpackage :flax.drawing
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates)
+ :3d-vectors)
(:export
:with-rendering
:render
@@ -44,46 +34,42 @@
(defpackage :flax.looms.001-triangles
(:use :cl :iterate :losh :flax.base :flax.quickutils
- :flax.coordinates
:3d-vectors)
(:export :loom))
(defpackage :flax.looms.002-wobbly-lines
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates
:3d-vectors)
(:export :loom))
(defpackage :flax.looms.003-basic-l-systems
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates)
+ :3d-vectors)
(:export :loom))
(defpackage :flax.looms.004-turtle-curves
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates)
+ :3d-vectors)
(:export :loom))
(defpackage :flax.looms.005-simple-triangulations
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates
:3d-vectors)
(:export :loom))
(defpackage :flax.looms.006-tracing-lines
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates)
+ :3d-vectors)
(:export :loom))
(defpackage :flax.looms.007-stipple
(:use :cl :iterate :losh :flax.base :flax.quickutils
:flax.colors
- :flax.coordinates
:3d-vectors)
(:export :loom))
--- a/src/base.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/base.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -1,6 +1,6 @@
(in-package :flax.base)
-;;;; Randomness ---------------------------------------------------------
+;;;; Randomness ---------------------------------------------------------------
(defun rand (bound)
(pcg:pcg-random t bound))
@@ -22,7 +22,7 @@
,@body))
-;;;; Math ---------------------------------------------------------
+;;;; Math ---------------------------------------------------------------------
(defun round-to (number precision)
"Round `number` to the given `precision`.
@@ -35,3 +35,4 @@
"
(* precision (round number precision)))
+
--- a/src/coordinates.lisp Wed Apr 04 23:37:07 2018 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,29 +0,0 @@
-(in-package :flax.coordinates)
-
-(defstruct (coord (:conc-name "")
- (:constructor make-coord (x y)))
- (x (error "Required") :type single-float)
- (y (error "Required") :type single-float))
-
-(defun coord (x y)
- (make-coord (coerce x 'single-float)
- (coerce y 'single-float)))
-
-(defun radial (angle magnitude)
- (coord (* magnitude (cos angle))
- (* magnitude (sin angle))))
-
-(defun distance (c1 c2)
- (sqrt (+ (square (- (x c2) (x c1)))
- (square (- (y c2) (y c1))))))
-
-(defun clerp (from to n)
- (coord (lerp (x from) (x to) n)
- (lerp (y from) (y to) n)))
-
-(defun coord+ (a b)
- (coord (+ (x a) (x b))
- (+ (y a) (y b))))
-
-(defun coord-to-cons (c)
- (cons (x c) (y c)))
--- a/src/drawing/api.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/drawing/api.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -16,7 +16,7 @@
;;;; Utils --------------------------------------------------------------------
-(defun convert-coord (value dimension)
+(defun convert-coordinate (value dimension)
(map-range (- *padding*) (1+ *padding*)
0 dimension
value))
@@ -33,8 +33,8 @@
(with-gensyms (coord)
(destructuring-bind (x-symbol y-symbol value) binding
`((,coord ,value)
- (,x-symbol (convert-coord (x ,coord) ,width))
- (,y-symbol (convert-coord (y ,coord) ,height))))))
+ (,x-symbol (convert-coordinate (vx ,coord) ,width))
+ (,y-symbol (convert-coordinate (vy ,coord) ,height))))))
(parse-magnitude-binding (binding)
(destructuring-bind (magnitude-symbol value) binding
`((,magnitude-symbol (convert-magnitude ,canvas ,value)))))
@@ -48,7 +48,7 @@
(defun coord-to-string (c)
- (format nil "(~A, ~A)" (x c) (y c)))
+ (format nil "(~A, ~A)" (vx c) (vy c)))
(defun coord-to-pair (canvas c)
(with-coordinates canvas ((x y c))
@@ -81,9 +81,9 @@
;;;; Triangles ----------------------------------------------------------------
(defclass* (triangle :conc-name "") (drawable)
- ((a :type coord)
- (b :type coord)
- (c :type coord)))
+ ((a :type vec2)
+ (b :type vec2)
+ (c :type vec2)))
(defun triangle (a b c &key (opacity 1.0d0) (color *black*))
(make-instance 'triangle :a a :b b :c c
@@ -93,18 +93,18 @@
(defmethod print-object ((o triangle) s)
(print-unreadable-object (o s :type t :identity nil)
(format s "(~D, ~D) (~D, ~D) (~D, ~D)"
- (x (a o))
- (y (a o))
- (x (b o))
- (y (b o))
- (x (c o))
- (y (c o)))))
+ (vx (a o))
+ (vy (a o))
+ (vx (b o))
+ (vy (b o))
+ (vx (c o))
+ (vy (c o)))))
;;;; Rectangles ---------------------------------------------------------------
(defclass* (rectangle :conc-name "") (drawable)
- ((a :type coord)
- (b :type coord)
+ ((a :type vec2)
+ (b :type vec2)
(round-corners :type float :initform 0.0)))
(defun rectangle (a b &key (opacity 1.0d0) (color *black*) round-corners)
@@ -116,10 +116,10 @@
(defmethod print-object ((o rectangle) s)
(print-unreadable-object (o s :type t :identity nil)
(format s "(~D, ~D) (~D, ~D)"
- (x (a o))
- (y (a o))
- (x (b o))
- (y (b o)))))
+ (vx (a o))
+ (vy (a o))
+ (vx (b o))
+ (vy (b o)))))
(defun compute-corner-rounding (canvas rect)
(if-let ((rounding (round-corners rect)))
@@ -132,7 +132,7 @@
;;;; Circles ------------------------------------------------------------------
(defclass* (circle :conc-name "") (drawable)
- ((center :type coord)
+ ((center :type vec2)
(radius :type single-float)))
(defun circle (center radius &key (opacity 1.0d0) (color *black*))
@@ -143,14 +143,14 @@
(defmethod print-object ((o circle) s)
(print-unreadable-object (o s :type t :identity nil)
(format s "(~D, ~D) radius ~D"
- (x (center o))
- (y (center o))
+ (vx (center o))
+ (vy (center o))
(radius o))))
;;;; Points -------------------------------------------------------------------
(defclass* (point :conc-name "") (drawable)
- ((location :type coord)))
+ ((location :type vec2)))
(defun point (location &key (opacity 1.0d0) (color *black*))
(make-instance 'point :location location
@@ -160,13 +160,13 @@
(defmethod print-object ((o point) s)
(print-unreadable-object (o s :type t :identity nil)
(format s "(~D, ~D)"
- (x (location o))
- (y (location o)))))
+ (vx (location o))
+ (vy (location o)))))
;;;; Text ---------------------------------------------------------------------
(defclass* (text :conc-name "") (drawable)
- ((pos :type coord)
+ ((pos :type vec2)
(font :type string)
(size :type single-float)
(align :type keyword)
@@ -184,8 +184,8 @@
(print-unreadable-object (o s :type t :identity nil)
(format s "~S (~D, ~D)"
(content o)
- (x (pos o))
- (y (pos o)))))
+ (vx (pos o))
+ (vy (pos o)))))
;;;; Rendering ----------------------------------------------------------------
--- a/src/drawing/svg.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/drawing/svg.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -50,6 +50,7 @@
:fill (web-color (color circ))
:fill-opacity (opacity circ)))))
+
;;;; Points -------------------------------------------------------------------
(defmethod draw ((canvas svg-canvas) (p point))
(with-coordinates canvas
--- a/src/looms/001-triangles.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/001-triangles.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -25,9 +25,7 @@
;;;; Element Conversion -------------------------------------------------------
(defun convert-triangle (triangle)
(with-triangle (triangle)
- (flax.drawing:triangle (coord (vx a) (vy a))
- (coord (vx b) (vy b))
- (coord (vx c) (vy c)))))
+ (flax.drawing:triangle a b c)))
(defun convert (universe)
(mapcar #'convert-triangle universe))
@@ -108,4 +106,5 @@
(values depth))))
-;; (time (loom nil "out" :svg 800 800))
+;; (declaim (optimize (debug 3)))
+;; (time (loom nil "out" :svg 800 800 :depth 12))
--- a/src/looms/002-wobbly-lines.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/002-wobbly-lines.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -18,8 +18,7 @@
;;;; Element Conversion -------------------------------------------------------
(defun convert (line opacity)
- (list (flax.drawing::path (iterate (for p :in-whatever (points line))
- (collect (coord (vx p) (vy p))))
+ (list (flax.drawing::path (coerce (points line) 'list)
:color (hsv *hue* 0.9 1)
:opacity opacity)))
--- a/src/looms/003-basic-l-systems.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/003-basic-l-systems.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -72,9 +72,9 @@
(defun convert-symbol (symbol x y)
(flax.drawing:rectangle
- (coord x y)
- (coord (+ x (symbol-width symbol))
- (+ y *cell-height*))
+ (vec x y)
+ (vec (+ x (symbol-width symbol))
+ (+ y *cell-height*))
:color *brush*
:round-corners (/ *cell-unit* 2)))
@@ -110,4 +110,4 @@
-;; (time (loom-anabaena-catenula nil "out" :svg 800 800))
+;; (time (loom nil "out" :svg 800 800))
--- a/src/looms/004-turtle-curves.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/004-turtle-curves.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -26,9 +26,9 @@
(defmethod perform-command (turtle (command (eql 'f)) n)
(with-turtle (turtle)
(list (flax.drawing:path
- (list (coord x y)
+ (list (vec x y)
(progn (perform-command turtle 's n)
- (coord x y)))
+ (vec x y)))
:color *color*))))
(defmethod perform-command (turtle (command (eql 'l)) n)
@@ -73,14 +73,14 @@
(defun find-bounds (paths)
(iterate (for path :in paths)
(for (p1 p2) = (flax.drawing:points path))
- (maximizing (x p1) :into max-x)
- (maximizing (x p2) :into max-x)
- (maximizing (y p1) :into max-y)
- (maximizing (y p2) :into max-y)
- (minimizing (x p1) :into min-x)
- (minimizing (x p2) :into min-x)
- (minimizing (y p1) :into min-y)
- (minimizing (y p2) :into min-y)
+ (maximizing (vx p1) :into max-x)
+ (maximizing (vx p2) :into max-x)
+ (maximizing (vy p1) :into max-y)
+ (maximizing (vy p2) :into max-y)
+ (minimizing (vx p1) :into min-x)
+ (minimizing (vx p2) :into min-x)
+ (minimizing (vy p1) :into min-y)
+ (minimizing (vy p2) :into min-y)
(finally (return (list min-x min-y max-x max-y)))))
(defun scale (paths)
@@ -94,10 +94,10 @@
(for path :in paths)
(for (p1 p2) = (flax.drawing:points path))
(zapf
- (x p1) (map-range min-x max-x x-padding (- 1.0 x-padding) %)
- (y p1) (map-range min-y max-y y-padding (- 1.0 y-padding) %)
- (x p2) (map-range min-x max-x x-padding (- 1.0 x-padding) %)
- (y p2) (map-range min-y max-y y-padding (- 1.0 y-padding) %)))
+ (vx p1) (map-range min-x max-x x-padding (- 1.0 x-padding) %)
+ (vy p1) (map-range min-y max-y y-padding (- 1.0 y-padding) %)
+ (vx p2) (map-range min-x max-x x-padding (- 1.0 x-padding) %)
+ (vy p2) (map-range min-y max-y y-padding (- 1.0 y-padding) %)))
paths)
@@ -312,9 +312,9 @@
-;; (time (loom 12 "out" :plot 800 800
+;; (time (loom nil "out" :svg 800 800
;; ;; :l-system *hexagonal-gosper-curve*
-;; :iterations 5
+;; ;; :iterations 5
;; ;; :starting-angle (- 1/4tau)
;; ))
--- a/src/looms/005-simple-triangulations.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/005-simple-triangulations.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -5,17 +5,13 @@
(defparameter *point-size* 0.003)
(defun convert-point (point)
- (flax.drawing:circle (coord (vx point) (vy point))
- (random-gaussian *point-size*
+ (flax.drawing:circle point (random-gaussian *point-size*
(* 0.15 *point-size*)
#'rand)))
(defun convert-triangle (ratio tri)
(when (randomp ratio #'rand)
- (destructuring-bind (a b c) tri
- (list (flax.drawing:triangle (coord (vx a) (vy a))
- (coord (vx b) (vy b))
- (coord (vx c) (vy c)))))))
+ (list (apply #'flax.drawing:triangle tri))))
(defun convert (points ratio)
(append
--- a/src/looms/006-tracing-lines.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/006-tracing-lines.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -6,7 +6,7 @@
;;;; Convert ------------------------------------------------------------------
(defun convert-point (point x y)
- (coord x (+ y point)))
+ (vec x (+ y point)))
(defun convert-line (line y)
(flax.drawing:path
--- a/src/looms/007-stippling.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/src/looms/007-stippling.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -3,8 +3,7 @@
;;;; Convert ------------------------------------------------------------------
(defun convert (points)
- (iterate (for p :in points)
- (collect (flax.drawing:point (coord (vx p) (vy p))))))
+ (mapcar #'flax.drawing:point points))
;;;; Shapes -------------------------------------------------------------------
@@ -127,4 +126,4 @@
(values shapes))))
;; (time (loom 11 "out" :svg 800 800))
-;; (time (loom 112 "out" :plot 800 800 :ratio 40000))
+;; (time (loom 112 "out" :png 800 800 :ratio 4000000))
--- a/test/test.lisp Wed Apr 04 23:37:07 2018 -0400
+++ b/test/test.lisp Fri Apr 06 23:37:30 2018 -0400
@@ -3,8 +3,10 @@
(defun check (loom)
(terpri)
(losh:pr 'checking loom)
- (funcall loom nil "out" (losh:random-elt '(:png :svg :plot)) 500 500)
- (losh:pr 'ok))
+ (mapcar (lambda (output)
+ (funcall loom nil "out" output 500 500)
+ (losh:pr output 'OK))
+ '(:png :svg :plot)))
(progn
(check #'flax.looms.001-triangles:loom)