diff options
Diffstat (limited to 'chickadee/graphics/path.scm')
| -rw-r--r-- | chickadee/graphics/path.scm | 826 |
1 files changed, 489 insertions, 337 deletions
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm index a6e27e9..435123a 100644 --- a/chickadee/graphics/path.scm +++ b/chickadee/graphics/path.scm @@ -22,16 +22,15 @@ (define-module (chickadee graphics path) #:use-module (chickadee config) #:use-module (chickadee data array-list) - #:use-module (chickadee graphics blend) + #:use-module (chickadee data bytestruct) + #:use-module (chickadee graphics) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics framebuffer) - #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics depth-stencil) #:use-module (chickadee graphics multisample) - #:use-module (chickadee graphics polygon) + #:use-module (chickadee graphics pipeline) + #:use-module (chickadee graphics primitive) #:use-module (chickadee graphics shader) - #:use-module (chickadee graphics stencil) #:use-module (chickadee graphics texture) #:use-module (chickadee image) #:use-module (chickadee math) @@ -41,6 +40,7 @@ #:use-module (chickadee math vector) #:use-module (chickadee utils) #:use-module (ice-9 match) + #:use-module (ice-9 textual-ports) #:use-module ((rnrs base) #:select (mod)) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) @@ -892,30 +892,50 @@ ;;; Stroked path ;;; -(define-geometry-type <stroke-vertex> - stroke-vertex-ref - stroke-vertex-set! - stroke-vertex-append! - (position vec2) - (texture vec2) - (length float)) +(define-bytestruct <stroke-vertex> + (struct (position <vec2>) + (texture <vec2>) + (length f32))) + +(define-bytestruct <stroke-index> + (struct (a s32) (b s32) (c s32) (d s32) (e s32) (f s32))) + +(define-bytestruct <stroke-uniforms> + (struct (mvp <matrix4>) + (color <color>) + (feather f32) + (stroke-width f32) + (stroke-miter-limit f32) + (stroke-closed? s32) + (stroke-cap s32) + (stroke-miter-style s32))) ;; 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 geometry) + (%make-stroked-path vertices indices vertex-bindings bindings) 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!) - (geometry stroked-path-geometry)) + (vertices stroked-path-vertices) + (indices stroked-path-indices) + (vertex-bindings stroked-path-vertex-bindings) + (bindings stroked-path-bindings)) (define (make-stroked-path) - (%make-stroked-path (make-geometry <stroke-vertex> 32))) + (%make-stroked-path (make-dbuffer #:name "Stroked path vertex buffer") + (make-dbuffer #:name "Stroked path index buffer" + #:usage '(index)) + (make-vector 1) + (vector + (make-buffer (bytestruct-sizeof <stroke-uniforms>) + #:name "Stroked path uniform buffer" + #:usage '(uniform))))) ;; Tesselation of stroked paths involves building rectangles composed ;; of 2 triangles for each line segment in the path. This @@ -936,218 +956,260 @@ (counts (compiled-path-counts compiled-path)) (path-count (compiled-path-count compiled-path)) (padding (/ (ceiling (+ width (* feather 2.5))) 2.0)) - (geometry (stroked-path-geometry stroked-path))) + (vertices (stroked-path-vertices stroked-path)) + (indices (stroked-path-indices stroked-path))) (define (add-points first? lx ly rx ry distance) - (let ((vert-count (geometry-vertex-count geometry <stroke-vertex>))) - ;; Each vertex has the following data: - ;; - x - ;; - y - ;; - distance from starting point - ;; - distance from true line segment (used for antialising) - ;; - ;; First vertex is the left hand side, second is the right. - (stroke-vertex-append! geometry - (lx ly distance padding 0.0) - (rx ry distance (- padding) 0.0)) - ;; 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? - (geometry-index-append! geometry - (- vert-count 1) - (- vert-count 2) - vert-count - (- vert-count 1) - vert-count - (+ vert-count 1))))) + ;; Each vertex has the following data: + ;; - x + ;; - y + ;; - distance from starting point + ;; - distance from true line segment (used for antialising) + ;; + ;; First vertex is the left hand side, second is the right. + (dbuffer-append! <stroke-vertex> + (((position x) lx) + ((position y) ly) + ((texture x) distance) + ((texture y) padding)) + vertices) + (dbuffer-append! <stroke-vertex> + (((position x) rx) + ((position y) ry) + ((texture x) distance) + ((texture y) (- padding))) + vertices) + ;; 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 ((vert-count (/ (dbuffer-length vertices) (bytestruct-sizeof <stroke-vertex>)))) + (dbuffer-append! <stroke-index> + (((a) (- vert-count 2)) + ((b) (- vert-count 4)) + ((c) (- vert-count 3)) + ((d) (- vert-count 1)) + ((e) (- vert-count 2)) + ((f) (- vert-count 3))) + indices)))) (define (set-length i length) - (stroke-vertex-set! geometry length (* i 2) length) - (stroke-vertex-set! geometry length (+ (* i 2) 1) length)) - (with-geometry geometry - (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))))))) + (dbuffer-pack! <stroke-vertex> + (((length) length)) + vertices + (* (bytestruct-sizeof <stroke-vertex>) (* i 2))) + (dbuffer-pack! <stroke-vertex> + (((length) length)) + vertices + (* (bytestruct-sizeof <stroke-vertex>) (1+ (* i 2))))) + (dbuffer-map! vertices) + (dbuffer-map! indices) + (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)))) + (dbuffer-unmap! indices) + (dbuffer-unmap! vertices))) ;;; ;;; Filled path ;;; -(define-geometry-type <fill-vertex> - fill-vertex-ref - fill-vertex-set! - fill-vertex-append! - (position vec2)) +(define-bytestruct <fill-vertex> + (struct (position <vec2>))) + +;; TODO: There's something broken with padding here. I want mode to +;; go *before* color but that seems to mess things up. +(define-bytestruct <fill-uniforms> + (struct (mvp <matrix4>) + (color <color>) + (mode s32) + (end-color <color>) + (gradient-matrix <matrix3>) + (gradient-range <vec2>) + (radial-gradient-ratio f32))) (define-record-type <filled-path> - (%make-filled-path count quad-geometry stencil-geometry) + (%make-filled-path count quad-vertices quad-indices + stencil-vertices stencil-indices + vertex-bindings bindings) 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-geometry filled-path-stencil-geometry) - (quad-geometry filled-path-quad-geometry)) + (quad-vertices filled-path-quad-vertices) + (quad-indices filled-path-quad-indices) + (stencil-vertices filled-path-stencil-vertices) + (stencil-indices filled-path-stencil-indices) + (vertex-bindings filled-path-vertex-bindings) + (bindings filled-path-bindings)) (define (make-filled-path) - (let* ((quad-geometry (make-geometry <fill-vertex> 4 - #:index-capacity 6)) - (stencil-geometry (make-geometry <fill-vertex> 32 - #:index? #f - #:mode 'triangle-fan))) - (%make-filled-path 0 quad-geometry stencil-geometry))) + (%make-filled-path 0 + (make-buffer (* (bytestruct-sizeof <fill-vertex>) 4) + #:name "Filled path quad vertex buffer") + (bytevector->buffer (u32vector 0 2 3 0 1 2) + #:name "Filled path quad index buffer" + #:usage '(index)) + (make-dbuffer #:name "Filled path stencil vertex buffer") + (make-dbuffer #:name "Filled path stencil index buffer" + #:usage '(index)) + (make-vector 1) + (vector + (make-buffer (bytestruct-sizeof <fill-uniforms>) + #:name "Filled path uniform buffer" + #:usage '(uniform))))) (define* (fill-path filled-path compiled-path #:key blend-mode color) (let* ((points (compiled-path-points compiled-path)) @@ -1164,8 +1226,9 @@ ;; a sensible location. (ref-x (rect-center-x bbox)) (ref-y (rect-center-y bbox)) - (quad-geometry (filled-path-quad-geometry filled-path)) - (stencil-geometry (filled-path-stencil-geometry filled-path))) + (quad-vertices (filled-path-quad-vertices filled-path)) + (stencil-vertices (filled-path-stencil-vertices filled-path)) + (stencil-indices (filled-path-stencil-indices filled-path))) ;; Setup style. (set-filled-path-color! filled-path color) (set-filled-path-blend-mode! filled-path blend-mode) @@ -1182,7 +1245,10 @@ (u32vector-set! bv i (+ (u32vector-ref offsets i) i))) (set-filled-path-offsets! filled-path bv)) ;; Create geometry for the stencil buffer. - (geometry-begin! stencil-geometry) + ;; + ;; TODO: Convert triangle fan to strip because WebGPU does not + ;; support triangle fans. + (dbuffer-map! stencil-vertices) (for-range ((i path-count)) (let* ((count (u32vector-ref counts i)) (first (u32vector-ref offsets i))) @@ -1194,142 +1260,228 @@ ;; ;; Add reference point as the basis for each triangle in ;; the fan. - (fill-vertex-append! stencil-geometry (ref-x ref-y)) + (dbuffer-append! <fill-vertex> + (((position x) ref-x) + ((position y) ref-y)) + stencil-vertices) ;; Now simply copy all the points in the path into the ;; buffer. (for-range ((j (+ first count) first)) - (fill-vertex-append! stencil-geometry - ((f32vector-ref points (* j 2)) - (f32vector-ref points (+ (* j 2) 1))))))) - (geometry-end! stencil-geometry) + (let ((j (* j 2))) + (dbuffer-append! <fill-vertex> + (((position x) (f32vector-ref points j)) + ((position y) (f32vector-ref points (1+ j)))) + stencil-vertices))))) + (dbuffer-unmap! stencil-vertices) ;; 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. - (geometry-begin! quad-geometry) + ;; TODO: Would computing a convex hull be worth it in order to + ;; process fewer fragments on the GPU? (let ((x1 (rect-x bbox)) (y1 (rect-y bbox)) (x2 (rect-right bbox)) - (y2 (rect-top bbox))) - (fill-vertex-append! quad-geometry (x1 y1) (x2 y1) (x2 y2) (x1 y2)) - (geometry-index-append! quad-geometry 0 2 3 0 1 2)) - (geometry-end! quad-geometry))) + (y2 (rect-top bbox)) + (size (bytestruct-sizeof <fill-vertex>)) + (bv (map-buffer quad-vertices 'write 0 (buffer-length quad-vertices)))) + (bytestruct-pack! <fill-vertex> + (((position x) x1) + ((position y) y1)) + bv 0) + (bytestruct-pack! <fill-vertex> + (((position x) x2) + ((position y) y1)) + bv size) + (bytestruct-pack! <fill-vertex> + (((position x) x2) + ((position y) y2)) + bv (* size 2)) + (bytestruct-pack! <fill-vertex> + (((position x) x1) + ((position y) y2)) + bv (* size 3)) + (unmap-buffer quad-vertices)))) ;;; ;;; Rendering ;;; +(define (load-file file-name) + (call-with-input-file file-name get-string-all)) + (define-graphics-variable stroke-shader - (load-shader (scope-datadir "shaders/path-stroke-vert.glsl") - (scope-datadir "shaders/path-stroke-frag.glsl"))) + (make-shader + (lambda (lang) + (values (load-file (scope-datadir "shaders/path-stroke-vert.glsl")) + (load-file (scope-datadir "shaders/path-stroke-frag.glsl")))))) (define-graphics-variable fill-shader - (load-shader (scope-datadir "shaders/path-fill-vert.glsl") - (scope-datadir "shaders/path-fill-frag.glsl"))) + (make-shader + (lambda (lang) + (values (load-file (scope-datadir "shaders/path-fill-vert.glsl")) + (load-file (scope-datadir "shaders/path-fill-frag.glsl")))))) (define-graphics-variable mvp-matrix (make-null-matrix4)) -(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) +(define-graphics-variable fill-stencil-pipeline + (make-render-pipeline + #:name "Filled path stencil pipeline" + #:shader (graphics-variable-ref fill-shader) + #:color-target (make-color-target #:mask (make-color-mask #f #f #f #f)) + #:primitive (make-primitive-mode #:topology 'triangle-fan + #:front-face 'cw) + #:depth+stencil (make-depth+stencil + #:stencil-face (make-stencil-face #:pass-op 'invert)) + #:vertex-layout (vector (make-vertex-buffer-layout + #:stride (bytestruct-sizeof <fill-vertex>) + #:attributes (vector + (make-vertex-attribute + #:format 'float32x2)))) + #:binding-layout (vector (make-buffer-layout)))) + +;; TODO: This needs to be part of the <filled-path> struct so we can +;; build a pipeline with the desired blend mode! +(define-graphics-variable fill-quad-pipeline + (make-render-pipeline + #:name "Filled path quad pipeline" + #:shader (graphics-variable-ref fill-shader) + ;; Anti-alias the edges of the fill with multisampling. + #:multisample (make-multisample #:count 4) + #:depth+stencil (make-depth+stencil + #:stencil-face (make-stencil-face #:compare 'not-equal + #:fail-op 'zero + #:depth-fail-op 'zero + #:pass-op 'zero)) + #:vertex-layout (vector (make-vertex-buffer-layout + #:stride (bytestruct-sizeof <fill-vertex>) + #:attributes (vector + (make-vertex-attribute + #:format 'float32x2)))) + #:binding-layout (vector (make-buffer-layout)))) (define* (draw-filled-path filled-path matrix) - (let ((shader (graphics-variable-ref fill-shader)) - (mvp (graphics-variable-ref mvp-matrix)) - (counts (filled-path-counts filled-path)) - (offsets (filled-path-offsets filled-path)) - (n (filled-path-count filled-path)) - (quad-geometry (filled-path-quad-geometry filled-path)) - (stencil-geometry (filled-path-stencil-geometry filled-path))) - (matrix4-mult! mvp matrix (current-projection)) - ;; Wireframe debug mode. - (when *debug?* - (with-graphics-state ((g:polygon-mode line-polygon-mode)) - (for-range ((i n)) - (shader-apply* shader - (geometry-vertex-array stencil-geometry) - (u32vector-ref offsets i) - (u32vector-ref counts i) - #:mvp (current-projection))))) - ;; Anti-alias the edges of the fill. - (with-graphics-state ((g: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-graphics-state ((g:color-mask null-color-mask) - (g:stencil-test stencil-flip)) - (for-range ((i n)) - (shader-apply* shader - (geometry-vertex-array stencil-geometry) - (u32vector-ref offsets i) - (u32vector-ref counts i) - #:mvp mvp))) - ;; 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-graphics-state ((g:stencil-test stencil-cover-and-clear) - (g:blend-mode (filled-path-blend-mode filled-path))) - (let ((color (filled-path-color filled-path))) - (if (gradient? color) - ;; Linear/radial gradient fill. - (shader-apply shader - (geometry-vertex-array quad-geometry) - #:mvp mvp - #:color (gradient-start-color color) - #:end-color (gradient-end-color color) - #:gradient-matrix (gradient-matrix color) - #:gradient-range (gradient-range color) - #:radial-gradient-ratio (gradient-radial-ratio color) - #:mode (case (gradient-type color) - ((linear) 1) - ((radial) 2))) - ;; Solid fill. - (shader-apply shader - (geometry-vertex-array quad-geometry) - #:mvp mvp - #:color (filled-path-color filled-path) - #:mode 0))))))) + (match filled-path + (($ <filled-path> blend-mode color counts offsets n + quad-vertices quad-indices + stencil-vertices stencil-indices vertex-bindings + (and bindings #(uniforms))) + (let ((stencil-pipeline (graphics-variable-ref fill-stencil-pipeline)) + (quad-pipeline (graphics-variable-ref fill-quad-pipeline)) + (mvp (graphics-variable-ref mvp-matrix))) + (matrix4-mult! mvp matrix (current-projection)) + (let ((bv (map-buffer uniforms 'write 0 + (bytestruct-sizeof <fill-uniforms>)))) + (bytestruct-pack! <fill-uniforms> + (((mvp) mvp)) + bv 0) + (match color + ;; Linear/radial gradient fill. + (($ <gradient> type matrix start-color end-color range radial-ratio) + (bytestruct-pack! <fill-uniforms> + (((mode) + (match type + ('linear 1) + ('radial 2))) + ((color) start-color) + ((end-color) end-color) + ((gradient-matrix) matrix) + ((gradient-range) range) + ((radial-gradient-ratio) radial-ratio)) + bv 0)) + ;; Solid fill. + (_ + (bytestruct-pack! <fill-uniforms> + (((mode) 0) + ((color) color)) + bv 0))) + (unmap-buffer uniforms)) + ;; 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 + (vector-set! vertex-bindings 0 (dbuffer-buffer stencil-vertices)) + (for-range ((i n)) + ;; TODO: Use a different shader for this pass because we + ;; don't care about color so using the fill shader is just + ;; wasted cycles. + (draw (u32vector-ref counts i) + #:start (u32vector-ref offsets i) + #:pipeline stencil-pipeline + #:vertex-buffers vertex-bindings + ;; #:index-buffer (dbuffer-buffer stencil-indices) + #:bindings bindings)) + ;; 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. + (vector-set! vertex-bindings 0 quad-vertices) + (draw 6 + #:pipeline quad-pipeline + #:vertex-buffers vertex-bindings + #:index-buffer quad-indices + #:bindings bindings))))) + +;; TODO: Make part of <stroked-path> to accomodate blend mode. +(define-graphics-variable stroke-pipeline + (make-render-pipeline + #:name "Stroked path pipeline" + #:shader (graphics-variable-ref stroke-shader) + #:color-target (make-color-target #:blend-mode blend:alpha) + #:vertex-layout (vector (make-vertex-buffer-layout + #:stride (bytestruct-sizeof <stroke-vertex>) + #:attributes (vector + (make-vertex-attribute + #:format 'float32x2) + (make-vertex-attribute + #:format 'float32x2 + #:offset (* 2 4)) + (make-vertex-attribute + #:format 'float32 + #:offset (* 4 4))))) + #:binding-layout (vector (make-buffer-layout)))) ;; TODO: dashed stroke ;; TODO: miter styles and miter limit (define* (draw-stroked-path stroked-path matrix) - (let ((shader (graphics-variable-ref stroke-shader)) - (mvp (graphics-variable-ref mvp-matrix))) - (matrix4-mult! mvp matrix (current-projection)) - (with-graphics-state ((g:blend-mode (stroked-path-blend-mode stroked-path))) - (let ((geometry (stroked-path-geometry stroked-path))) - (shader-apply* shader - (geometry-vertex-array geometry) - 0 - (geometry-index-count geometry) - #:mvp mvp - #:color (stroked-path-color stroked-path) - #:feather (stroked-path-feather stroked-path) - #:stroke-cap (case (stroked-path-cap stroked-path) - ((#f) 0) ; no cap - ((butt) 1) - ((square) 2) - ((round) 3) - ((triangle-out) 4) - ((triangle-in) 5) - (else - (error "unsupported line cap style" - (stroked-path-cap stroked-path)))) - #:stroke-width (stroked-path-width stroked-path)))))) + (match stroked-path + (($ <stroked-path> blend-mode color width feather cap vertices indices + vertex-bindings (and bindings #(uniforms))) + (let ((mvp (graphics-variable-ref mvp-matrix)) + (pipeline (graphics-variable-ref stroke-pipeline))) + (matrix4-mult! mvp matrix (current-projection)) + (let ((bv (map-buffer uniforms 'write 0 + (bytestruct-sizeof <stroke-uniforms>)))) + (bytestruct-pack! <stroke-uniforms> + (((mvp) mvp) + ((color) color) + ((feather) feather) + ((stroke-closed?) 0) + ((stroke-width) width) + ((stroke-cap) + (match cap + (#f 0) ; no cap + ('butt 1) + ('square 2) + ('round 3) + ('triangle-out 4) + ('triangle-in 5))) + ((stroke-miter-style) 0) + ((stroke-miter-limit) 0)) + bv 0) + (unmap-buffer uniforms)) + (vector-set! vertex-bindings 0 (dbuffer-buffer vertices)) + (draw (/ (dbuffer-length indices) 4) + #:pipeline pipeline + #:index-buffer (dbuffer-buffer indices) + #:vertex-buffers vertex-bindings + #:bindings bindings))))) ;;; @@ -1638,18 +1790,18 @@ (define (draw-canvas canvas) (draw-canvas* canvas %identity-matrix)) -(define (canvas->pixbuf canvas) - "Return a new pixbuf containing the rasterized CANVAS." - (let* ((bb (painter-bounding-box (canvas-painter canvas))) - (width (inexact->exact (ceiling (rect-width bb)))) - (height (inexact->exact (ceiling (rect-height bb)))) - (framebuffer (make-framebuffer width height))) - (with-framebuffer framebuffer - (draw-canvas* canvas (make-identity-matrix4))) - (texture->pixbuf (framebuffer-texture framebuffer)))) - -(define* (write-canvas canvas - #:optional (file-name (temp-image-file-name 'png)) - #:key (format 'png)) - "Write CANVAS to FILE-NAME using FORMAT ('png' by default.)" - (write-image (canvas->pixbuf canvas) file-name #:format format)) +;; (define (canvas->pixbuf canvas) +;; "Return a new pixbuf containing the rasterized CANVAS." +;; (let* ((bb (painter-bounding-box (canvas-painter canvas))) +;; (width (inexact->exact (ceiling (rect-width bb)))) +;; (height (inexact->exact (ceiling (rect-height bb)))) +;; (framebuffer (make-framebuffer width height))) +;; (with-framebuffer framebuffer +;; (draw-canvas* canvas (make-identity-matrix4))) +;; (texture->pixbuf (framebuffer-texture framebuffer)))) + +;; (define* (write-canvas canvas +;; #:optional (file-name (temp-image-file-name 'png)) +;; #:key (format 'png)) +;; "Write CANVAS to FILE-NAME using FORMAT ('png' by default.)" +;; (write-image (canvas->pixbuf canvas) file-name #:format format)) |