# HG changeset patch # User Steve Losh # Date 1560097003 14400 # Node ID 4b63cff9f91247f25f0f03015920883d7e4ab311 # Parent 4f1a10f252451df85602e425f51bb672f2b1975d Bug fixes and cleanup diff -r 4f1a10f25245 -r 4b63cff9f912 src/drawing/api.lisp --- a/src/drawing/api.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/drawing/api.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -7,23 +7,18 @@ ;;;; Canvas ------------------------------------------------------------------- (defclass* canvas () - ((width :type (integer 0)) - (height :type (integer 0)) + ((width :type (integer 1)) + (height :type (integer 1)) (padding :type (single-float 0.0 0.5) :initform 0.03) (output-transformation :type mat3))) (defun recompute-output-transformation (canvas) - (let* ((fw (coerce (width canvas) 'single-float)) - (fh (coerce (height canvas) 'single-float)) - (p (padding canvas)) - (pw (* p fw)) - (ph (* p fh)) - (w (- fw pw pw)) - (h (- fh ph ph))) - (setf (output-transformation canvas) - (transformation - (scale w h) - (translate pw ph))))) + (setf (output-transformation canvas) + (transformation + (place (vec 0 0) + (vec (coerce (width canvas) 'single-float) + (coerce (height canvas) 'single-float)) + :padding (padding canvas))))) (defmethod initialize-instance :after ((canvas canvas) &key) (recompute-output-transformation canvas)) @@ -123,9 +118,9 @@ (vy (c o))))) (defmethod ntransform ((triangle triangle) transformation) - (ntransform (a triangle)) - (ntransform (b triangle)) - (ntransform (c triangle)) + (ntransform (a triangle) transformation) + (ntransform (b triangle) transformation) + (ntransform (c triangle) transformation) triangle) @@ -139,7 +134,7 @@ (make-instance 'rectangle :a (homogenize a) :b (homogenize b) :color color :opacity (coerce opacity 'double-float) - :round-corners round-corners)) + :round-corners (or round-corners 0.0))) (defmethod print-object ((o rectangle) s) (print-unreadable-object (o s :type t :identity nil) @@ -158,9 +153,9 @@ 0)) (defmethod ntransform ((rectangle rectangle) transformation) - (ntransform (a rectangle)) - (ntransform (b rectangle)) - (callf (round-corners rectangle) #'ntransform) + (ntransform (a rectangle) transformation) + (ntransform (b rectangle) transformation) + (zapf (round-corners rectangle) (ntransform % transformation)) rectangle) @@ -182,8 +177,8 @@ (radius o)))) (defmethod ntransform ((circle circle) transformation) - (ntransform (center circle)) - (callf (radius circle) #'ntransform) + (ntransform (center circle) transformation) + (zapf (radius circle) (ntransform % transformation)) circle) @@ -203,7 +198,7 @@ (vy (location o))))) (defmethod ntransform ((point point) transformation) - (ntransform (location point)) + (ntransform (location point) transformation) point) @@ -231,8 +226,8 @@ (vy (pos o))))) (defmethod ntransform ((text text) transformation) - (ntransform (pos text)) - (callf (size text) #'ntransform) + (ntransform (pos text) transformation) + (zapf (size text) (ntransform % transformation)) text) @@ -272,7 +267,7 @@ :padding ,padding :background ,background))) (multiple-value-prog1 ,@body - (write-file ,canvas-symbol (full-filename ,filename ,canvas-type))))))) + (write-file ,canvas-symbol (full-filename ,filename ,canvas-type))))))) ;;;; Usage -------------------------------------------------------------------- diff -r 4f1a10f25245 -r 4b63cff9f912 src/drawing/plot.lisp --- a/src/drawing/plot.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/drawing/plot.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -6,13 +6,14 @@ (defclass* plot-canvas (svg-canvas) ()) -(defmethod make-canvas ((type (eql :plot)) &key height width) +(defmethod make-canvas ((type (eql :plot)) &key height width padding) (let ((scene (svg:make-svg-toplevel 'svg:svg-1.1-toplevel :height height :width width))) (make-instance 'plot-canvas :height height :width width - :scene scene))) + :scene scene + :padding padding))) (defmethod file-extension ((type (eql :plot))) "svg") diff -r 4f1a10f25245 -r 4b63cff9f912 src/drawing/png.lisp --- a/src/drawing/png.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/drawing/png.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -46,11 +46,12 @@ (defclass* png-canvas (canvas) (image state)) -(defmethod make-canvas ((type (eql :png)) &key height width background) +(defmethod make-canvas ((type (eql :png)) &key height width background padding) (make-instance 'png-canvas :height height :width width - :image (make-image width height background))) + :image (make-image width height background) + :padding padding)) ;;;; Rectangles --------------------------------------------------------------- diff -r 4f1a10f25245 -r 4b63cff9f912 src/drawing/svg.lisp --- a/src/drawing/svg.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/drawing/svg.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -13,7 +13,7 @@ (defclass* svg-canvas (canvas) (scene)) -(defmethod make-canvas ((type (eql :svg)) &key height width background) +(defmethod make-canvas ((type (eql :svg)) &key height width background padding) (let ((scene (svg:make-svg-toplevel 'svg:svg-1.1-toplevel :height height :width width))) (svg:draw scene (:rect :x 0 :y 0 :width width :height height @@ -21,7 +21,8 @@ (make-instance 'svg-canvas :height height :width width - :scene scene))) + :scene scene + :padding padding))) ;;;; Rectangles --------------------------------------------------------------- diff -r 4f1a10f25245 -r 4b63cff9f912 src/package.lisp --- a/src/package.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/package.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -25,6 +25,7 @@ :transformation :scale :rotate + :place :translate :ntransform)) @@ -90,3 +91,9 @@ (:export :loom)) +(defpackage :flax.scratch + (:use :cl :iterate :losh :flax.base :flax.quickutils + :flax.colors + :flax.transform + :3d-vectors) + (:export)) diff -r 4f1a10f25245 -r 4b63cff9f912 src/transform.lisp --- a/src/transform.lisp Sun Jun 09 11:27:41 2019 -0400 +++ b/src/transform.lisp Sun Jun 09 12:16:43 2019 -0400 @@ -21,6 +21,17 @@ 0 0 1) m)) +(defun place (m corner1 corner2 &key (padding 0.0)) + (let* ((fw (abs (- (vx corner1) (vx corner2)))) + (fh (abs (- (vy corner1) (vy corner2)))) + (pw (* padding fw)) + (ph (* padding fh)) + (w (- fw pw pw)) + (h (- fh ph ph)) + (x (+ (min (vx corner1) (vx corner2)) pw)) + (y (+ (min (vy corner1) (vy corner2)) ph))) + (translate (scale m w h) x y))) + (defmacro transformation (&rest transforms) `(-<> (id)