graphics: Add polygon and cull face modes to render context.

6 files changed, 153 insertions, 13 deletions

diff --git a/Makefile.am b/Makefile.am
index eee4261..d6525e4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -65,14 +65,15 @@ SOURCES = 					\
   chickadee/graphics/gl.scm			\
   chickadee/graphics/gpu.scm			\
   chickadee/graphics/blend.scm			\
+  chickadee/graphics/polygon.scm		\
   chickadee/graphics/depth.scm			\
-  chickadee/graphics/stencil.scm			\
-  chickadee/graphics/texture.scm			\
+  chickadee/graphics/stencil.scm		\
+  chickadee/graphics/texture.scm		\
   chickadee/graphics/shader.scm			\
   chickadee/graphics/buffer.scm			\
-  chickadee/graphics/viewport.scm			\
+  chickadee/graphics/viewport.scm		\
   chickadee/graphics/framebuffer.scm		\
-  chickadee/graphics.scm				\
+  chickadee/graphics.scm			\
   chickadee/graphics/sprite.scm			\
   chickadee/graphics/font.scm			\
   chickadee/graphics/tiled.scm			\
diff --git a/chickadee/graphics.scm b/chickadee/graphics.scm
index 10ff18f..67abacb 100644
--- a/chickadee/graphics.scm
+++ b/chickadee/graphics.scm
@@ -23,18 +23,21 @@
 
 (define-module (chickadee graphics)
   #:use-module (chickadee math matrix)
-  #:use-module (chickadee graphics gpu)
   #:use-module (chickadee graphics blend)
+  #:use-module (chickadee graphics buffer)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics framebuffer)
+  #:use-module (chickadee graphics gpu)
+  #:use-module (chickadee graphics polygon)
   #:use-module (chickadee graphics shader)
   #:use-module (chickadee graphics texture)
-  #:use-module (chickadee graphics buffer)
   #:use-module (chickadee graphics viewport)
   #:use-module (srfi srfi-9)
   #:export (current-viewport
             current-framebuffer
             current-blend-mode
+            current-polygon-mode
+            current-cull-face-mode
             current-depth-test
             current-stencil-test
             current-texture
@@ -44,6 +47,8 @@
             with-viewport
             with-framebuffer
             with-blend-mode
+            with-polygon-mode
+            with-cull-face-mode
             with-depth-test
             with-stencil-test
             with-texture
@@ -57,13 +62,15 @@
             gpu-apply/instanced))
 
 (define-record-type <render-context>
-  (make-render-context viewport framebuffer blend-mode depth-test
-                       stencil-test projection multisample? color-mask
-                       textures)
+  (make-render-context viewport framebuffer blend-mode polygon-mode
+                       cull-face-mode depth-test stencil-test projection
+                       multisample? color-mask textures)
   render-context?
   (viewport render-context-viewport set-render-context-viewport!)
   (framebuffer render-context-framebuffer set-render-context-framebuffer!)
   (blend-mode render-context-blend-mode set-render-context-blend-mode!)
+  (polygon-mode render-context-polygon-mode set-render-context-polygon-mode!)
+  (cull-face-mode render-context-cull-face-mode set-render-context-cull-face-mode!)
   (depth-test render-context-depth-test set-render-context-depth-test!)
   (stencil-test render-context-stencil-test set-render-context-stencil-test!)
   (projection render-context-projection set-render-context-projection!)
@@ -75,6 +82,8 @@
   (make-render-context null-viewport
                        null-framebuffer
                        'replace
+                       fill-polygon-mode
+                       back-cull-face-mode
                        #f
                        #f
                        (make-identity-matrix4)
@@ -91,6 +100,12 @@
 (define (current-blend-mode)
   (render-context-blend-mode render-context))
 
+(define (current-polygon-mode)
+  (render-context-polygon-mode render-context))
+
+(define (current-cull-face-mode)
+  (render-context-cull-face-mode render-context))
+
 (define (current-depth-test)
   (render-context-depth-test render-context))
 
@@ -139,6 +154,14 @@
   (with (render-context-blend-mode set-render-context-blend-mode! blend-mode)
         body ...))
 
+(define-syntax-rule (with-polygon-mode polygon-mode body ...)
+  (with (render-context-polygon-mode set-render-context-polygon-mode! polygon-mode)
+        body ...))
+
+(define-syntax-rule (with-cull-face-mode cull-face-mode body ...)
+  (with (render-context-cull-face-mode set-render-context-cull-face-mode! cull-face-mode)
+        body ...))
+
 (define-syntax-rule (with-depth-test depth-test body ...)
   (with (render-context-depth-test set-render-context-depth-test! depth-test)
         body ...))
@@ -189,6 +212,8 @@
     (set-gpu-framebuffer! gpu (current-framebuffer))
     (set-gpu-viewport! gpu (current-viewport))
     (set-gpu-blend-mode! gpu (current-blend-mode))
+    (set-gpu-polygon-mode! gpu (current-polygon-mode))
+    (set-gpu-cull-face-mode! gpu (current-cull-face-mode))
     (set-gpu-depth-test! gpu (current-depth-test))
     (set-gpu-stencil-test! gpu (current-stencil-test))
     (set-gpu-multisample! gpu (current-multisample))
diff --git a/chickadee/graphics/gl.scm b/chickadee/graphics/gl.scm
index b525294..739165f 100644
--- a/chickadee/graphics/gl.scm
+++ b/chickadee/graphics/gl.scm
@@ -335,4 +335,5 @@ object.")
 ;;;
 
 (re-export (%glPolygonMode . gl-polygon-mode)
+           (%glCullFace . gl-cull-face)
            (%glColorMask . gl-color-mask))
diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm
index 16f5554..7783fe5 100644
--- a/chickadee/graphics/gpu.scm
+++ b/chickadee/graphics/gpu.scm
@@ -38,6 +38,8 @@
             gpu-glsl-version
             gpu-max-texture-size
             gpu-blend-mode
+            gpu-polygon-mode
+            gpu-cull-face-mode
             gpu-depth-test
             gpu-stencil-test
             gpu-framebuffer
@@ -49,6 +51,8 @@
             gpu-multisample
             gpu-color-mask
             set-gpu-blend-mode!
+            set-gpu-polygon-mode!
+            set-gpu-cull-face-mode!
             set-gpu-depth-test!
             set-gpu-stencil-test!
             set-gpu-framebuffer!
@@ -108,6 +112,8 @@ from the GPU's memory."
              glsl-version
              max-texture-size
              blend-mode
+             polygon-mode
+             cull-face-mode
              depth-test
              stencil-test
              framebuffer
@@ -124,6 +130,8 @@ from the GPU's memory."
   (glsl-version gpu-glsl-version)
   (max-texture-size gpu-max-texture-size)
   (blend-mode %gpu-blend-mode)
+  (polygon-mode %gpu-polygon-mode)
+  (cull-face-mode %gpu-cull-face-mode)
   (depth-test %gpu-depth-test)
   (stencil-test %gpu-stencil-test)
   (framebuffer %gpu-framebuffer)
@@ -154,6 +162,7 @@ from the GPU's memory."
   (let ((textures (make-vector 32))
         ;; Lazily resolve bindings to avoid circular dependencies.
         (blend-module (resolve-interface '(chickadee graphics blend)))
+        (polygon-module (resolve-interface '(chickadee graphics polygon)))
         (depth-module (resolve-interface '(chickadee graphics depth)))
         (stencil-module (resolve-interface '(chickadee graphics stencil)))
         (buffer-module (resolve-interface '(chickadee graphics buffer)))
@@ -179,6 +188,10 @@ from the GPU's memory."
                (max-texture-size)
                (make-gpu-state (module-ref blend-module 'apply-blend-mode)
                                'replace)
+               (make-gpu-state (module-ref polygon-module 'apply-polygon-mode)
+                               (module-ref polygon-module 'fill-polygon-mode))
+               (make-gpu-state (module-ref polygon-module 'apply-cull-face-mode)
+                               (module-ref polygon-module 'back-cull-face-mode))
                (make-gpu-state (module-ref depth-module 'apply-depth-test) #f)
                (make-gpu-state (module-ref stencil-module 'apply-stencil-test) #f)
                (make-gpu-state (module-ref framebuffer-module 'apply-framebuffer)
@@ -201,6 +214,8 @@ from the GPU's memory."
     (gpu-state-ref (ref gpu))))
 
 (define-gpu-getter gpu-blend-mode %gpu-blend-mode)
+(define-gpu-getter gpu-blend-mode %gpu-polygon-mode)
+(define-gpu-getter gpu-blend-mode %gpu-cull-face-mode)
 (define-gpu-getter gpu-depth-test %gpu-depth-test)
 (define-gpu-getter gpu-stencil-test %gpu-stencil-test)
 (define-gpu-getter gpu-framebuffer %gpu-framebuffer)
@@ -216,6 +231,8 @@ from the GPU's memory."
     (gpu-state-set! (ref gpu) x)))
 
 (define-gpu-setter set-gpu-blend-mode! %gpu-blend-mode)
+(define-gpu-setter set-gpu-polygon-mode! %gpu-polygon-mode)
+(define-gpu-setter set-gpu-cull-face-mode! %gpu-cull-face-mode)
 (define-gpu-setter set-gpu-depth-test! %gpu-depth-test)
 (define-gpu-setter set-gpu-stencil-test! %gpu-stencil-test)
 (define-gpu-setter set-gpu-framebuffer! %gpu-framebuffer)
diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm
index 3500c15..ca1b0be 100644
--- a/chickadee/graphics/path.scm
+++ b/chickadee/graphics/path.scm
@@ -27,6 +27,7 @@
   #:use-module (chickadee graphics)
   #:use-module (chickadee graphics color)
   #:use-module (chickadee graphics gl)
+  #:use-module (chickadee graphics polygon)
   #:use-module (chickadee graphics shader)
   #:use-module (chickadee graphics stencil)
   #:use-module (chickadee graphics buffer)
@@ -1240,8 +1241,7 @@
     (matrix4-mult! *mvp* matrix (current-projection))
     ;; Wireframe debug mode.
     (when *debug?*
-      (begin
-        (gl-polygon-mode (cull-face-mode front) (polygon-mode line))
+      (with-polygon-mode line-polygon-mode
         (let loop ((i 0))
           (when (< i n)
             (gpu-apply* (force path-shader)
@@ -1250,8 +1250,7 @@
                         (u32vector-ref counts i)
                         #:mvp (current-projection)
                         #:mode 0)
-            (loop (+ i 1))))
-        (gl-polygon-mode (cull-face-mode front) (polygon-mode fill))))
+            (loop (+ i 1))))))
     ;; Anti-alias the edges of the fill.
     (with-multisample #t
       ;; Render fan to stencil buffer. Each time a triangle is
diff --git a/chickadee/graphics/polygon.scm b/chickadee/graphics/polygon.scm
new file mode 100644
index 0000000..b84cc63
--- /dev/null
+++ b/chickadee/graphics/polygon.scm
@@ -0,0 +1,97 @@
+;;; 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
+;;
+;; Polygon face rendering configuration.
+;;
+;;; Code:
+
+(define-module (chickadee graphics polygon)
+  #:use-module (chickadee graphics gl)
+  #:use-module (gl)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:export (make-polygon-mode
+            polygon-mode?
+            polygon-mode-front
+            polygon-mode-back
+            fill-polygon-mode
+            line-polygon-mode
+            point-polygon-mode
+            apply-polygon-mode
+
+            make-cull-face-mode
+            cull-face-mode?
+            cull-face-mode-front?
+            cull-face-mode-back?
+            no-cull-face-mode
+            back-cull-face-mode
+            front-cull-face-mode
+            front-and-back-cull-face-mode
+            apply-cull-face-mode))
+
+(define-record-type <polygon-mode>
+  (make-polygon-mode front back)
+  polygon-mode?
+  (front polygon-mode-front)
+  (back polygon-mode-back))
+
+(define fill-polygon-mode (make-polygon-mode 'fill 'fill))
+(define line-polygon-mode (make-polygon-mode 'line 'line))
+(define point-polygon-mode (make-polygon-mode 'point 'point))
+
+(define (apply-polygon-mode mode)
+  (define (glmode sym)
+    (match sym
+      ('fill (polygon-mode fill))
+      ('line (polygon-mode line))
+      ('point (polygon-mode point))))
+  (let ((front (polygon-mode-front mode))
+        (back (polygon-mode-back mode)))
+    (if (eq? front back)
+        (gl-polygon-mode (cull-face-mode front-and-back) (glmode front))
+        (begin
+          (gl-polygon-mode (cull-face-mode front) (glmode front))
+          (gl-polygon-mode (cull-face-mode back) (glmode back))))))
+
+(define-record-type <cull-face-mode>
+  (make-cull-face-mode front? back?)
+  cull-face-mode?
+  (front? cull-face-mode-front?)
+  (back? cull-face-mode-back?))
+
+(define no-cull-face-mode (make-cull-face-mode #f #f))
+(define back-cull-face-mode (make-cull-face-mode #f #t))
+(define front-cull-face-mode (make-cull-face-mode #t #f))
+(define front-and-back-cull-face-mode (make-cull-face-mode #t #t))
+
+(define (apply-cull-face-mode mode)
+  (let ((front? (cull-face-mode-front? mode))
+        (back? (cull-face-mode-back? mode)))
+    (cond
+     ((and front? back?)
+      (gl-enable (enable-cap cull-face))
+      (gl-cull-face (cull-face-mode front-and-back)))
+     (front?
+      (gl-enable (enable-cap cull-face))
+      (gl-cull-face (cull-face-mode front)))
+     (back?
+      (gl-enable (enable-cap cull-face))
+      (gl-cull-face (cull-face-mode back)))
+     (else
+      (gl-disable (enable-cap cull-face))))))