diff options
| -rw-r--r-- | Makefile.am | 7 | ||||
| -rw-r--r-- | chickadee/graphics/path.scm | 1554 | ||||
| -rw-r--r-- | data/shaders/path-frag.glsl | 93 | ||||
| -rw-r--r-- | data/shaders/path-vert.glsl | 44 | ||||
| -rw-r--r-- | doc/api.texi | 273 | ||||
| -rw-r--r-- | examples/path.scm | 80 |
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) |