graphics: blend: Add proper <blend-mode> data type.

No more symbols.  Hooray!

6 files changed, 202 insertions, 66 deletions

diff --git a/chickadee/graphics/blend.scm b/chickadee/graphics/blend.scm
index 8901246..d13d541 100644
--- a/chickadee/graphics/blend.scm
+++ b/chickadee/graphics/blend.scm
@@ -16,54 +16,126 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (chickadee graphics blend)
-  #:use-module (ice-9 match)
-  #:use-module (gl)
   #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics gl)
-  #:export (g:blend-mode
+  #:use-module (gl)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:export (make-blend-mode
+            blend-mode?
+            blend-mode-equation
+            blend-mode-source-function
+            blend-mode-destination-function
+            blend:alpha
+            blend:multiply
+            blend:subtract
+            blend:add
+            blend:lighten
+            blend:darken
+            blend:screen
+            blend:replace
+            g:blend-mode
             current-blend-mode))
 
+(define-record-type <blend-mode>
+  (make-blend-mode equation source-function destination-function)
+  blend-mode?
+  (equation blend-mode-equation)
+  (source-function blend-mode-source-function)
+  (destination-function blend-mode-destination-function))
+
+(define blend:alpha
+  (make-blend-mode 'add 'source-alpha 'one-minus-source-alpha))
+(define blend:multiply
+  (make-blend-mode 'add 'destination-color 'zero))
+(define blend:subtract
+  (make-blend-mode 'reverse-subtract 'one 'zero))
+(define blend:add
+  (make-blend-mode 'add 'one 'one))
+(define blend:lighten
+  (make-blend-mode 'max 'one 'zero))
+(define blend:darken
+  (make-blend-mode 'min 'one 'zero))
+(define blend:screen
+  (make-blend-mode 'add 'one 'one-minus-source-color))
+(define blend:replace
+  (make-blend-mode 'add 'one 'zero))
+
 (define (bind-blend-mode blend-mode)
   (if blend-mode
       (begin
         (gl-enable (enable-cap blend))
-        (match blend-mode
-          ('alpha
-           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
-           (gl-blend-func (blending-factor-src src-alpha)
-                          (blending-factor-dest one-minus-src-alpha)))
-          ('multiply
-           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
-           (gl-blend-func (blending-factor-src dst-color)
-                          (blending-factor-dest zero)))
-          ('subtract
-           (gl-blend-equation
+        (gl-blend-equation
+         (match (blend-mode-equation blend-mode)
+           ('add
+            (blend-equation-mode-ext func-add-ext))
+           ('subtract
+            (blend-equation-mode-ext func-subtract-ext))
+           ('reverse-subtract
             (blend-equation-mode-ext func-reverse-subtract-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest zero)))
-          ('add
-           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest one)))
-          ('lighten
-           (gl-blend-equation (blend-equation-mode-ext max-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest zero)))
-          ('darken
-           (gl-blend-equation (blend-equation-mode-ext min-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest zero)))
-          ('screen
-           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest one-minus-src-color)))
-          ('replace
-           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
-           (gl-blend-func (blending-factor-src one)
-                          (blending-factor-dest zero)))))
+           ('min
+            (blend-equation-mode-ext min-ext))
+           ('max
+            (blend-equation-mode-ext max-ext))
+           ('alpha-min
+            (blend-equation-mode-ext alpha-min-sgix))
+           ('alpha-max
+            (blend-equation-mode-ext alpha-min-sgix))))
+        (gl-blend-func (match (blend-mode-source-function blend-mode)
+                         ('zero
+                          (blending-factor-src zero))
+                         ('one
+                          (blending-factor-src one))
+                         ('destination-color
+                          (blending-factor-src dst-color))
+                         ('one-minus-destination-color
+                          (blending-factor-src one-minus-dst-color))
+                         ('source-alpha-saturate
+                          (blending-factor-src src-alpha-saturate))
+                         ('source-alpha
+                          (blending-factor-src src-alpha))
+                         ('one-minus-source-alpha
+                          (blending-factor-src one-minus-src-alpha))
+                         ('destination-alpha
+                          (blending-factor-src dst-alpha))
+                         ('one-minus-destination-alpha
+                          (blending-factor-src one-minus-dst-alpha))
+                         ('constant-color
+                          (blending-factor-src constant-color-ext))
+                         ('one-minus-constant-color
+                          (blending-factor-src one-minus-constant-color-ext))
+                         ('contstant-alpha
+                          (blending-factor-src constant-alpha-ext))
+                         ('one-minus-constant-alpha
+                          (blending-factor-src one-minus-constant-alpha-ext)))
+                       (match (blend-mode-destination-function blend-mode)
+                         ('zero
+                          (blending-factor-dest zero))
+                         ('one
+                          (blending-factor-dest one))
+                         ('source-color
+                          (blending-factor-dest src-color))
+                         ('one-minus-source-color
+                          (blending-factor-dest one-minus-src-color))
+                         ('source-alpha
+                          (blending-factor-dest src-alpha))
+                         ('one-minus-source-alpha
+                          (blending-factor-dest one-minus-src-alpha))
+                         ('destination-alpha
+                          (blending-factor-dest dst-alpha))
+                         ('one-minus-destination-alpha
+                          (blending-factor-dest one-minus-dst-alpha))
+                         ('constant-color
+                          (blending-factor-dest constant-color-ext))
+                         ('one-minus-constant-color
+                          (blending-factor-dest one-minus-constant-color-ext))
+                         ('contstant-alpha
+                          (blending-factor-dest constant-alpha-ext))
+                         ('one-minus-constant-alpha
+                          (blending-factor-dest one-minus-constant-alpha-ext)))))
       (gl-disable (enable-cap blend))))
 
 (define-graphics-state g:blend-mode
   current-blend-mode
-  #:default 'replace
+  #:default blend:replace
   #:bind bind-blend-mode)
diff --git a/chickadee/graphics/font.scm b/chickadee/graphics/font.scm
index eb1de3f..8adba8d 100644
--- a/chickadee/graphics/font.scm
+++ b/chickadee/graphics/font.scm
@@ -37,6 +37,7 @@
   #:use-module (chickadee math matrix)
   #:use-module (chickadee math rect)
   #:use-module (chickadee math vector)
+  #:use-module (chickadee graphics blend)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics shader)
@@ -433,7 +434,7 @@ extension must be either .xml or .fnt."
 (define draw-text*
   (let ((cursor (vec2 0.0 0.0))
         (rect (make-rect 0.0 0.0 0.0 0.0)))
-    (lambda* (font text matrix #:key (blend-mode 'alpha)
+    (lambda* (font text matrix #:key (blend-mode blend:alpha)
                    (color white) (start 0) (end (string-length text)))
       (let ((batches (font-sprite-batches font))
             (kernings (font-kernings font)))
@@ -500,7 +501,7 @@ extension must be either .xml or .fnt."
               (origin %null-vec2)
               (rotation 0)
               (scale %default-scale)
-              (blend-mode 'alpha)
+              (blend-mode blend:alpha)
               (start 0)
               (end (string-length text)))
       "Draw the string TEXT with the first character starting at
diff --git a/chickadee/graphics/particles.scm b/chickadee/graphics/particles.scm
index d735572..08e5957 100644
--- a/chickadee/graphics/particles.scm
+++ b/chickadee/graphics/particles.scm
@@ -204,7 +204,7 @@ void main (void) {
                            (delete emitter (particles-emitters particles))))
 
 (define* (make-particles capacity #:key
-                         (blend-mode 'alpha)
+                         (blend-mode blend:alpha)
                          (start-color white)
                          (end-color (make-color 0.0 0.0 0.0 0.0))
                          (texture null-texture)
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
index 8a4edfd..ef5206a 100644
--- a/chickadee/graphics/path.scm
+++ b/chickadee/graphics/path.scm
@@ -1194,7 +1194,7 @@
   ;; Another mini VM for a simple picture language.
   (let loop ((commands (painter-commands painter))
              (matrix matrix)
-             (blend-mode 'alpha)
+             (blend-mode blend:alpha)
              (fill-color white)
              (stroke-color black)
              (stroke-width 1.0)
diff --git a/chickadee/graphics/sprite.scm b/chickadee/graphics/sprite.scm
index 76ee94a..0d6f838 100644
--- a/chickadee/graphics/sprite.scm
+++ b/chickadee/graphics/sprite.scm
@@ -108,7 +108,7 @@ void main (void) {
                        matrix
                        #:key
                        (tint white)
-                       (blend-mode 'alpha)
+                       (blend-mode blend:alpha)
                        (texcoords (texture-gl-tex-rect texture)))
   (let ((shader (graphics-variable-ref sprite-shader))
         (geometry (graphics-variable-ref sprite-geometry))
@@ -152,7 +152,7 @@ void main (void) {
                       (origin %null-vec2)
                       (scale %default-scale)
                       (rotation 0.0)
-                      (blend-mode 'alpha)
+                      (blend-mode blend:alpha)
                       (rect (texture-gl-rect texture)))
   "Draw TEXTURE at POSITION.
 
@@ -335,7 +335,7 @@ may be specified via the TEXTURE-REGION argument."
                        #:tint tint
                        #:texture-region texture-region)))
 
-(define* (draw-sprite-batch* batch matrix #:key (blend-mode 'alpha))
+(define* (draw-sprite-batch* batch matrix #:key (blend-mode blend:alpha))
   "Render the contents of BATCH."
   (let ((shader (graphics-variable-ref sprite-batch-shader))
         (mvp (graphics-variable-ref sprite-mvp-matrix)))
@@ -356,7 +356,7 @@ may be specified via the TEXTURE-REGION argument."
                             (origin %null-vec2)
                             (scale %default-scale)
                             (rotation 0.0)
-                            (blend-mode 'alpha))
+                            (blend-mode blend:alpha))
   "Render the contents of BATCH."
   (let ((matrix (graphics-variable-ref sprite-model-matrix)))
     (matrix4-2d-transform! matrix
@@ -383,7 +383,7 @@ may be specified via the TEXTURE-REGION argument."
               (bottom-margin margin)
               (left-margin margin)
               (right-margin margin)
-              (blend-mode 'alpha)
+              (blend-mode blend:alpha)
               (tint white))
       (let* ((x (rect-x rect))
              (y (rect-y rect))
@@ -463,7 +463,7 @@ may be specified via the TEXTURE-REGION argument."
               (origin %null-vec2)
               (rotation 0.0)
               (scale %default-scale)
-              (blend-mode 'alpha)
+              (blend-mode blend:alpha)
               (tint white))
       "Draw a \"nine patch\" sprite.  A nine patch sprite renders
 TEXTURE on the rectangular area RECT whose stretchable areas are
diff --git a/doc/api.texi b/doc/api.texi
index 07005a6..5fa18b3 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1965,7 +1965,7 @@ interface for working with sprites.  Bitmaps are stored in textures
 @code{draw-sprite} procedure.
 
 @deffn {Procedure} draw-sprite texture position @
-       [#:tint white] [#:origin] [#:scale] [#:rotation] [#:blend-mode alpha] @
+       [#:tint white] [#:origin] [#:scale] [#:rotation] [#:blend-mode] @
        [#:rect]
 
 Draw @var{texture} at @var{position}.
@@ -2036,7 +2036,7 @@ See @code{draw-sprite} for information about the other arguments.
 Reset size of @var{batch} to 0.
 @end deffn
 
-@deffn {Procedure} draw-sprite-batch batch [#:blend-mode @code{alpha}]
+@deffn {Procedure} draw-sprite-batch batch [#:blend-mode]
 Render @var{batch} using @var{blend-mode}.  Alpha blending is used by
 default.
 @end deffn
@@ -2071,7 +2071,7 @@ artifacts.
 @deffn {Procedure} draw-nine-patch texture rect @
        [#:margin 0] [#:top-margin margin] [#:bottom-margin margin] @
        [#:left-margin margin] [#:right-margin margin] @
-       [#:origin] [#:scale] [#:rotation] [#:blend-mode alpha] @
+       [#:origin] [#:scale] [#:rotation] [#:blend-mode] @
        [#:tint white]
 
 Draw a nine patch sprite.  A nine patch sprite renders @var{texture}
@@ -2410,7 +2410,7 @@ at the coordinates @code{(320, 240)}:
 
 To see all of the tweakable knobs and switches, read on!
 
-@deffn {Procedure} make-particles capacity [#:blend-mode @code{alpha}] @
+@deffn {Procedure} make-particles capacity [#:blend-mode] @
        [#:color white] [#:end-color transparent] [#:texture] @
        [#:animation-rows 1] [#:animation-columns 1] [#:width] [#:height] @
        [#:speed-range (vec2 0.1 1.0)] [#:acceleration-range (vec2 0.0 0.1)] @
@@ -2420,7 +2420,7 @@ Return a new particle system that may contain up to @var{capacity}
 particles.  Achieving the desired particle effect involves tweaking
 the following keyword arguments as needed:
 
-- @var{blend-mode}: Pixel blending mode.  @code{alpha} by default.
+- @var{blend-mode}: Pixel blending mode.  Alpha blending is used by default.
 (@pxref{Blending} for more about blend modes).
 
 - @var{start-color}: The tint color of the particle at the beginning of its
@@ -2789,36 +2789,99 @@ and @var{view-matrix} applied.
 Rendering a scene often involves drawing layers of objects that
 overlap each other.  Blending determines how two overlapping pixels
 are combined in the final image that is rendered to the screen.
-Chickadee provides the following blend modes:
-
-@itemize
 
-@item @code{replace}
-Use the latest color, ignoring all others.
+Chickadee provides the following blend modes:
 
-@item @code{alpha}
+@defvar blend:alpha
 Blend pixels according to the values of their alpha channels.  This is
-the most commonly used blend mode and thus is Chickadee's default
-mode.
+the most commonly used blend mode.
+@end defvar
 
-@item @code{add}
+@defvar blend:replace
+Overwrite the output pixel color with the color being drawn.
+@end defvar
+
+@defvar blend:add
 Add all pixel color values together.  The more colors blended
 together, the more white the final color becomes.
+@end defvar
 
-@item @code{subtract}
+@defvar blend:subtract
 Subtract all pixel color values.  The more colors blended together,
 the more black the final color becomes.
+@end defvar
+
+@defvar blend:multiply
+@end defvar
 
-@item @code{multiply}
+@defvar blend:darken
+@end defvar
 
-@item @code{darken}
+@defvar blend:lighten
+@end defvar
 
-@item @code{lighten}
+@defvar blend:screen
+@end defvar
 
-@item @code{screen}
+Custom blend modes can be created using the @code{make-blend-mode} procedure:
 
+@deffn {Procedure} make-blend-mode equation source-function destination-function
+Return a new custom blend mode that applies @var{source-function} to
+the source color, @var{destination-function} to the destination color,
+and finally applies @var{equation} to the transformed
+source/destination color values.  These arguments are @emph{not}
+procedures, but symbolic representations of the functions that OpenGL
+supports.
+
+Valid values for @var{equation} are:
+
+@itemize
+@item @code{add}
+@item @code{subtract}
+@item @code{reverse-subtract}
+@item @code{min}
+@item @code{max}
+@item @code{alpha-min}
+@item @code{alpha-max}
 @end itemize
 
+Valid values for @var{source-function} are:
+
+@itemize
+@item @code{zero}
+@item @code{one}
+@item @code{destination-color}
+@item @code{one-minus-destination-color}
+@item @code{source-alpha-saturate}
+@item @code{source-alpha}
+@item @code{one-minus-source-alpha}
+@item @code{destination-alpha}
+@item @code{one-minus-destination-alpha}
+@item @code{constant-color}
+@item @code{one-minus-constant-color}
+@item @code{constant-alpha}
+@item @code{one-minus-constant-alpha}
+@end itemize
+
+Valid values for @var{destination-function} are:
+
+@itemize
+@item @code{zero}
+@item @code{one}
+@item @code{source-color}
+@item @code{one-minus-source-color}
+@item @code{source-alpha}
+@item @code{one-minus-source-alpha}
+@item @code{destination-alpha}
+@item @code{one-minus-destination-alpha}
+@item @code{constant-color}
+@item @code{one-minus-constant-color}
+@item @code{constant-alpha}
+@item @code{one-minus-constant-alpha}
+@end itemize
+
+@end deffn
+
 @node Framebuffers
 @subsection Framebuffers