From 14f984b34d065d7c8bb27f5fe9a46cab4d66b563 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 8 Jan 2018 21:46:21 -0500
Subject: render: shapes: Add draw-filled-rect procedure.

* chickadee/render/shapes.scm (draw-filled-rect): New procedure.
---
 chickadee/render/shapes.scm | 76 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 74 insertions(+), 2 deletions(-)

diff --git a/chickadee/render/shapes.scm b/chickadee/render/shapes.scm
index 415eff8..d2e2ca2 100644
--- a/chickadee/render/shapes.scm
+++ b/chickadee/render/shapes.scm
@@ -1,5 +1,5 @@
 ;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2018 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
@@ -26,12 +26,84 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-4)
   #:use-module (chickadee math matrix)
+  #:use-module (chickadee math rect)
   #:use-module (chickadee math vector)
   #:use-module (chickadee render)
   #:use-module (chickadee render color)
   #:use-module (chickadee render shader)
   #:use-module (chickadee render buffer)
-  #:export (draw-line))
+  #:export (draw-filled-rect
+            draw-line))
+
+;; TODO: Make a generic polygon renderer, include batching, etc.
+(define draw-filled-rect
+  (let* ((vertex-buffer
+          (delay
+            (make-streaming-typed-buffer 'vec2 'float 4
+                                         #:name "rect-typed-buffer")))
+         (index-buffer
+          (delay
+            (make-typed-buffer #:type 'scalar
+                               #:component-type 'unsigned-int
+                               #:buffer (make-buffer (u32vector 0 3 2 0 2 1)
+                                                     #:target 'index))))
+         (vertex-array
+          (delay
+            (make-vertex-array #:indices (force index-buffer)
+                               #:attributes `((0 . ,(force vertex-buffer))))))
+         (default-shader
+           (delay
+             (strings->shader
+              "
+#version 330
+
+in vec2 position;
+uniform mat4 mvp;
+
+void main(void) {
+    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
+}
+"
+              "
+#version 330
+
+in vec2 frag_tex;
+uniform vec4 color;
+
+void main (void) {
+    gl_FragColor = color;
+}
+")))
+         (mvp (make-null-matrix4)))
+    (lambda* (region
+              color
+              #:key
+              (blend-mode 'alpha)
+              (shader (force default-shader))
+              matrix)
+      (let* ((x1 (rect-x region))
+             (y1 (rect-y region))
+             (x2 (+ x1 (rect-width region)))
+             (y2 (+ y1 (rect-height region))))
+        (with-mapped-typed-buffer (force vertex-buffer)
+          (let ((bv (typed-buffer-data (force vertex-buffer))))
+            (f32vector-set! bv 0 x1)
+            (f32vector-set! bv 1 y1)
+            (f32vector-set! bv 2 x2)
+            (f32vector-set! bv 3 y1)
+            (f32vector-set! bv 4 x2)
+            (f32vector-set! bv 5 y2)
+            (f32vector-set! bv 6 x1)
+            (f32vector-set! bv 7 y2)))
+        (with-blend-mode blend-mode
+          (gpu-apply shader (force vertex-array)
+                     #:mvp (if matrix
+                               (begin
+                                 (matrix4-mult! mvp matrix
+                                                (current-projection))
+                                 mvp)
+                               (current-projection))
+                     #:color color))))))
 
 (define draw-line
   (let* ((vertex-buffer
-- 
cgit v1.2.3