# HG changeset patch # User Steve Losh # Date 1517958318 18000 # Node ID ba8de632202256037a90c0f6417fb92230a76f8e # Parent f0fe6cc0a43f4b4eeb31bc976ce8b98dc88914e6 Refactor drawing array handling, add lparallel diff -r f0fe6cc0a43f -r ba8de6322022 flax.asd --- a/flax.asd Mon Feb 05 23:54:28 2018 -0500 +++ b/flax.asd Tue Feb 06 18:05:18 2018 -0500 @@ -8,6 +8,7 @@ :cl-vectors :iterate :losh + :lparallel :zpng) :serial t diff -r f0fe6cc0a43f -r ba8de6322022 package.lisp --- a/package.lisp Mon Feb 05 23:54:28 2018 -0500 +++ b/package.lisp Tue Feb 06 18:05:18 2018 -0500 @@ -14,7 +14,6 @@ (:export :color :with-color - :blend! :hsv :rgb)) @@ -25,6 +24,7 @@ (:export :with-rendering :render + :fade :triangle :path)) diff -r f0fe6cc0a43f -r ba8de6322022 src/base.lisp --- a/src/base.lisp Mon Feb 05 23:54:28 2018 -0500 +++ b/src/base.lisp Tue Feb 06 18:05:18 2018 -0500 @@ -1,5 +1,7 @@ (in-package :flax.base) +(setf lparallel:*kernel* (lparallel:make-kernel 6)) + (defun rand (bound) (pcg:pcg-random t bound)) diff -r f0fe6cc0a43f -r ba8de6322022 src/drawing.lisp --- a/src/drawing.lisp Mon Feb 05 23:54:28 2018 -0500 +++ b/src/drawing.lisp Tue Feb 06 18:05:18 2018 -0500 @@ -10,8 +10,9 @@ value)) (defmacro with-coordinates (image bindings &body body) - (with-gensyms (width height) - `(destructuring-bind (,width ,height) (array-dimensions ,image) + (with-gensyms (width height channels) + `(destructuring-bind (,height ,width ,channels) (array-dimensions ,image) + (declare (ignore ,channels)) (let* ,(iterate (for (x-symbol y-symbol coord) :in bindings) (for c = (gensym "coord")) (appending @@ -94,14 +95,14 @@ ;;;; Glue --------------------------------------------------------------------- (deftype image () - '(simple-array color (* *))) - -(deftype prepared-image () - '(simple-array (simple-array (integer 0 255) (3)) (* *))) + '(simple-array (double-float 0.0d0 1.0d0) (* * 3))) (deftype index () `(integer 0 (,array-dimension-limit))) +(deftype row-buffer () + '(simple-array (integer 0 255) (*))) + (defun-inline normalize-alpha (alpha) (declare (optimize speed) @@ -115,75 +116,97 @@ (type index x y) (type (double-float 0.0d0 1.0d0) opacity) (type fixnum alpha)) - (let ((pixel (aref image x y))) - (declare (type color pixel)) - (blend! pixel color (* opacity (normalize-alpha alpha))) + (let ((pixel-alpha (* opacity (normalize-alpha alpha)))) + (zapf (aref image y x 0) (lerp % (flax.colors::r color) pixel-alpha) + (aref image y x 1) (lerp % (flax.colors::g color) pixel-alpha) + (aref image y x 2) (lerp % (flax.colors::b color) pixel-alpha)) (values))) -(defun-inline prepare-channel (value) +(defun-inline prepare-sample (value) (declare (optimize speed) (type (double-float 0.0d0 1.0d0) value)) (round (* 255.0d0 value))) -(defun-inline prepare-pixel (pixel) - (declare (optimize speed) - (type color pixel)) - (with-color (pixel r g b) - (list (prepare-channel r) - (prepare-channel g) - (prepare-channel b) - 255))) +(defun make-image (width height color) + (let ((image (make-array (list height width 3) + :element-type 'double-float + :initial-element 1.0d0))) + (with-color (color r g b) + (lparallel:pdotimes (row height) + (dotimes (col width) + (setf (aref image row col 0) r + (aref image row col 1) g + (aref image row col 2) b)))) + image)) -(defun make-initialized-array (dimensions function &rest make-array-args) - (let ((result (apply #'make-array dimensions make-array-args))) - (do-array (v result) - (setf v (funcall function))) - result)) - -(defun make-image (width height) - (make-initialized-array (list width height) - (curry #'rgb 1 1 1))) - +(defun fill-row (image row buffer) + (declare (optimize speed) + (type image image) + (type index row) + (type row-buffer buffer)) + (iterate + (declare (iterate:declare-variables)) + (with width = (length buffer)) + (for (the fixnum i) :from (* row width)) + (for (the fixnum j) :from 0 :below width) + (setf (aref buffer j) + (prepare-sample (row-major-aref image i))))) (defun write-file (image filename) - (destructuring-bind (width height) (array-dimensions image) + (destructuring-bind (height width channels) (array-dimensions image) + (declare (ignore channels)) (let ((png (make-instance 'zpng:pixel-streamed-png - :color-type :truecolor-alpha + :color-type :truecolor :width width - :height height))) + :height height)) + (buffer (make-array (* width 3) :element-type '(integer 0 255)))) (with-open-file (stream filename :direction :output :if-exists :supersede :if-does-not-exist :create :element-type '(unsigned-byte 8)) (zpng:start-png png stream) - (dotimes (y height) - (dotimes (x width) - (zpng:write-pixel (prepare-pixel (aref image x y)) png))) + (dotimes (row height) + (fill-row image row buffer) + (zpng:write-row buffer png)) (zpng:finish-png png))))) -(defun blit (image object) +(defun render-object (image object) (let ((state (aa:make-state))) (draw image state object) - (destructuring-bind (width height) (array-dimensions image) + (destructuring-bind (height width channels) (array-dimensions image) + (declare (ignore channels)) (aa:cells-sweep/rectangle state 0 0 width height (curry #'put-pixel image (color object) (opacity object)))))) +(defun render (image objects) + (map nil (curry #'render-object image) objects)) -(defun render (image objects) - (map nil (curry #'blit image) objects)) +(defun fade (image color alpha) + (declare (optimize speed) + (type image image) + (type color color) + (type (double-float 0.0d0 1.0d0) alpha)) + (nest (with-color (color r g b)) + (lparallel:pdotimes (row (array-dimension image 0))) + (dotimes (col (array-dimension image 1))) + (zapf (aref image row col 0) (lerp % r alpha) + (aref image row col 1) (lerp % g alpha) + (aref image row col 2) (lerp % b alpha)))) (defmacro with-rendering - ((image-symbol filename width height &key (padding 0.03)) + ((image-symbol filename width height &key + (padding 0.03) + (background '(rgb 1 1 1))) &body body) `(progn (sb-ext:gc :full t) - (let ((,image-symbol (make-image ,width ,height)) + (let ((,image-symbol (make-image ,width ,height ,background)) (*padding* ,padding)) - ,@body - (write-file ,image-symbol ,filename) - (values)))) + (prog1 ,@body + (write-file ,image-symbol ,filename))))) + diff -r f0fe6cc0a43f -r ba8de6322022 src/looms/001-triangles.lisp --- a/src/looms/001-triangles.lisp Mon Feb 05 23:54:28 2018 -0500 +++ b/src/looms/001-triangles.lisp Tue Feb 06 18:05:18 2018 -0500 @@ -100,4 +100,4 @@ (flax.drawing:render image (convert (generate-universe-balancing depth seed))))) -;; (time (loom 19 15 "out.png" 1000 1000)) +;; (time (loom nil 18 "out.png" 3000 3000)) diff -r f0fe6cc0a43f -r ba8de6322022 src/looms/002-wobbly-lines.lisp --- a/src/looms/002-wobbly-lines.lisp Mon Feb 05 23:54:28 2018 -0500 +++ b/src/looms/002-wobbly-lines.lisp Tue Feb 06 18:05:18 2018 -0500 @@ -4,6 +4,8 @@ (defvar *brush* nil) (defvar *hue* nil) (defvar *hue-increment* nil) +(defparameter *swing* 0.03) +(defparameter *background* (hsv 0 0 0.05)) ;;;; Elements ----------------------------------------------------------------- @@ -15,10 +17,10 @@ ;;;; Element Conversion ------------------------------------------------------- -(defun convert (line total-ticks) +(defun convert (line opacity) (list (flax.drawing::path (coerce (points line) 'list) - :color (hsv *hue* 1 1) - :opacity (/ 95.0d0 total-ticks)))) + :color (hsv *hue* 0.9 1) + :opacity opacity))) ;;;; Generation --------------------------------------------------------------- @@ -30,10 +32,11 @@ ;;;; Tick --------------------------------------------------------------------- +(defun perturb-point (point) + (incf (y point) (random-range-inclusive (- *swing*) *swing* #'rand))) + (defun perturb-line (line) - (map nil (lambda (c) - (incf (y c) (random-range-inclusive -0.025 0.025 #'rand))) - (points line))) + (map nil #'perturb-point (points line))) (defun smooth-line (line) (iterate @@ -54,15 +57,23 @@ ;;;; Main --------------------------------------------------------------------- (defun loom (seed ticks filename width height) (with-seed seed - (flax.drawing:with-rendering (image filename width height :padding 0.0) + (flax.drawing:with-rendering (image filename width height + :padding 0.0 + :background *background*) (let ((line (initial 300)) (*hue* (random-range 0.0d0 1.0d0 #'rand)) - (*hue-increment* (/ (random-range 0.15d0 0.3d0 #'rand) ticks))) + (*hue-increment* (/ (random-range 0.15d0 0.3d0 #'rand) ticks)) + (mode (random-elt '(:opaque :transparent :fade) #'rand))) (dotimes (tick ticks) (when (dividesp tick (/ (expt 10 (floor (log (1- ticks) 10))) 2)) (print tick)) - (flax.drawing:render image (convert line ticks)) - (tick line)))))) + (when (and (eq mode :fade) (dividesp tick 10)) + (flax.drawing:fade image *background* 0.04d0)) + (flax.drawing:render image (convert line (if (eq mode :transparent) + (/ 95.0d0 ticks) + 1.0d0))) + (tick line)) + mode)))) -;; (time (loom nil 1000 "out.png" 3000 500)) +;; (time (loom nil 2000 "out.png" 3000 500))