From 5fb3ce614b59f4bd8d7966d41aab750d317810aa Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 16 Feb 2023 09:01:39 -0500
Subject: Port path fill shader to Seagull.

---
 chickadee/graphics/path.scm | 53 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 51 insertions(+), 2 deletions(-)

diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
index 30d4c7c..f97ca4a 100644
--- a/chickadee/graphics/path.scm
+++ b/chickadee/graphics/path.scm
@@ -30,6 +30,7 @@
   #:use-module (chickadee graphics gl)
   #:use-module (chickadee graphics multisample)
   #:use-module (chickadee graphics polygon)
+  #:use-module (chickadee graphics seagull)
   #:use-module (chickadee graphics shader)
   #:use-module (chickadee graphics stencil)
   #:use-module (chickadee graphics texture)
@@ -1224,9 +1225,57 @@
   (load-shader (scope-datadir "shaders/path-stroke-vert.glsl")
                (scope-datadir "shaders/path-stroke-frag.glsl")))
 
+(define-vertex-shader fill-vertex
+  ((in vec2 position)
+   (out vec2 frag-position)
+   (uniform mat4 mvp)
+   (uniform vec4 color)
+   (uniform mat3 gradient-matrix))
+  ;; Short-circuit because the fragments will just be discarded
+  ;; anyway.
+  (if (<= (-> color w) 0.0)
+      (outputs
+       (vertex:position (vec4 0.0 0.0 0.0 1.0)))
+      (let* ((x (-> position x))
+             (y (-> position y))
+             (fp (* gradient-matrix (vec3 x y 1.0))))
+        (outputs
+         (vertex:position (* mvp (vec4 x y 0.0 1.0)))
+         (frag-position (vec2 (-> fp x) (-> fp y)))))))
+
+(define-fragment-shader fill-fragment
+  ((in vec2 frag-position)
+   (out vec4 frag-color)
+   (uniform int mode)
+   (uniform vec4 color)
+   (uniform vec4 end-color)
+   (uniform vec2 gradient-range)
+   (uniform float radial-gradient-ratio))
+  (let ((gradient-mix (lambda (x)
+                        (let* ((start (-> gradient-range x))
+                               (end (-> gradient-range y))
+                               (t (clamp (/ (- x start) (- end start))
+                                         0.0 1.0)))
+                          (mix color end-color t)))))
+    (if (<= (-> color w) 0.0)
+        (outputs
+         (frag-color (vec4 1.0 1.0 1.0 1.0)))
+        (outputs
+         (frag-color
+          (case mode
+            ((0)
+             color)
+            ((1)
+             (gradient-mix (-> frag-position x)))
+            ((2)
+             (let ((p (* frag-position
+                         (vec2 1.0 radial-gradient-ratio))))
+               (gradient-mix (length p))))
+            (else
+             (vec4 0.0 0.0 0.0 0.0))))))))
+
 (define-graphics-variable fill-shader
-  (load-shader (scope-datadir "shaders/path-fill-vert.glsl")
-               (scope-datadir "shaders/path-fill-frag.glsl")))
+  (compile-shader fill-vertex fill-fragment))
 
 (define-graphics-variable mvp-matrix (make-null-matrix4))
 
-- 
cgit v1.2.3