summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am7
-rw-r--r--chickadee/graphics/path.scm1554
-rw-r--r--data/shaders/path-frag.glsl93
-rw-r--r--data/shaders/path-vert.glsl44
-rw-r--r--doc/api.texi273
-rw-r--r--examples/path.scm80
6 files changed, 1991 insertions, 60 deletions
diff --git a/Makefile.am b/Makefile.am
index d98b4ba..eee4261 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -80,6 +80,7 @@ SOURCES = \
chickadee/graphics/phong.scm \
chickadee/graphics/pbr.scm \
chickadee/graphics/model.scm \
+ chickadee/graphics/path.scm \
chickadee/scripting/agenda.scm \
chickadee/scripting/script.scm \
chickadee/scripting/channel.scm \
@@ -98,6 +99,7 @@ EXTRA_DIST += \
examples/game-controller.scm \
examples/sprite-batch.scm \
examples/model.scm \
+ examples/path.scm \
examples/images/AUTHORS \
examples/images/chickadee.png \
examples/images/controller-buttons.png \
@@ -116,6 +118,11 @@ fontsdir = $(pkgdatadir)/fonts
dist_fonts_DATA = \
data/fonts/Inconsolata-Regular.otf
+shadersdir = $(pkgdatadir)/shaders
+dist_shaders_DATA = \
+ data/shaders/path-vert.glsl \
+ data/shaders/path-frag.glsl
+
info_TEXINFOS = doc/chickadee.texi
doc_chickadee_TEXINFOS = \
doc/fdl.texi \
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
new file mode 100644
index 0000000..5412c30
--- /dev/null
+++ b/chickadee/graphics/path.scm
@@ -0,0 +1,1554 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary
+;;
+;; Vector path rendering.
+;;
+;;; Code:
+
+(define-module (chickadee graphics path)
+ #:use-module (chickadee array-list)
+ #:use-module (chickadee config)
+ #:use-module (chickadee graphics)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics gl)
+ #:use-module (chickadee graphics shader)
+ #:use-module (chickadee graphics stencil)
+ #:use-module (chickadee graphics buffer)
+ #:use-module (chickadee math)
+ #:use-module (chickadee math bezier)
+ #:use-module (chickadee math matrix)
+ #:use-module (chickadee math rect)
+ #:use-module (chickadee math vector)
+ #:use-module (gl)
+ #:use-module (ice-9 match)
+ #:use-module ((rnrs base) #:select (mod))
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-4)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-43)
+ #:export (path
+ path?
+ move-to
+ line-to
+ bezier-to
+ close-path
+ arc
+ arc-to
+ line
+ polyline
+ rectangle
+ square
+ rounded-rectangle
+ regular-polygon
+ ellipse
+ circle
+ stroke
+ fill
+ fill-and-stroke
+ with-style
+ with-transform
+ translate
+ rotate
+ scale
+ superimpose
+ pad
+ beside
+ below
+ make-empty-canvas
+ make-canvas
+ canvas?
+ set-canvas-painter!
+ set-canvas-matrix!
+ draw-canvas))
+
+
+;;;
+;;; Paths
+;;;
+
+;; TODO: Support clockwise *and* counterclockwise winding.
+
+;; Meet the primitive commands: move-to, line-to, bezier-to, and
+;; close-path.
+(define (move-to point)
+ `(move-to ,point))
+
+(define (line-to point)
+ `(line-to ,point))
+
+(define (bezier-to control1 control2 point)
+ `(bezier-to ,control1 ,control2 ,point))
+
+(define (close-path)
+ '(close))
+
+;; Arcs are interesting in that they can be built from the primitives
+;; above *but* they need to know the previous point in the path first.
+;; Because of this context sensitivity, we must defer the process of
+;; creating the command list until we have a full path assembled.
+;;
+;; So in addition to our primitives, we need one more: expand. The
+;; expand command is like a trivial macro expander. It accepts a proc
+;; with a single argument: The previous point in the path.
+(define (arc center rx ry angle-start angle-end)
+ ;; This algorithm is based on "Approximating Arcs Using Cubic Bézier
+ ;; Curves" by Joe Cridge:
+ ;; https://web.archive.org/web/20170829122313/https://www.joecridge.me/content/pdf/bezier-arcs.pdf
+ (define (adjust-angle angle)
+ ;; Clamp within [0, 2pi] range.
+ (let* ((clamped (mod angle 2pi))
+ (adjusted (atan (* (/ rx ry) (tan clamped)))))
+ ;; Adjust angles to counter linear scaling.
+ (cond
+ ((<= clamped pi/2)
+ adjusted)
+ ((and (> clamped pi/2)
+ (<= clamped (* pi 1.5)))
+ (+ adjusted pi))
+ (else
+ (+ adjusted 2pi)))))
+ (let* ((angle-start (adjust-angle angle-start))
+ (angle-end* (adjust-angle angle-end))
+ (angle-end (if (> angle-start angle-end*)
+ (+ angle-end* 2pi)
+ angle-end*))
+ ;; Don't bother making a curve for an angle smaller than
+ ;; this.
+ (min-angle .00001)
+ (cx (vec2-x center))
+ (cy (vec2-y center)))
+ (define (expand-arc prev-point)
+ ;; Break the arc into a series of bezier curves where each curve
+ ;; covers at most pi/2 radians of the total curve.
+ (let loop ((start angle-start)
+ ;; Carrying over some values from each iteration to
+ ;; reduce redundant sin/cos calls.
+ (cos-start #f)
+ (sin-start #f)
+ (x1 #f)
+ (y1 #f))
+ (let ((delta (- angle-end start)))
+ (if (> delta min-angle)
+ (if x1
+ ;; Iteration 2+: Create a bezier curve for up to pi/2
+ ;; radians of the arc. Limiting a curve to <= pi/2
+ ;; radians creates a very close approximation of the
+ ;; true curve.
+ (let* ((size (min delta pi/2)) ; max segment angle is pi/2
+ ;; This curve segment spans the range [start,
+ ;; end] radians.
+ (end (+ start size))
+ (cos-end (cos end))
+ (sin-end (sin end))
+ ;; The end point is on the true arc.
+ (x2 (+ cx (* cos-end rx)))
+ (y2 (+ cy (* sin-end ry)))
+ ;; Alpha is the segment angle split in half.
+ ;; Looking at this on the unit circle, it puts
+ ;; half of the arc segment above the x axis and
+ ;; the other half below. Alpha is <= pi/4.
+ (alpha (/ size 2.0))
+ (cos-alpha (cos alpha))
+ ;; The unscaled, unrotated x coordinate of the
+ ;; control points. This formula makes it so
+ ;; that the midpoint of the bezier curve is the
+ ;; midpoint of the true arc.
+ (control-x (/ (- 4.0 cos-alpha) 3.0))
+ ;; The unscaled, unrotated, positive y
+ ;; coordinate of the control points. This
+ ;; formula makes it so that the control points
+ ;; are tangents to the true arc.
+ (control-y (+ (sin alpha)
+ (* (- cos-alpha control-x)
+ (/ 1.0 (tan alpha)))))
+ ;; All the preceding calculations were done
+ ;; with an arc segment somewhere in the range
+ ;; [-pi/4, pi/4]. In order to create a curve
+ ;; for the range [start, end], we need to
+ ;; rotate.
+ (rotation (+ start alpha))
+ (cos-rotation (cos rotation))
+ (sin-rotation (sin rotation))
+ ;; Compute the actual control points by
+ ;; applying the necessary rotation and linear
+ ;; scaling to achieve the ellipitcal shape at
+ ;; the desired size and location.
+ ;;
+ ;; Control point 1:
+ (cx1 (+ cx (* (+ (* control-x cos-rotation)
+ (* control-y sin-rotation))
+ rx)))
+ (cy1 (+ cy (* (- (* control-x sin-rotation)
+ (* control-y cos-rotation))
+ ry)))
+ ;; Control point 2:
+ (cx2 (+ cx (* (- (* control-x cos-rotation)
+ (* control-y sin-rotation))
+ rx)))
+ (cy2 (+ cy (* (+ (* control-x sin-rotation)
+ (* control-y cos-rotation))
+ ry))))
+ (cons (bezier-to (vec2 cx1 cy1)
+ (vec2 cx2 cy2)
+ (vec2 x2 y2))
+ (loop end cos-end sin-end x2 y2)))
+ ;; First iteration: Compute the starting point and move
+ ;; the brush to that point.
+ (let* ((cos-start (cos start))
+ (sin-start (sin start))
+ (x1 (+ cx (* cos-start rx)))
+ (y1 (+ cy (* sin-start ry))))
+ (cons (if prev-point
+ (line-to (vec2 x1 y1))
+ (move-to (vec2 x1 y1)))
+ (loop start cos-start sin-start x1 y1))))
+ ;; The remaining arc segment to render is either 0 or so
+ ;; miniscule that it won't be visible, so we're done.
+ '()))))
+ `(expand ,expand-arc)))
+
+;; TODO: Make this work correctly.
+;; (define* (arc-to control point radius)
+;; (define distance-tolerance 0.01)
+;; (define (close? a b)
+;; (let ((dx (- (vec2-x b) (vec2-x a)))
+;; (dy (- (vec2-y b) (vec2-y a))))
+;; (< (+ (* dx dx) (* dy dy))
+;; (* distance-tolerance distance-tolerance))))
+;; (define (expand-arc-to prev-point)
+;; (unless prev-point
+;; (error "path cannot start with arc-to"))
+;; ;; If the points are really close together, just use a line
+;; ;; segment instead of an arc.
+;; (if (or (close? prev-point control)
+;; (close? control point)
+;; (< radius distance-tolerance))
+;; `((line-to ,point))
+;; (let* ((d0 (vec2-normalize (vec2- prev-point control)))
+;; (d1 (vec2-normalize (vec2- point control)))
+;; (a (acos (+ (* (vec2-x d0) (vec2-x d1))
+;; (* (vec2-y d0) (vec2-y d1)))))
+;; (d (/ radius (tan (/ a 2.0)))))
+;; (cond
+;; ((> d 10000.0)
+;; `((line-to ,point)))
+;; ((> (vec2-cross d0 d1) 0.0)
+;; (pk 'clockwise)
+;; (let ((cx (+ (vec2-x control)
+;; (* (vec2-x d0) d)
+;; (* (vec2-y d0) radius)))
+;; (cy (+ (vec2-y control)
+;; (* (vec2-y d0) d)
+;; (* (- (vec2-x d0)) radius)))
+;; (angle-start (atan (- (vec2-y d0)) (vec2-x d0)))
+;; (angle-end (atan (vec2-y d1) (- (vec2-x d1)))))
+;; (list (arc (vec2 cx cy) radius radius angle-start angle-end))))
+;; (else
+;; (pk 'counter-clockwise)
+;; (let ((cx (+ (vec2-x control)
+;; (* (vec2-x d0) d)
+;; (* (- (vec2-y d0)) radius)))
+;; (cy (+ (vec2-y control)
+;; (* (vec2-y d0) d)
+;; (* (vec2-x d0) radius)))
+;; (angle-start (atan (vec2-y d0) (- (vec2-x d0))))
+;; (angle-end (atan (- (vec2-y d1)) (vec2-x d1))))
+;; (list (arc (vec2 cx cy) radius radius angle-start angle-end))))))))
+;; `(expand ,expand-arc-to))
+
+(define-record-type <path>
+ (make-path commands bounding-box)
+ path?
+ (commands path-commands)
+ (bounding-box path-bounding-box))
+
+(define (path . commands)
+ (let ((commands*
+ ;; Expand and flatten the command list.
+ (let loop ((commands commands)
+ (prev-point #f))
+ (match commands
+ (() '())
+ ((command . rest)
+ (match command
+ ((or ('move-to point)
+ ('line-to point)
+ ('bezier-to _ _ point))
+ (cons command (loop rest point)))
+ ;; Recursively expand nested command list.
+ (('expand proc)
+ (loop (append (proc prev-point) rest) prev-point))
+ ;; Flatten nested command list.
+ (((? pair? sub-commands) ...)
+ (loop (append sub-commands rest) prev-point))
+ (other
+ (cons other (loop rest prev-point)))))))))
+ (make-path (list->vector commands*)
+ ;; Compute bounding box.
+ (let loop ((commands commands*)
+ (xmin +inf.0)
+ (xmax -inf.0)
+ (ymin +inf.0)
+ (ymax -inf.0))
+ (match commands
+ (()
+ (make-rect xmin ymin (- xmax xmin) (- ymax ymin)))
+ ((((or 'move-to 'line-to) point) . rest)
+ (loop rest
+ (min xmin (vec2-x point))
+ (max xmax (vec2-x point))
+ (min ymin (vec2-y point))
+ (max ymax (vec2-y point))))
+ ((('bezier-to control1 control2 point) . rest)
+ (loop rest
+ (min xmin (vec2-x control1) (vec2-x control2) (vec2-x point))
+ (max xmax (vec2-x control1) (vec2-x control2) (vec2-x point))
+ (min ymin (vec2-y control1) (vec2-y control2) (vec2-y point))
+ (max ymax (vec2-y control1) (vec2-y control2) (vec2-y point))))
+ ((_ . rest)
+ (loop rest xmin xmax ymin ymax)))))))
+
+
+;;;
+;;; Closed path constructors
+;;;
+
+(define (line start end)
+ (path (move-to start)
+ (line-to end)))
+
+(define (polyline p1 p2 . prest)
+ (apply path
+ (move-to p1)
+ (line-to p2)
+ (map line-to prest)))
+
+(define (rectangle bottom-left width height)
+ (let ((x (vec2-x bottom-left))
+ (y (vec2-y bottom-left)))
+ (path (move-to bottom-left) ; bottom left
+ (line-to (vec2 (+ x width) y)) ; bottom right
+ (line-to (vec2 (+ x width) (+ y height))) ; top right
+ (line-to (vec2 x (+ y height))) ; top left
+ (close-path)))) ; back to bottom left
+
+(define (square bottom-left size)
+ (rectangle bottom-left size size))
+
+;; Kappa is the constant used for calculating the locations of control
+;; points for cubic bezier curves in order to create 90 degree arcs.
+;;
+;; The derivation can be found here:
+;; http://www.whizkidtech.redprince.net/bezier/circle/kappa/
+(define kappa 0.5522847498307936)
+
+(define* (rounded-rectangle bottom-left width height #:key
+ (radius 4.0)
+ (radius-bottom-left radius)
+ (radius-bottom-right radius)
+ (radius-top-left radius)
+ (radius-top-right radius))
+ (let* ((hw (/ width 2.0))
+ (hh (/ height 2.0))
+ (x (vec2-x bottom-left))
+ (y (vec2-y bottom-left))
+ (rxbl (min radius-bottom-left hw))
+ (rybl (min radius-bottom-left hh))
+ (rxbr (min radius-bottom-right hw))
+ (rybr (min radius-bottom-right hh))
+ (rxtl (min radius-top-left hw))
+ (rytl (min radius-top-left hh))
+ (rxtr (min radius-top-right hw))
+ (rytr (min radius-top-right hh)))
+ (path (move-to (vec2 x (+ y rytl)))
+ (line-to (vec2 x (- (+ y height) rybl)))
+ (bezier-to (vec2 x
+ (- (+ y height) (* rybl (- 1.0 kappa))))
+ (vec2 (+ x (* rxbl (- 1.0 kappa)))
+ (+ y height))
+ (vec2 (+ x rxbl)
+ (+ y height)))
+ (line-to (vec2 (- (+ x width) rxbr)
+ (+ y height)))
+ (bezier-to (vec2 (- (+ x width) (* rxbr (- 1.0 kappa)))
+ (+ y height))
+ (vec2 (+ x width)
+ (- (+ y height) (* rybr (- 1.0 kappa))))
+ (vec2 (+ x width)
+ (- (+ y height) rybr)))
+ (line-to (vec2 (+ x width)
+ (+ y rytr)))
+ (bezier-to (vec2 (+ x width)
+ (+ y (* rytr (- 1.0 kappa))))
+ (vec2 (- (+ x width) (* rxtr (- 1.0 kappa)))
+ y)
+ (vec2 (- (+ x width) rxtr)
+ y))
+ (line-to (vec2 (+ x rxtl) y))
+ (bezier-to (vec2 (+ x (* rxtl (- 1.0 kappa)))
+ y)
+ (vec2 x
+ (+ y (* rytl (- 1.0 kappa))))
+ (vec2 x (+ y rytl)))
+ (close-path))))
+
+(define (regular-polygon center num-sides radius)
+ (let ((theta-step (/ 2pi num-sides)))
+ (apply path
+ (let loop ((i 0))
+ (cond
+ ;; Return to the starting point to close the polygon.
+ ((= i num-sides)
+ (list (close-path)))
+ ;; First point needs to move the brush to the initial
+ ;; position directly above the center point.
+ ((zero? i)
+ (cons (move-to (vec2/polar center radius pi/2))
+ (loop (+ i 1))))
+ ;; Draw a line to the next point. Lines are drawn in a
+ ;; counter clockwise order.
+ (else
+ (cons (line-to (vec2/polar center radius
+ (+ (* i theta-step) pi/2)))
+ (loop (+ i 1)))))))))
+
+(define (ellipse center rx ry)
+ (let ((cx (vec2-x center))
+ (cy (vec2-y center)))
+ ;; To begin, move brush to the left of the center point.
+ (path (move-to (vec2 (- cx rx) cy))
+ ;; Draw a curve 90 degrees clockwise. The brush is now
+ ;; above the center point. The first control point is
+ ;; directly above the start point. The second control point
+ ;; is directly to the left of the end point. The kappa
+ ;; constant is used to place the control points just right
+ ;; so as to form a 90 degree arc with the desired radii.
+ (bezier-to (vec2 (- cx rx) (+ cy (* ry kappa)))
+ (vec2 (- cx (* rx kappa)) (+ cy ry))
+ (vec2 cx (+ cy ry)))
+ ;; Draw the same type of curve again, moving the brush to
+ ;; the right of the center point.
+ (bezier-to (vec2 (+ cx (* rx kappa)) (+ cy ry))
+ (vec2 (+ cx rx) (+ cy (* ry kappa)))
+ (vec2 (+ cx rx) cy))
+ ;; Now the brush moves below the center point.
+ (bezier-to (vec2 (+ cx rx) (- cy (* ry kappa)))
+ (vec2 (+ cx (* rx kappa)) (- cy ry))
+ (vec2 cx (- cy ry)))
+ ;; And finally back to the starting point to the left of the
+ ;; center point.
+ (bezier-to (vec2 (- cx (* rx kappa)) (- cy ry))
+ (vec2 (- cx rx) (- cy (* ry kappa)))
+ (vec2 (- cx rx) cy)))))
+
+(define (circle center r)
+ (ellipse center r r))
+
+
+;;;
+;;; Path Tesselation
+;;;
+
+;; Tesselation is a 2 step process:
+;;
+;; Step 1: Compile path commands into a sequence of points that form
+;; line segments.
+;;
+;; Step 2: Use compiled points to fill vertex buffers with triangles
+;; for filling or stroking.
+(define-record-type <compiled-path>
+ (%make-compiled-path point-capacity point-count path-capacity path-count bounding-box)
+ compiled-path?
+ (point-count compiled-path-point-count set-compiled-path-point-count!)
+ (point-capacity compiled-path-point-capacity set-compiled-path-point-capacity!)
+ (path-count compiled-path-count set-compiled-path-count!)
+ (path-capacity compiled-path-capacity set-compiled-path-capacity!)
+ (points compiled-path-points set-compiled-path-points!)
+ (offsets compiled-path-offsets set-compiled-path-offsets!)
+ (counts compiled-path-counts set-compiled-path-counts!)
+ (bounding-box compiled-path-bounding-box))
+
+(define (resize-compiled-path-offsets-and-counts! compiled-path capacity)
+ (let ((new-offsets (make-u32vector capacity))
+ (new-counts (make-u32vector capacity)))
+ (unless (zero? (compiled-path-capacity compiled-path))
+ (let ((old-offsets (compiled-path-offsets compiled-path))
+ (old-counts (compiled-path-counts compiled-path)))
+ (bytevector-copy! old-offsets 0 new-offsets 0 (bytevector-length old-offsets))
+ (bytevector-copy! old-counts 0 new-counts 0 (bytevector-length old-counts))))
+ (set-compiled-path-offsets! compiled-path new-offsets)
+ (set-compiled-path-counts! compiled-path new-counts)
+ (set-compiled-path-capacity! compiled-path capacity)))
+
+(define (resize-compiled-path-points! compiled-path capacity)
+ (let ((new-points (make-f32vector (* capacity 2))))
+ (unless (zero? (compiled-path-point-capacity compiled-path))
+ (let ((old-points (compiled-path-points compiled-path)))
+ (bytevector-copy! old-points 0 new-points 0 (bytevector-length old-points))))
+ (set-compiled-path-points! compiled-path new-points)
+ (set-compiled-path-point-capacity! compiled-path capacity)))
+
+(define (make-compiled-path)
+ (let ((compiled-path (%make-compiled-path 0 0 0 0 (make-rect 0.0 0.0 0.0 0.0))))
+ (resize-compiled-path-offsets-and-counts! compiled-path 64)
+ (resize-compiled-path-points! compiled-path 256)
+ compiled-path))
+
+(define (clear-compiled-path compiled-path)
+ (set-compiled-path-count! compiled-path 0)
+ (set-compiled-path-point-count! compiled-path 0))
+
+(define %origin (vec2 0.0 0.0))
+
+(define (transform-bounding-box rect matrix)
+ (let* ((x1 (rect-x rect))
+ (y1 (rect-y rect))
+ (x2 (rect-right rect))
+ (y2 (rect-top rect))
+ (bottom-left (matrix3-transform matrix (vec2 x1 y1)))
+ (bottom-right (matrix3-transform matrix (vec2 x2 y1)))
+ (top-right (matrix3-transform matrix (vec2 x2 y2)))
+ (top-left (matrix3-transform matrix (vec2 x1 y2)))
+ (min-x (min (vec2-x bottom-left)
+ (vec2-x bottom-right)
+ (vec2-x top-right)
+ (vec2-x top-left)))
+ (min-y (min (vec2-y bottom-left)
+ (vec2-y bottom-right)
+ (vec2-y top-right)
+ (vec2-y top-left)))
+ (max-x (max (vec2-x bottom-left)
+ (vec2-x bottom-right)
+ (vec2-x top-right)
+ (vec2-x top-left)))
+ (max-y (max (vec2-y bottom-left)
+ (vec2-y bottom-right)
+ (vec2-y top-right)
+ (vec2-y top-left))))
+ (make-rect min-x min-y (- max-x min-x) (- max-y min-y))))
+
+(define (compile-path compiled-path path matrix)
+ ;; Command interpreter:
+ (define (add-point x y)
+ (let* ((n (compiled-path-point-count compiled-path))
+ (i (* n 2))
+ (c (compiled-path-point-capacity compiled-path)))
+ ;; Dynamically expand point buffer as needed.
+ (when (= n c)
+ (resize-compiled-path-points! compiled-path (* c 2)))
+ (let ((points (compiled-path-points compiled-path)))
+ (f32vector-set! points i x)
+ (f32vector-set! points (+ i 1) y)
+ (set-compiled-path-point-count! compiled-path (+ n 1)))))
+ (define (add-path offset)
+ (let* ((n (compiled-path-count compiled-path))
+ (c (compiled-path-capacity compiled-path)))
+ ;; Dynamically expand count/offset buffers, as needed.
+ (when (= n c)
+ (resize-compiled-path-offsets-and-counts! compiled-path (* c 2)))
+ (let ((offsets (compiled-path-offsets compiled-path))
+ (counts (compiled-path-counts compiled-path)))
+ (u32vector-set! offsets n offset)
+ (u32vector-set! counts n (- (compiled-path-point-count compiled-path) offset))
+ (set-compiled-path-count! compiled-path (+ n 1)))))
+ ;; Expand bounding box to cover the new path, taking into account
+ ;; the transformation matrix.
+ (rect-union! (compiled-path-bounding-box compiled-path)
+ (transform-bounding-box (path-bounding-box path) matrix))
+ (path-bounding-box path) (compiled-path-bounding-box compiled-path)
+ ;; Evaluate all commands. This simple virtual machine uses a
+ ;; brush-on-paper metaphor and has a few variables that can be
+ ;; manipulated:
+ ;;
+ ;; - offset: the index to the first point of the current path in the
+ ;; compiled path's collection of points.
+ ;;
+ ;; - brush: the current location of the imaginary brush that is
+ ;; drawing the path. Some commands move the brush while its on the
+ ;; paper, thus creating a path, while others may pick the brush up
+ ;; and move it to a different location.
+ ;;
+ ;; - first: the starting point of the current brush stroke. This is
+ ;; used to handle the close command, where a straight line is drawn
+ ;; directly back to the beginning of the path.
+ (let loop ((commands (path-commands path))
+ (i 0)
+ (offset (compiled-path-point-count compiled-path))
+ (brush %origin)
+ (first #f))
+ (cond
+ ((< i (vector-length commands))
+ (match (vector-ref commands i)
+ ;; Move the brush without adding any new points. Reset first
+ ;; and prev since the brush isn't on the paper anymore.
+ (('move-to point)
+ (let ((point (matrix3-transform matrix point)))
+ (if first
+ ;; Moving the brush completes the current path and starts
+ ;; a new one.
+ (begin
+ (add-path offset)
+ (loop commands (+ i 1) (compiled-path-point-count compiled-path) point #f))
+ ;; Moving the brush before drawing anything is a noop.
+ (loop commands (+ i 1) offset point #f))))
+ ;; Draw a line from the current brush position to the given
+ ;; point.
+ (('line-to point)
+ (let ((point (matrix3-transform matrix point)))
+ (if first
+ (begin
+ (add-point (vec2-x point) (vec2-y point))
+ (loop commands (+ i 1) offset point first))
+ ;; This is the first time we're moving the brush while
+ ;; its on the paper, so we have to add the initial brush
+ ;; point in addition to the line endpoint.
+ (begin
+ (add-point (vec2-x brush) (vec2-y brush))
+ (add-point (vec2-x point) (vec2-y point))
+ (loop commands (+ i 1) offset point brush)))))
+ ;; Draw a cubic bezier curve from the current brush position
+ ;; to the given point.
+ (('bezier-to control1 control2 point)
+ (let ((control1 (matrix3-transform matrix control1))
+ (control2 (matrix3-transform matrix control2))
+ (point (matrix3-transform matrix point)))
+ (unless first
+ (add-point (vec2-x brush) (vec2-y brush)))
+ ;; Approximate a Bezier curve using De Casteljau's method
+ ;; of recursive subdivision.
+ ;;
+ ;; This implementation is based on the paper "Piecewise
+ ;; Linear Approximation of Bezier Curves" (2000) by Kaspar
+ ;; Fischer.
+ ;;
+ ;; https://pdfs.semanticscholar.org/fdf9/3b43da6de234a023d0a0d353f713ba8c5cb5.pdf
+ (let flatten ((x1 (vec2-x brush))
+ (y1 (vec2-y brush))
+ (cx1 (vec2-x control1))
+ (cy1 (vec2-y control1))
+ (cx2 (vec2-x control2))
+ (cy2 (vec2-y control2))
+ (x2 (vec2-x point))
+ (y2 (vec2-y point)))
+ ;; Calculate how flat the curve is. If the curve is
+ ;; sufficiently flat, we can approximate it with a
+ ;; straight line from its start point to its end point. I
+ ;; don't understand this part yet, tbh, but it works
+ ;; well.
+ (let* ((ux (max (- (* cx1 3.0) (* x1 2.0) x2)
+ (- (* cx2 3.0) (* x2 2.0) x1)))
+ (uy (max (- (* cy1 3.0) (* y1 2.0) y2)
+ (- (* cy2 3.0) (* y2 2.0) y1)))
+ ;; TODO: Figure out a tolerance value based on the
+ ;; DPI of the screen we're rendering to so that
+ ;; our approximation will always appear smooth.
+ (tol 0.25)
+ (tolerance (* tol tol 16.0)))
+ ;; Are ya flat enough, son?
+ (if (<= (+ (* ux ux) (* uy uy)) tolerance)
+ ;; Curve is within the tolerance range for
+ ;; flatness. Add a point to the baked path and
+ ;; increment the point count.
+ (add-point x2 y2)
+ ;; Curve is not flat enough, so split the curve
+ ;; into 2 smaller curves (left and right) that
+ ;; together describe the same curve as the
+ ;; original. To figure out the start, end, and
+ ;; control points for these 2 smaller curves, we
+ ;; work from the start and end points of the
+ ;; original curve and move inward.
+ (let* (;; Left start point is the same as the
+ ;; original start point.
+ (lx1 x1)
+ (ly1 y1)
+ ;; Right end point is the same as the
+ ;; original end point.
+ (rx2 x2)
+ (ry2 y2)
+ ;; Left control point 1 is the midpoint of
+ ;; the line formed by the start point and
+ ;; the control point 1.
+ (lcx1 (/ (+ x1 cx1) 2.0))
+ (lcy1 (/ (+ y1 cy1) 2.0))
+ ;; Right control point 2 is the midpoint of
+ ;; the line formed by control point 2 and
+ ;; the end point.
+ (rcx2 (/ (+ cx2 x2) 2.0))
+ (rcy2 (/ (+ cy2 y2) 2.0))
+ ;; m is the midpoint of the line formed by
+ ;; control points 1 and 2.
+ (mx (/ (+ cx1 cx2) 2.0))
+ (my (/ (+ cy1 cy2) 2.0))
+ ;; Left control point 2 is the midpoint of
+ ;; the line formed by m and left control
+ ;; point 1.
+ (lcx2 (/ (+ lcx1 mx) 2.0))
+ (lcy2 (/ (+ lcy1 my) 2.0))
+ ;; Right control point 1 is the midpoint of
+ ;; the line formed by m and right control
+ ;; point 2.
+ (rcx1 (/ (+ mx rcx2) 2.0))
+ (rcy1 (/ (+ my rcy2) 2.0))
+ ;; The left end point and the right start
+ ;; point are the same. This point is the
+ ;; midpoint of the line formed by left
+ ;; control point 2 and right control point
+ ;; 1.
+ (lx2 (/ (+ lcx2 rcx1) 2.0))
+ (ly2 (/ (+ lcy2 rcy1) 2.0))
+ (rx1 lx2)
+ (ry1 ly2))
+ ;; Recursively subdivide the left side first,
+ ;; then the right.
+ (flatten lx1 ly1 lcx1 lcy1 lcx2 lcy2 lx2 ly2)
+ (flatten rx1 ry1 rcx1 rcy1 rcx2 rcy2 rx2 ry2)))))
+ (loop commands (+ i 1) offset point (or first brush))))
+ ;; Draw a line back to the first point.
+ (('close)
+ (if first
+ ;; Add a point that is the same as the first point in the
+ ;; path, then start a new path.
+ (begin
+ (unless (vec2= brush first)
+ (add-point (vec2-x first) (vec2-y first)))
+ (add-path offset)
+ (loop commands (+ i 1) (compiled-path-point-count compiled-path) brush #f))
+ ;; Closing a loop with no points is a noop.
+ (loop commands (+ i 1) offset brush #f)))
+ ;; Unknown command.
+ (((? symbol? name) . _)
+ (error "unrecognized path command" name))
+ ;; Straight up garbage.
+ (invalid-command
+ (error "invalid path command" invalid-command))))
+ ;; All commands processed. All that's left to do is check if
+ ;; an unclosed path has been left hanging and add it.
+ ((= offset (compiled-path-point-count compiled-path))
+ ;; The last path was closed, so there's nothing left to do.
+ #t)
+ (else
+ ;; The last path isn't closed, so we just need to register the
+ ;; open path.
+ (add-path offset)))))
+
+
+;;;
+;;; Stroked path
+;;;
+
+;; TODO: Allow for multiple path styles to be rendered in a single
+;; draw call. This will probably involve abusing textures to store
+;; the per-path style info. We can cross that bridge if we ever need
+;; the extra performance.
+(define-record-type <stroked-path>
+ (%make-stroked-path vertex-count index-count
+ vertex-capacity index-capacity
+ vertex-buffer index-buffer vertex-array)
+ stroked-path?
+ (blend-mode stroked-path-blend-mode set-stroked-path-blend-mode!)
+ (color stroked-path-color set-stroked-path-color!)
+ (width stroked-path-width set-stroked-path-width!)
+ (feather stroked-path-feather set-stroked-path-feather!)
+ (cap stroked-path-cap set-stroked-path-cap!)
+ (vertex-count stroked-path-vertex-count set-stroked-path-vertex-count!)
+ (index-count stroked-path-index-count set-stroked-path-index-count!)
+ (vertex-capacity stroked-path-vertex-capacity set-stroked-path-vertex-capacity!)
+ (index-capacity stroked-path-index-capacity set-stroked-path-index-capacity!)
+ (vertex-buffer stroked-path-vertex-buffer)
+ (index-buffer stroked-path-index-buffer)
+ (vertex-array stroked-path-vertex-array))
+
+(define (resize-stroked-path-vertex-buffer! stroked-path capacity)
+ (resize-buffer! (stroked-path-vertex-buffer stroked-path)
+ (* capacity (* 5 4))) ; 5 floats per vertex
+ (set-stroked-path-vertex-capacity! stroked-path capacity))
+
+(define (resize-stroked-path-index-buffer! stroked-path capacity)
+ (resize-buffer! (stroked-path-index-buffer stroked-path)
+ (* capacity 4)) ; 4 bytes per index
+ (set-stroked-path-index-capacity! stroked-path capacity))
+
+(define (make-stroked-path)
+ (let* ((vertex-buffer (make-buffer #f
+ #:name "stroke vertex buffer"
+ ;; Vertex layout:
+ ;; - x, y
+ ;; - u, v
+ ;; - length of current path
+ #:stride (* 5 4) ; 5 f32s
+ #:usage 'stream))
+ (index-buffer (make-buffer #f
+ #:name "stroke index buffer"
+ #:target 'index
+ #:usage 'stream))
+ (verts (make-buffer-view #:name "stroke vertices"
+ #:buffer vertex-buffer
+ #:type 'vec2
+ #:component-type 'float))
+ (tex (make-buffer-view #:name "stroke texcoords"
+ #:buffer vertex-buffer
+ #:type 'vec2
+ #:component-type 'float
+ #:offset 8))
+ (lengths (make-buffer-view #:name "stroke lengths"
+ #:buffer vertex-buffer
+ #:type 'scalar
+ #:component-type 'float
+ #:offset 16))
+ (index (make-buffer-view #:name "stroke index"
+ #:buffer index-buffer
+ #:type 'scalar
+ #:component-type 'unsigned-int))
+ (vertex-array (make-vertex-array #:indices index
+ #:attributes `((0 . ,verts)
+ (1 . ,tex)
+ (2 . ,lengths))))
+ (stroked-path (%make-stroked-path 0 0 0 0
+ vertex-buffer
+ index-buffer
+ vertex-array)))
+ (resize-stroked-path-vertex-buffer! stroked-path 128)
+ (resize-stroked-path-index-buffer! stroked-path 128)
+ stroked-path))
+
+;; Tesselation of stroked paths involves building rectangles composed
+;; of 2 triangles for each line segment in the path. This
+;; implementation is based upon the paper "Shader-Based, Antialiased,
+;; Dashed, Stroked Polylines" by Nicolas P. Rougier.
+;;
+;; See: https://pdfs.semanticscholar.org/5ec2/8762c868b410b8388181d63a17469c38b26c.pdf
+(define* (stroke-path stroked-path compiled-path #:key blend-mode color width feather cap)
+ ;; Setup stroke style.
+ (set-stroked-path-blend-mode! stroked-path blend-mode)
+ (set-stroked-path-color! stroked-path color)
+ (set-stroked-path-width! stroked-path width)
+ (set-stroked-path-feather! stroked-path feather)
+ (set-stroked-path-cap! stroked-path cap)
+ ;; Initialize counts.
+ (set-stroked-path-vertex-count! stroked-path 0)
+ (set-stroked-path-index-count! stroked-path 0)
+ ;; Tesselate.
+ (with-mapped-buffer (stroked-path-vertex-buffer stroked-path)
+ (with-mapped-buffer (stroked-path-index-buffer stroked-path)
+ (let ((points (compiled-path-points compiled-path))
+ (offsets (compiled-path-offsets compiled-path))
+ (counts (compiled-path-counts compiled-path))
+ (path-count (compiled-path-count compiled-path))
+ (padding (/ (ceiling (+ width (* feather 2.5))) 2.0)))
+ (define (add-points first? lx ly rx ry distance)
+ ;; Resize buffers, if necessary.
+ (let ((vert-count (stroked-path-vertex-count stroked-path))
+ (vert-capacity (stroked-path-vertex-capacity stroked-path))
+ (index-count (stroked-path-index-count stroked-path))
+ (index-capacity (stroked-path-index-capacity stroked-path)))
+ (when (> (+ vert-count 2) vert-capacity)
+ (resize-stroked-path-vertex-buffer! stroked-path
+ (* vert-capacity 2))
+ (map-buffer! (stroked-path-vertex-buffer stroked-path)))
+ (when (> (+ index-count 6) index-capacity)
+ (resize-stroked-path-index-buffer! stroked-path
+ (* index-capacity 2))
+ (map-buffer! (stroked-path-index-buffer stroked-path)))
+ (let ((verts (buffer-data
+ (stroked-path-vertex-buffer stroked-path)))
+ (voffset (* vert-count 5))) ; 5 floats per vertex
+ ;; Left:
+ ;; Position
+ (f32vector-set! verts voffset lx)
+ (f32vector-set! verts (+ voffset 1) ly)
+ ;; Distance from starting point
+ (f32vector-set! verts (+ voffset 2) distance)
+ ;; Distance from true line segment (used for antialising)
+ (f32vector-set! verts (+ voffset 3) padding)
+ ;; Right:
+ ;; Position
+ (f32vector-set! verts (+ voffset 5) rx)
+ (f32vector-set! verts (+ voffset 6) ry)
+ ;; Distance from starting point
+ (f32vector-set! verts (+ voffset 7) distance)
+ ;; Distance from true line segment
+ (f32vector-set! verts (+ voffset 8) (- padding)))
+ (set-stroked-path-vertex-count! stroked-path (+ vert-count 2))
+ ;; On the first iteration we only have 2 points which is
+ ;; not enough to create line segment geometry which
+ ;; requires looking at the newest 2 points + the 2
+ ;; previous points.
+ (unless first?
+ (let ((index (buffer-data
+ (stroked-path-index-buffer stroked-path))))
+ (u32vector-set! index index-count (- vert-count 1))
+ (u32vector-set! index (+ index-count 1) (- vert-count 2))
+ (u32vector-set! index (+ index-count 2) vert-count)
+ (u32vector-set! index (+ index-count 3) (- vert-count 1))
+ (u32vector-set! index (+ index-count 4) vert-count)
+ (u32vector-set! index (+ index-count 5) (+ vert-count 1))
+ (set-stroked-path-index-count! stroked-path (+ index-count 6))))))
+ (define (set-length i length)
+ (let ((verts (buffer-data (stroked-path-vertex-buffer stroked-path)))
+ (voffset (* i 5 2)))
+ (f32vector-set! verts (+ voffset 4) length)
+ (f32vector-set! verts (+ voffset 9) length)))
+ (let path-loop ((i 0))
+ (when (< i path-count)
+ (let* ((count (u32vector-ref counts i))
+ (first (u32vector-ref offsets i))
+ (last (+ first count -1))
+ (open? (or (not (= (f32vector-ref points (* first 2))
+ (f32vector-ref points (* last 2))))
+ (not (= (f32vector-ref points (+ (* first 2) 1))
+ (f32vector-ref points (+ (* last 2) 1))))))
+ (last* (- last 1)))
+ (let point-loop ((j first)
+ ;; How far along the line segment we are.
+ (distance 0.0))
+ (when (<= j last)
+ (let ((x (f32vector-ref points (* j 2)))
+ (y (f32vector-ref points (+ (* j 2) 1))))
+ (cond
+ ;; Beginning cap.
+ ((and open? (= j first))
+ (let* ((next-offset (* (+ j 1) 2))
+ (next-x (f32vector-ref points next-offset))
+ (next-y (f32vector-ref points (+ next-offset 1)))
+ (dx (- x next-x))
+ (dy (- y next-y))
+ (mag (sqrt (+ (* dx dx) (* dy dy))))
+ (norm-x (/ dx mag))
+ (norm-y (/ dy mag))
+ (pad-x (* norm-x padding))
+ (pad-y (* norm-y padding))
+ (lx (+ x pad-x pad-y))
+ (ly (- (+ y pad-y) pad-x))
+ (rx (- (+ x pad-x) pad-y))
+ (ry (+ y pad-y pad-x)))
+ (add-points #t lx ly rx ry (- padding))
+ (point-loop (+ j 1) mag)))
+ ;; End cap.
+ ((and open? (= j last))
+ (let* ((prev-offset (* (- j 1) 2))
+ (prev-x (f32vector-ref points prev-offset))
+ (prev-y (f32vector-ref points (+ prev-offset 1)))
+ (dx (- x prev-x))
+ (dy (- y prev-y))
+ (mag (sqrt (+ (* dx dx) (* dy dy))))
+ (norm-x (/ dx mag))
+ (norm-y (/ dy mag))
+ (pad-x (* norm-x padding))
+ (pad-y (* norm-y padding))
+ (lx (- (+ x pad-x) pad-y))
+ (ly (+ y pad-y pad-x))
+ (rx (+ x pad-x pad-y))
+ (ry (- (+ y pad-y) pad-x)))
+ (add-points #f lx ly rx ry (+ distance padding))))
+ ;; Point is somewhere in the middle of the path
+ ;; (or the first/last point within a closed loop)
+ ;; and needs to be mitered.
+ ;;
+ ;; The vector math used to make a miter joint for
+ ;; a polyline is based on this informative forum
+ ;; thread:
+ ;;
+ ;; https://forum.libcinder.org/topic/smooth-thick-lines-using-geometry-shader
+ (else
+ ;; For the prev/next offsets, we need to account
+ ;; for closed loops. When j = last, we need the
+ ;; next index to be 1. Likewise, when j =
+ ;; first, we need the previous index to be
+ ;; offset + count - 1, in other words: the
+ ;; second to last point. This is because the
+ ;; first and last points of a closed loop are
+ ;; the same, so in order to know how to miter
+ ;; the first and last line segments we need to
+ ;; know about the second and second to last
+ ;; points in the compiled path buffer. The
+ ;; modulo operator is our best friend when it
+ ;; comes to wrapping values to a range.
+ (let* ((prev-offset (* (+ (modulo (- j first 1)
+ (- count 1))
+ first)
+ 2))
+ (prev-x (f32vector-ref points prev-offset))
+ (prev-y (f32vector-ref points (+ prev-offset 1)))
+ (next-offset (* (+ (modulo (- j first)
+ (- count 1))
+ first 1)
+ 2))
+ (next-x (f32vector-ref points next-offset))
+ (next-y (f32vector-ref points (+ next-offset 1)))
+ ;; Vector from (x, y) to (next-x next-y).
+ (ndx (- next-x x))
+ (ndy (- next-y y))
+ ;; Normalized form.
+ (nmag (sqrt (+ (* ndx ndx) (* ndy ndy))))
+ (nx (if (zero? nmag) 0.0 (/ ndx nmag)))
+ (ny (if (zero? nmag) 0.0 (/ ndy nmag)))
+ ;; Vector from (prev-x, prev-y) to (x, y).
+ (pdx (- x prev-x))
+ (pdy (- y prev-y))
+ ;; Normalized form.
+ (pmag (sqrt (+ (* pdx pdx) (* pdy pdy))))
+ (px (if (zero? pmag) 0.0 (/ pdx pmag)))
+ (py (if (zero? pmag) 0.0 (/ pdy pmag)))
+ ;; Tangent of the 2 vectors.
+ (tanx (+ nx px))
+ (tany (+ ny py))
+ ;; Normalized form.
+ (tanmag (sqrt (+ (* tanx tanx) (* tany tany))))
+ (ntanx (if (zero? tanmag) 0.0 (/ tanx tanmag)))
+ (ntany (if (zero? tanmag) 0.0 (/ tany tanmag)))
+ ;; In order to join 2 line segments
+ ;; together neatly, they must have
+ ;; mitered corners. The miter direction
+ ;; is perpendicular to the tangent of the
+ ;; 2 line segments.
+ (miterx (- ntany))
+ (mitery ntanx)
+ ;; In order to compute the proper length
+ ;; of the miter line, we need to project
+ ;; the miter vector (which is in
+ ;; normalized form) onto the normalized
+ ;; form of a vector for one of the line
+ ;; segments. It doesn't matter which
+ ;; vector is used, so I chose the vector
+ ;; from the current point to the
+ ;; previous.
+ (miter-dot (+ (* miterx (- py)) (* mitery px)))
+ (miter-length (abs (/ padding miter-dot)))
+ ;; The vector that will thicken the line.
+ (padx (* miterx miter-length))
+ (pady (* mitery miter-length))
+ ;; Figure out the extra distance +/- that
+ ;; the mitering has caused so the
+ ;; vertices distance attribute can be
+ ;; adjusted accordingly.
+ (padmag (sqrt (+ (* padx padx) (* pady pady))))
+ ;; (npadx (if (zero? padmag) 0.0 (/ padx padmag)))
+ ;; (npady (if (zero? padmag) 0.0 (/ pady padmag)))
+ (miter-distance (sqrt (- (* padmag padmag) (* padding padding))))
+ ;; Left side
+ (lx (+ x padx))
+ (ly (+ y pady))
+ ;; Right side
+ (rx (- x padx))
+ (ry (- y pady)))
+ (add-points (= j first) lx ly rx ry distance)
+ (point-loop (+ j 1) (+ distance nmag)))))))
+ (when (= j last)
+ ;; Go over the points one more time to set the total
+ ;; length in each vertex.
+ (let length-loop ((k first))
+ (when (<= k last)
+ (set-length k distance)
+ (length-loop (+ k 1)))))))
+ (path-loop (+ i 1))))))))
+
+
+;;;
+;;; Filled path
+;;;
+
+(define-record-type <filled-path>
+ (%make-filled-path count stencil-vertex-count stencil-vertex-capacity
+ stencil-vertex-buffer stencil-vertex-array
+ quad-vertex-buffer quad-vertex-array)
+ filled-path?
+ (blend-mode filled-path-blend-mode set-filled-path-blend-mode!)
+ (color filled-path-color set-filled-path-color!)
+ (counts filled-path-counts set-filled-path-counts!)
+ (offsets filled-path-offsets set-filled-path-offsets!)
+ (count filled-path-count set-filled-path-count!)
+ (stencil-vertex-count filled-path-stencil-vertex-count
+ set-filled-path-stencil-vertex-count!)
+ (stencil-vertex-capacity filled-path-stencil-vertex-capacity
+ set-filled-path-stencil-vertex-capacity!)
+ (stencil-vertex-buffer filled-path-stencil-vertex-buffer)
+ (stencil-vertex-array filled-path-stencil-vertex-array)
+ (quad-vertex-buffer filled-path-quad-vertex-buffer)
+ (quad-vertex-array filled-path-quad-vertex-array))
+
+(define (resize-filled-path-stencil-vertex-buffer! filled-path capacity)
+ (resize-buffer! (filled-path-stencil-vertex-buffer filled-path)
+ (* capacity 8)) ; 2 f32s per vertex: x y
+ (set-filled-path-stencil-vertex-capacity! filled-path capacity))
+
+(define (make-filled-path)
+ (let* ((quad-vertex-buffer (make-buffer #f
+ #:length (* 8 4) ; 8 f32s
+ #:name "fill quad vertices"
+ #:usage 'stream))
+ (quad-verts (make-buffer-view #:name "fill quad vertices"
+ #:buffer quad-vertex-buffer
+ #:type 'vec2
+ #:component-type 'float))
+ (quad-index (make-buffer-view #:name "fill quad index"
+ #:type 'scalar
+ #:component-type 'unsigned-int
+ #:buffer (make-buffer (u32vector 0 2 3 0 1 2)
+ #:name "fill quad index"
+ #:target 'index)))
+ (quad-vertex-array (make-vertex-array #:indices quad-index
+ #:attributes `((0 . ,quad-verts))))
+ (stencil-vertex-buffer (make-buffer #f
+ #:name "fill stencil vertices"
+ #:usage 'stream))
+ (stencil-verts (make-buffer-view #:name "fill stencil vertices"
+ #:buffer stencil-vertex-buffer
+ #:type 'vec2
+ #:component-type 'float))
+ (stencil-vertex-array (make-vertex-array #:attributes `((0 . ,stencil-verts))
+ #:mode 'triangle-fan))
+ (filled-path (%make-filled-path 0 0 0
+ stencil-vertex-buffer
+ stencil-vertex-array
+ quad-vertex-buffer
+ quad-vertex-array)))
+ (resize-filled-path-stencil-vertex-buffer! filled-path 128)
+ filled-path))
+
+(define* (fill-path filled-path compiled-path #:key blend-mode color)
+ (let* ((points (compiled-path-points compiled-path))
+ (offsets (compiled-path-offsets compiled-path))
+ (counts (compiled-path-counts compiled-path))
+ (path-count (compiled-path-count compiled-path))
+ (bbox (compiled-path-bounding-box compiled-path))
+ ;; Every triangle fan that we create will contain this
+ ;; reference point as the initial point. Mathematically
+ ;; speaking, any point can be chosen and the fill algorithm
+ ;; will still behave correctly. Choosing a point within the
+ ;; path's bounding box should lead to less fragments on the
+ ;; GPU, though, and the center of the bounding box seems like
+ ;; a sensible location.
+ (ref-x (rect-center-x bbox))
+ (ref-y (rect-center-y bbox)))
+ ;; Setup style.
+ (set-filled-path-color! filled-path color)
+ ;; Setup counts and offsets.
+ (set-filled-path-count! filled-path 0)
+ (set-filled-path-stencil-vertex-count! filled-path 0)
+ (set-filled-path-count! filled-path path-count)
+ (let ((bv (make-u32vector path-count)))
+ (let loop ((i 0))
+ (when (< i path-count)
+ (u32vector-set! bv i (+ (u32vector-ref counts i) 1))
+ (loop (+ i 1))))
+ (set-filled-path-counts! filled-path bv))
+ (let ((bv (make-u32vector path-count)))
+ (let loop ((i 0))
+ (when (< i path-count)
+ (u32vector-set! bv i (+ (u32vector-ref offsets i) i))
+ (loop (+ i 1))))
+ (set-filled-path-offsets! filled-path bv))
+ ;; Create geometry for the stencil buffer.
+ (with-mapped-buffer (filled-path-stencil-vertex-buffer filled-path)
+ (let loop ((i 0))
+ (when (< i path-count)
+ (let* ((count (u32vector-ref counts i))
+ (first (u32vector-ref offsets i))
+ (last (+ first count -1))
+ (n (filled-path-stencil-vertex-count filled-path)))
+ ;; Resize buffer, if necessary.
+ (let ((capacity (filled-path-stencil-vertex-capacity filled-path)))
+ (when (>= (+ n count 1) capacity)
+ (let ((new-capacity (let cloop ((c (* capacity 2)))
+ (if (> c (+ n count 1))
+ c
+ (cloop (* c 2))))))
+ (resize-filled-path-stencil-vertex-buffer! filled-path
+ new-capacity)
+ (map-buffer! (filled-path-stencil-vertex-buffer filled-path)))))
+ (let ((verts (buffer-data (filled-path-stencil-vertex-buffer filled-path)))
+ (offset (* n 2)))
+ ;; Build the triangle fan for the path. This geometry
+ ;; will be used for a GPU-based implementation of the
+ ;; non-zero rule:
+ ;;
+ ;; See: https://en.wikipedia.org/wiki/Nonzero-rule
+ ;;
+ ;; Add reference point as the basis for each triangle in
+ ;; the fan.
+ (f32vector-set! verts offset ref-x)
+ (f32vector-set! verts (+ offset 1) ref-y)
+ ;; Now simply copy all the points in the path into the
+ ;; buffer. Each point is stored as 2 f32s, so 8 bytes per
+ ;; point.
+ (bytevector-copy! points (* first 8) verts (* (+ n 1) 8) (* count 8))
+ (set-filled-path-stencil-vertex-count! filled-path (+ n count 1))))
+ (loop (+ i 1)))))
+ ;; Create simple quad covering the bounding box to be used for the
+ ;; final render pass with stencil applied.
+ ;;
+ ;; TODO: A convex hull would result in less fragments to process.
+ (with-mapped-buffer (filled-path-quad-vertex-buffer filled-path)
+ (let ((verts (buffer-data (filled-path-quad-vertex-buffer filled-path)))
+ (x1 (rect-x bbox))
+ (y1 (rect-y bbox))
+ (x2 (rect-right bbox))
+ (y2 (rect-top bbox)))
+ (f32vector-set! verts 0 x1)
+ (f32vector-set! verts 1 y1)
+ (f32vector-set! verts 2 x2)
+ (f32vector-set! verts 3 y1)
+ (f32vector-set! verts 4 x2)
+ (f32vector-set! verts 5 y2)
+ (f32vector-set! verts 6 x1)
+ (f32vector-set! verts 7 y2)))))
+
+
+;;;
+;;; Rendering
+;;;
+
+(define path-shader
+ (delay
+ (load-shader (scope-datadir "shaders/path-vert.glsl")
+ (scope-datadir "shaders/path-frag.glsl"))))
+
+(define stencil-flip
+ (make-stencil-test #:on-pass 'invert))
+
+(define stencil-cover-and-clear
+ (make-stencil-test #:on-fail 'zero #:on-depth-fail 'zero #:on-pass 'zero
+ #:function 'not-equal))
+
+(define *debug?* #f)
+
+;; TODO: gradients
+(define* (draw-filled-path filled-path)
+ (let ((counts (filled-path-counts filled-path))
+ (offsets (filled-path-offsets filled-path))
+ (n (filled-path-count filled-path)))
+ ;; Wireframe debug mode.
+ (when *debug?*
+ (begin
+ (gl-polygon-mode (cull-face-mode front) (polygon-mode line))
+ (let loop ((i 0))
+ (when (< i n)
+ (gpu-apply* (force path-shader)
+ (filled-path-stencil-vertex-array filled-path)
+ (u32vector-ref offsets i)
+ (u32vector-ref counts i)
+ #:mvp (current-projection)
+ #:mode 0)
+ (loop (+ i 1))))
+ (gl-polygon-mode (cull-face-mode front) (polygon-mode fill))))
+ ;; Anti-alias the edges of the fill.
+ (with-multisample #t
+ ;; Render fan to stencil buffer. Each time a triangle is
+ ;; rasterized, it flips the values in the stencil buffer for
+ ;; those fragments. So, the first time a triangle is rendered,
+ ;; it sets the stencil bits for all fragments to 1. Then, when
+ ;; an overlapping triangle is rendered, it sets all the stencil
+ ;; bits for the overlapped fragments back to 0. This neat hack
+ ;; implements the non-zero rule for determining whether or not a
+ ;; point is inside a closed path.
+ ;;
+ ;; For more information, see:
+ ;; http://developer.download.nvidia.com/devzone/devcenter/gamegraphics/files/opengl/gpupathrender.pdf
+ (with-color-mask null-color-mask
+ (with-stencil-test stencil-flip
+ (let loop ((i 0))
+ (when (< i n)
+ (gpu-apply* (force path-shader)
+ (filled-path-stencil-vertex-array filled-path)
+ (u32vector-ref offsets i)
+ (u32vector-ref counts i)
+ #:mvp (current-projection)
+ #:mode 0)
+ (loop (+ i 1))))))
+ ;; Render a quad with the stencil applied. The quad is the size
+ ;; of the path's bounding box. The stencil test will make it so
+ ;; we only draw fragments that are part of the filled path.
+ (with-stencil-test stencil-cover-and-clear
+ (with-blend-mode (filled-path-blend-mode filled-path)
+ (gpu-apply (force path-shader)
+ (filled-path-quad-vertex-array filled-path)
+ #:mvp (current-projection)
+ #:mode 0
+ #:color (filled-path-color filled-path)))))))
+
+;; TODO: dashed stroke
+;; TODO: miter styles and miter limit
+(define* (draw-stroked-path stroked-path)
+ (with-blend-mode (stroked-path-blend-mode stroked-path)
+ (gpu-apply* (force path-shader)
+ (stroked-path-vertex-array stroked-path)
+ 0
+ (stroked-path-index-count stroked-path)
+ #:mvp (current-projection)
+ #:color (stroked-path-color stroked-path)
+ #:mode 1
+ #:feather (stroked-path-feather stroked-path)
+ #:stroke-cap (match (stroked-path-cap stroked-path)
+ (#f 0) ; no cap
+ ('butt 1)
+ ('square 2)
+ ('round 3)
+ ('triangle-out 4)
+ ('triangle-in 5)
+ (x (error "unsupported line cap style" x)))
+ #:stroke-width (stroked-path-width stroked-path))))
+
+
+;;;
+;;; High-level canvas API
+;;;
+
+(define-record-type <painter>
+ (make-painter commands bounding-box)
+ painter?
+ (commands painter-commands)
+ (bounding-box painter-bounding-box))
+
+(define (eval-painter result compiled-path filled-paths stroked-paths painter matrix)
+ ;; Another mini VM for a simple picture language.
+ (let loop ((commands (painter-commands painter))
+ (matrix matrix)
+ (blend-mode 'alpha)
+ (fill-color white)
+ (stroke-color black)
+ (stroke-width 1.0)
+ (stroke-feather 1.0)
+ (stroke-cap 'round))
+ (match commands
+ ((command . rest)
+ (match command
+ ;; Compile paths into a series of line segments.
+ (('compile paths)
+ (clear-compiled-path compiled-path)
+ (for-each (lambda (path)
+ (compile-path compiled-path path matrix))
+ paths)
+ (loop rest matrix blend-mode fill-color stroke-color stroke-width
+ stroke-feather stroke-cap))
+ ;; Tesselate filled path.
+ (('fill)
+ (let ((filled-path (if (array-list-empty? filled-paths)
+ (make-filled-path)
+ (array-list-pop! filled-paths))))
+ (fill-path filled-path compiled-path
+ #:blend-mode blend-mode
+ #:color fill-color)
+ (array-list-push! result filled-path)
+ (loop rest matrix blend-mode fill-color stroke-color stroke-width
+ stroke-feather stroke-cap)))
+ ;; Tesselate stroked path.
+ (('stroke)
+ ;; Apply the transformation matrix to the stroke width so if
+ ;; the picture is scaled up/down the stroke gets
+ ;; wider/narrower. There's surely a more accurate way to do
+ ;; this, but the result looks okay to me for now.
+ (let* ((a (matrix3-transform matrix (vec2 0.0 0.0)))
+ (b (matrix3-transform matrix (vec2 stroke-width 0.0)))
+ (stroke-width* (vec2-magnitude (vec2- b a)))
+ (stroked-path (if (array-list-empty? stroked-paths)
+ (make-stroked-path)
+ (array-list-pop! stroked-paths))))
+ (stroke-path stroked-path
+ compiled-path
+ #:blend-mode blend-mode
+ #:cap stroke-cap
+ #:color stroke-color
+ #:feather stroke-feather
+ #:width stroke-width*)
+ (array-list-push! result stroked-path)
+ (loop rest matrix blend-mode fill-color stroke-color stroke-width
+ stroke-feather stroke-cap)))
+ ;; Apply transformation matrix.
+ (('transform transform)
+ (loop rest (matrix3* matrix transform) blend-mode fill-color
+ stroke-color stroke-width stroke-feather stroke-cap))
+ ;; Set style properties.
+ ((or ('set-style 'blend-mode blend-mode)
+ ('set-style 'fill-color fill-color)
+ ('set-style 'stroke-color stroke-color)
+ ('set-style 'stroke-width stroke-width)
+ ('set-style 'stroke-feather stroke-feather)
+ ('set-style 'stroke-cap stroke-cap))
+ (loop rest matrix blend-mode fill-color stroke-color stroke-width
+ stroke-feather stroke-cap))
+ ;; Recursively tesselate another painter.
+ (('call subpainter)
+ (loop (painter-commands subpainter)
+ matrix blend-mode fill-color stroke-color stroke-width
+ stroke-feather stroke-cap)
+ (loop rest matrix blend-mode fill-color stroke-color
+ stroke-width stroke-feather stroke-cap))))
+ (() #t))))
+
+(define (bounding-box-union rects)
+ (reduce rect-union (make-null-rect) rects))
+
+;; Primitive painters
+(define (stroke . paths)
+ (make-painter `((compile ,paths)
+ (stroke))
+ (bounding-box-union
+ (map path-bounding-box paths))))
+
+(define (fill . paths)
+ (make-painter `((compile ,paths)
+ (fill))
+ (bounding-box-union
+ (map path-bounding-box paths))))
+
+(define (fill-and-stroke . paths)
+ (make-painter `((compile ,paths)
+ (fill)
+ (stroke))
+ (bounding-box-union
+ (map path-bounding-box paths))))
+
+;; Painter combinators
+(define-syntax-rule (with-style ((key value) ...) painter)
+ (let ((p painter)) ; avoid evaling painter twice
+ (make-painter `((set-style key ,value) ...
+ (call ,p))
+ (painter-bounding-box p))))
+
+(define (transform matrix painter)
+ (make-painter `((transform ,matrix)
+ (call ,painter))
+ (transform-bounding-box (painter-bounding-box painter)
+ matrix)))
+
+(define (translate v painter)
+ (transform (matrix3-translate v) painter))
+
+(define (rotate angle painter)
+ (transform (matrix3-rotate angle) painter))
+
+(define (scale x painter)
+ (transform (matrix3-scale x) painter))
+
+(define (pad pad-x pad-y painter)
+ (make-painter (painter-commands painter)
+ (rect-inflate (painter-bounding-box painter) pad-x pad-y)))
+
+(define (superimpose . painters)
+ (make-painter (map (lambda (painter)
+ `(call ,painter))
+ painters)
+ (bounding-box-union
+ (map painter-bounding-box painters))))
+
+(define (beside . painters)
+ (make-painter (let loop ((painters painters)
+ (x 0.0))
+ (match painters
+ (() '())
+ ((painter . rest)
+ (let* ((r (painter-bounding-box painter))
+ (rx (rect-x r))
+ (ry (rect-y r))
+ (rw (rect-width r)))
+ (cons `(call ,(translate (vec2 (- x rx) (- ry)) painter))
+ (loop rest (+ x rw)))))))
+ (let loop ((painters painters)
+ (width 0.0)
+ (height 0.0))
+ (match painters
+ (()
+ (make-rect 0.0 0.0 width height))
+ ((painter . rest)
+ (let ((r (painter-bounding-box painter)))
+ (loop rest (+ width (rect-width r)) (max height (rect-height r)))))))))
+
+(define (below . painters)
+ (make-painter (let loop ((painters painters)
+ (y 0.0))
+ (match painters
+ (() '())
+ ((painter . rest)
+ (let* ((r (painter-bounding-box painter))
+ (rx (rect-x r))
+ (ry (rect-y r))
+ (rh (rect-width r)))
+ (cons `(call ,(translate (vec2 (- rx) (- y ry)) painter))
+ (loop rest (+ y rh)))))))
+ (let loop ((painters painters)
+ (width 0.0)
+ (height 0.0))
+ (match painters
+ (()
+ (make-rect 0.0 0.0 width height))
+ ((painter . rest)
+ (let ((r (painter-bounding-box painter)))
+ (loop rest (max width (rect-width r)) (+ height (rect-height r)))))))))
+
+(define-record-type <canvas>
+ (%make-canvas matrix compiled-path filled-path-pool stroked-path-pool
+ tesselated-paths)
+ canvas?
+ (painter canvas-painter %set-canvas-painter!)
+ (matrix canvas-matrix %set-canvas-matrix!)
+ (compiled-path canvas-compiled-path)
+ (filled-path-pool canvas-filled-path-pool)
+ (stroked-path-pool canvas-stroked-path-pool)
+ (tesselated-paths canvas-tesselated-paths))
+
+(define (repaint-canvas canvas)
+ (let ((painter (canvas-painter canvas))
+ (fill-pool (canvas-filled-path-pool canvas))
+ (stroke-pool (canvas-stroked-path-pool canvas))
+ (tesselations (canvas-tesselated-paths canvas)))
+ ;; Return tesselations back to pools. Reusing existing GPU
+ ;; buffers for canvases that are constantly redrawn is a very good
+ ;; thing.
+ (array-list-for-each (lambda (i tesselation)
+ (if (filled-path? tesselation)
+ (array-list-push! fill-pool tesselation)
+ (array-list-push! stroke-pool tesselation)))
+ tesselations)
+ (array-list-clear! tesselations)
+ ;; Rebuild tesselations with new painter.
+ (when painter
+ (eval-painter tesselations
+ (canvas-compiled-path canvas)
+ fill-pool
+ stroke-pool
+ painter
+ (canvas-matrix canvas)))))
+
+(define (set-canvas-painter! canvas painter)
+ (%set-canvas-painter! canvas painter)
+ (repaint-canvas canvas))
+
+(define (set-canvas-matrix! canvas matrix)
+ (%set-canvas-matrix! canvas matrix)
+ (repaint-canvas canvas))
+
+(define* (make-empty-canvas #:key (matrix (make-identity-matrix3)))
+ (%make-canvas matrix
+ (make-compiled-path)
+ (make-array-list)
+ (make-array-list)
+ (make-array-list)))
+
+(define* (make-canvas painter #:key (matrix (make-identity-matrix3)))
+ (let ((canvas (make-empty-canvas #:matrix matrix)))
+ (set-canvas-painter! canvas painter)
+ canvas))
+
+(define (draw-canvas canvas)
+ (array-list-for-each (lambda (i tesselation)
+ (if (filled-path? tesselation)
+ (draw-filled-path tesselation)
+ (draw-stroked-path tesselation)))
+ (canvas-tesselated-paths canvas)))
diff --git a/data/shaders/path-frag.glsl b/data/shaders/path-frag.glsl
new file mode 100644
index 0000000..a38f1d0
--- /dev/null
+++ b/data/shaders/path-frag.glsl
@@ -0,0 +1,93 @@
+// -*- mode: c -*-
+
+#ifdef GLSL330
+out vec4 fragColor;
+#endif
+
+#ifdef GLSL120
+attribute vec2 fragTex;
+attribute float fragStrokeLength;
+#else
+in vec2 fragTex;
+in float fragStrokeLength;
+#endif
+
+uniform int mode;
+uniform vec4 color;
+uniform float feather;
+uniform int strokeClosed;
+uniform float strokeWidth;
+uniform int strokeCap;
+uniform int strokeMiterStyle;
+uniform float strokeMiterLimit;
+
+float infinity = 1.0 / 0.0;
+
+void main(void) {
+ if (color.a <= 0.0) {
+ discard;
+ }
+
+ // fill mode
+ if(mode == 0) {
+#ifdef GLSL330
+ fragColor = color;
+#else
+ gl_FragColor = color;
+#endif
+ } else if(mode == 1) { // stroke mode
+ float hw = strokeWidth / 2.0;
+ float u = fragTex.x;
+ float v = fragTex.y;
+ float dx;
+ float dy;
+ float d;
+
+ // Stroke caps.
+ if (u < 0 || u > fragStrokeLength) {
+ if (u < 0) {
+ dx = abs(u);
+ } else {
+ dx = u - fragStrokeLength;
+ }
+ dy = abs(v);
+
+ if (strokeCap == 0) { // none
+ d = infinity;
+ } else if (strokeCap == 1) { // butt
+ d = max(dx + hw - 2 * feather, dy);
+ } else if (strokeCap == 2) { // square
+ d = max(dx, dy);
+ } else if (strokeCap == 3) { // round
+ d = sqrt(dx * dx + dy * dy);
+ } else if (strokeCap == 4) { // triangle out
+ d = dx + dy;
+ } else if (strokeCap == 5) { // triangle in
+ d = max(dy, hw - feather + dx - dy);
+ }
+ // Stroke inner/join
+ } else {
+ d = abs(v);
+ }
+
+ if(d <= hw) {
+#ifdef GLSL330
+ fragColor = color;
+#else
+ gl_FragColor = color;
+#endif
+ } else {
+ vec4 c = vec4(color.rgb, color.a * (1.0 - ((d - hw) / feather)));
+
+ if (c.a <= 0.0) {
+ discard;
+ }
+
+#ifdef GLSL330
+ fragColor = c;
+#else
+ gl_FragColor = c;
+#endif
+ }
+ }
+}
diff --git a/data/shaders/path-vert.glsl b/data/shaders/path-vert.glsl
new file mode 100644
index 0000000..38fa5d2
--- /dev/null
+++ b/data/shaders/path-vert.glsl
@@ -0,0 +1,44 @@
+// -*- mode: c -*-
+
+#ifdef GLSL330
+layout (location = 0) in vec2 position;
+layout (location = 1) in vec2 tex;
+layout (location = 2) in float strokeLength;
+#elif defined(GLSL130)
+in vec2 position;
+in vec2 tex;
+in float strokeLength;
+#elif defined(GLSL120)
+attribute vec2 position;
+attribute vec2 tex;
+attribute float strokeLength;
+#endif
+
+#ifdef GLSL120
+varying vec2 fragTex;
+varying float fragStrokeLength;
+#else
+out vec2 fragTex;
+out float fragStrokeLength;
+#endif
+
+uniform mat4 mvp;
+uniform vec4 color;
+uniform int mode;
+uniform int strokeClosed;
+
+void main(void) {
+ // Short-circuit because the fragments will just be discarded anyway.
+ if (color.a <= 0.0) {
+ gl_Position = vec4(0.0, 0.0, 0.0, 1.0);
+ return;
+ }
+
+ // Stroke specific setup.
+ if (mode == 1) {
+ fragStrokeLength = strokeLength;
+ }
+
+ fragTex = tex;
+ gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
+}
diff --git a/doc/api.texi b/doc/api.texi
index a8bac69..e93263e 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1365,10 +1365,6 @@ Bezier curves become particularly interesting when they are chained
together to form a Bezier ``path'', where the end point of one curve
becomes the starting point of the next.
-Currently, the rendering of Bezier curves is rather crude and provided
-mostly for visualizing and debugging curves that would be unseen in
-the final game. See @xref{Lines and Shapes} for more information.
-
@deffn {Procedure} make-bezier-curve p0 p1 p2 p3
Return a new Bezier curve object whose starting point is @var{p0},
ending point is @var{p3}, and control points are @var{p1} and
@@ -1502,7 +1498,7 @@ blocks to implement additional rendering techniques.
* Textures:: 2D images.
* Sprites:: Draw 2D images.
* Tile Maps:: Draw 2D tile maps.
-* Lines and Shapes:: Draw line segments and polygons.
+* Vector Paths:: Draw filled and stroked paths.
* Fonts:: Drawing text.
* Particles:: Pretty little flying pieces!
* 3D Models:: Spinning teapots everywhere.
@@ -2214,61 +2210,218 @@ Return @code{#t} if @var{obj} is a polygon.
Return the list of points that form @var{polygon}.
@end deffn
-@node Lines and Shapes
-@subsection Lines and Shapes
-
-Sprites are fun, but sometimes simple, untextured lines and polygons
-are desired. That's where the @code{(chickadee graphics shapes)} module
-comes in!
-
-@deffn {Procedure} draw-line start end @
- [#:thickness 0.5] [#:feather 1.0] [#:cap round] [#:color] @
- [#:shader]
-
-Draw a line segment from @var{start} to @var{end}. The line will be
-@var{thickness} pixels thick with an antialiased border @var{feather}
-pixels wide. The line will be colored @var{color}. @var{cap}
-specifies the type of end cap that should be used to terminate the
-lines, either @code{none}, @code{butt}, @code{square}, @code{round},
-@code{triangle-in}, or @code{triangle-out}. Advanced users may use
-the @var{shader} argument to override the built-in line segment
-shader.
-@end deffn
-
-@deffn {Procedure} draw-bezier-curve bezier [#:segments 32] @
- [#:control-points?] [#:tangents?] @
- [#:control-point-size 8] @
- [#:control-point-color yellow] @
- [#:tangent-color yellow] @
- [#:thickness 0.5] [#:feather 1.0] @
- [#:matrix]
-
-Draw the curve defined by @var{bezier} using a resolution of N
-@var{segments}. When @var{control-points?} is @code{#t}, the control
-points are rendered as squares of size @var{control-point-size} pixels
-and a color of @var{control-point-color}. When @var{tangents?} is
-@code{#t}, the tangent lines from terminal point to control point are
-rendered using the color @var{tangent-color}.
-
-All line segments rendered use @code{draw-line}, and thus the
-arguments @var{thickness} and @var{feather} have the same effect as in
-that procedure.
-
-A custom @var{matrix} may be passed for applications that require more
-control over the final output.
-@end deffn
-
-@deffn {Procedure} draw-bezier-path path [#:segments 32] @
- [#:control-points?] [#:tangents?] @
- [#:control-point-size 8] @
- [#:control-point-color yellow] @
- [#:tangent-color yellow] @
- [#:thickness 0.5] [#:feather 1.0] @
- [#:matrix]
-
-Render @var{path}, a list of bezier curves. See the documentation for
-@code{draw-bezier-curve} for an explanation of all the keyword
-arguments.
+@node Vector Paths
+@subsection Vector Paths
+
+The @code{(chickadee graphics path)} module can be used to draw lines,
+curves, circles, rectangles, and more in a scalable, resolution
+independent manner. It is @emph{not} an SVG compliant renderer, nor
+does it intend to be. However, those familiar with SVG and/or the
+HTML5 Canvas API should find lots of similarities.
+
+@emph{This API is considered to be experimental and may change
+substantially in future releases of Chickadee. There are many missing
+features such as gradient fills and dashed strokes.}
+
+The first step to rendering vector graphics is to create a
+@emph{path}: A series of commands that can be thought of as moving a
+pen around a piece of paper. A path can be either open or closed. A
+closed path draws a straight line from the last point in the path to
+the first.
+
+@deffn {Procedure} path . commands
+Return a new path that follows @var{commands}.
+
+@example
+(path (move-to (vec2 50.0 50.0))
+ (line-to (vec2 500.0 50.0))
+ (line-to (vec2 400.0 200.0))
+ (bezier-to (vec2 500.0 250.0) (vec2 380.0 300.0) (vec2 400.0 400.0))
+ (line-to (vec2 300.0 400.0))
+ (close-path))
+@end example
+
+@end deffn
+
+Available drawing commands:
+
+@deffn {Procedure} move-to point
+Pick up the pen and move it to @var{point}.
+@end deffn
+
+@deffn {Procedure} line-to point
+Draw a line from the current pen position to @var{point}.
+@end deffn
+
+@deffn {Procedure} bezier-to control1 control2 point
+Draw a cubic bezier curve from the current pen position to
+@var{point}. The shape of the curve is determined by the two control
+points: @var{control1} and @var{control2}.
+@end deffn
+
+@deffn {Procedure} close-path
+Draw a straight line back to the first point drawn in the path.
+@end deffn
+
+@deffn {Procedure} arc center rx ry angle-start angle-end
+Draw an elliptical arc spanning the angle range [@var{angle-start},
+@var{angle-end}], centered at @var{center} with radii @var{rx} and
+@var{ry} (set both to the same value for a circular arc.)
+@end deffn
+
+Included are some helpful procedures for generating common types of
+paths:
+
+@deffn {Procedure} line start end
+Return a path that draws a straight line from @var{start} to @var{end}.
+@end deffn
+
+@deffn {Procedure} polyline . points
+Return a path that draws a series of lines connecting @var{points}.
+@end deffn
+
+@deffn {Procedure} rectangle bottom-left width height
+Return a path that draws a rectangle whose bottom-left corner is at
+@var{bottom-left} and whose size is defined by @var{width} and
+@var{height}.
+@end deffn
+
+@deffn {Procedure} square bottom-left size
+Return a path draws a square whose bottom-left corner is at
+@var{bottom-left} and whose size is defined by @var{size}.
+@end deffn
+
+@deffn {Procedure} rounded-rectangle bottom-left width height @
+ [#:radius 4.0] [#:radius-bottom-left] @
+ [#:radius-bottom-right] [#:radius-top-left] @
+ [#:radius-top-right]
+
+Return a path that draws a rectangle with rounded corners whose
+bottom-left corner is at @var{bottom-left} and whose size is defined
+by @var{width} and @var{height}. The argument @var{radius} is used to
+define the corner radius for all corners. To use a different radius
+value for a corner, use @var{radius-bottom-left},
+@var{radius-bottom-right}, @var{radius-top-left}, and/or
+@var{radius-top-right}.
+@end deffn
+
+@deffn {Procedure} regular-polygon center num-sides radius
+Return a path that draws a regular polygon with @var{num-sides} sides
+centered on the point @var{center} with each vertex @var{radius} units
+away from the center.
+@end deffn
+
+@deffn {Procedure} ellipse center rx ry
+Return a path that draws an ellipsed centered on the point
+@var{center} with radii @var{rx} and @var{ry}.
+@end deffn
+
+@deffn {Procedure} circle center r
+Return a path that draws a circle centered on the point @var{center}
+with radius @var{r}.
+@end deffn
+
+With one or more paths created, a @emph{painter} is needed to give the
+path its style and placement in the final picture. Painters can be
+combined together to form arbitrarily complex pictures.
+
+@deffn {Procedure} stroke . paths
+Apply a stroked drawing style to @var{paths}.
+@end deffn
+
+@deffn {Procedure} fill . paths
+Apply a filled drawing style to @var{paths}.
+@end deffn
+
+@deffn {Procedure} fill-and-stroke . paths
+Apply a filled and stroked drawing style to @var{paths}.
+@end deffn
+
+@deffn {Procedure} transform matrix painter
+Apply @var{matrix}, a 3x3 transformation matrix, to @var{painter}.
+@end deffn
+
+@deffn {Procedure} translate v painter
+Translate @var{painter} by the 2D vector @var{v}.
+@end deffn
+
+@deffn {Procedure} rotate angle painter
+Rotate @var{painter} by @var{angle} radians.
+@end deffn
+
+@deffn {Procedure} scale x painter
+Scale @var{painter} by the scalar @var{x}.
+@end deffn
+
+@deffn {Procedure} pad pad-x pad-y painter
+Add @var{pad-x} and @var{pad-y} amount of empty space around
+@var{painter}.
+@end deffn
+
+@deffn {Procedure} superimpose . painters
+Stack @var{painters} on top of each other.
+@end deffn
+
+@deffn {Procedure} beside . painters
+Place @var{painters} next to each other in a row.
+@end deffn
+
+@deffn {Procedure} below . painters
+Place @var{painters} next to each other in a column.
+@end deffn
+
+@deffn {Syntax} with-style ((style-name value) ...) painter
+Apply all the given style settings to @var{painter}.
+
+Possible style attributes are:
+
+@itemize
+@item blend-mode
+@item fill-color
+@item stroke-color
+@item stroke-width
+@item stroke-feather
+@item stroke-cap
+@end itemize
+
+@example
+(with-style ((stroke-color green)
+ (stroke-width 4.0))
+ (stroke (circle (vec2 100.0 100.0) 50.0)))
+@end example
+
+@end deffn
+
+As in real life, a painter cannot paint anything without a canvas.
+Once a painter has been associated with a canvas, it can finally be
+rendered to the screen.
+
+@deffn {Procedure} make-canvas painter [#:matrix]
+Return a new canvas that will @var{painter} will draw on. Optionally,
+a 3x3 @var{matrix} may be specified to apply an arbitrary
+transformation to the resulting image.
+@end deffn
+
+@deffn {Procedure} make-empty-canvas [#:matrix]
+Return a new canvas that no painter is using. Optionally, a 3x3
+@var{matrix} may be specified to apply an arbitrary transformation to
+the image, should a painter later be associated with this canvas.
+@end deffn
+
+@deffn {Procedure} canvas? obj
+Return @code{#t} is @var{obj} is a canvas.
+@end deffn
+
+@deffn {Procedure} set-canvas-painter! canvas painter
+Associate @var{painter} with @var{canvas}.
+@end deffn
+
+@deffn {Procedure} set-canvas-matrix! canvas matrix
+Set the 3x3 transformation matrix of @var{canvas} to @var{matrix}.
+@end deffn
+
+@deffn {Procedure} draw-canvas canvas
+Render @var{canvas} to the screen.
@end deffn
@node Fonts
diff --git a/examples/path.scm b/examples/path.scm
new file mode 100644
index 0000000..0223864
--- /dev/null
+++ b/examples/path.scm
@@ -0,0 +1,80 @@
+(use-modules (chickadee)
+ (chickadee graphics color)
+ (chickadee graphics font)
+ (chickadee graphics path)
+ (chickadee math)
+ (chickadee math vector)
+ (chickadee scripting))
+
+(set! *random-state* (random-state-from-platform))
+
+(define (stats-message)
+ (format #f "fps: ~1,2f"
+ (/ 1000.0 avg-frame-time)))
+(define start-time 0.0)
+(define avg-frame-time 16)
+(define stats-text (stats-message))
+(define stats-text-pos (vec2 4.0 464.0))
+(define last-update start-time)
+(define canvas (make-empty-canvas))
+(define rss-orange (string->color "#FF8800"))
+
+(define rss-feed-logo
+ (superimpose
+ (with-style ((fill-color rss-orange))
+ (fill
+ (rounded-rectangle (vec2 0.0 3.0) 95.0 95.0 #:radius 15.0)))
+ (with-style ((fill-color white))
+ (fill
+ (circle (vec2 18.0 18.0) 9.0)))
+ (with-style ((stroke-color white)
+ (stroke-cap 'round)
+ (stroke-width 15.0))
+ (stroke
+ (path
+ (arc (vec2 18.0 18.0) 30.0 30.0 0.0 pi/2))
+ (path
+ (arc (vec2 18.0 18.0) 60.0 60.0 0.0 pi/2))))))
+
+(define polylines
+ (with-style ((stroke-color tango-plum)
+ (stroke-width 6.0))
+ (stroke
+ (apply polyline (map (lambda (i)
+ (vec2 (* (+ i 1) 30) (+ (random 240) 100)))
+ (iota 20))))))
+
+(define (make-example-painter s)
+ (superimpose (translate (vec2 30.0 10.0)
+ (scale s rss-feed-logo))
+ polylines))
+
+(define (load)
+ (script
+ (forever
+ (tween 60 1.0 4.0
+ (lambda (s)
+ (set-canvas-painter! canvas (make-example-painter s))))
+ (tween 60 4.0 1.0
+ (lambda (s)
+ (set-canvas-painter! canvas (make-example-painter s)))))))
+
+(define (draw alpha)
+ (draw-canvas canvas)
+ (draw-text stats-text stats-text-pos)
+ (let ((current-time (elapsed-time)))
+ (set! avg-frame-time
+ (+ (* (- current-time start-time) 0.1)
+ (* avg-frame-time 0.9)))
+ (set! start-time current-time)
+ (when (>= (- current-time last-update) 1000)
+ (set! stats-text (stats-message))
+ (set! last-update current-time))))
+
+(define (update dt)
+ (update-agenda 1))
+
+(run-game #:window-title "Vector paths"
+ #:load load
+ #:draw draw
+ #:update update)