From 46544b7dba0081f22e686f70c606a338c7fa52dd Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 21 Sep 2015 19:44:10 -0400
Subject: render: Reimplement rendering engine using functional combinators.

Warning: This is a huge commit.

I completely gutted the old scene graph and replaced it with a somewhat
monadic rendering combinator module instead.  The interface remains
purely functional, but replaces the <model> data type with procedures in
the rendering monad instead.  This opens the door for
rendering *anything*, not just meshes.  Now I can implement particle
systems and other non-static things.
---
 examples/mines/mines.scm | 86 ++++++++++++++++++++++++------------------------
 1 file changed, 43 insertions(+), 43 deletions(-)

(limited to 'examples/mines')

diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 3a9ee7d..0b55d8b 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -34,12 +34,12 @@
              (sly math rect)
              (sly math transform)
              (sly math vector)
+             (sly render)
              (sly render camera)
              (sly render color)
              (sly render font)
-             (sly render model)
              (sly render sprite)
-             (sly render scene)
+             (sly render texture)
              (sly input keyboard)
              (sly input mouse))
 
@@ -296,9 +296,11 @@
 (define sprites
   (map (match-lambda
         ((key . config)
-         (cons key (load-sprite
-                       (string-append "images/" (assoc-ref config 'name) ".png")
-                       #:anchor (assoc-ref config 'anchor)))))
+         (let ((sprite (load-sprite (string-append "images/"
+                                                   (assoc-ref config 'name)
+                                                   ".png")
+                                    #:anchor (assoc-ref config 'anchor))))
+           (cons key sprite))))
        '((1 .        ((name . "1-mine")
                       (anchor . center)))
          (2 .        ((name . "2-mines")
@@ -348,57 +350,55 @@
           (else #f))
          sprite-ref))
 
-(define draw-tile
-  (let ((offset (translate (vector2 (/ tile-size 2) (/ tile-size 2)))))
+(define render-tile
+  (let ((offset (vector2 (/ tile-size 2) (/ tile-size 2))))
     (lambda (tile)
-      (model-group (tile-base-sprite tile)
-                   (let ((overlay (tile-overlay-sprite tile)))
-                     (if overlay
-                         (model-place offset overlay)
-                         null-model))))))
+      (render-begin
+       (render-sprite (tile-base-sprite tile))
+       (let ((overlay (tile-overlay-sprite tile)))
+         (if overlay
+             (move offset (render-sprite overlay))
+             render-nothing))))))
 
 (define-signal board-view
   (signal-let ((board board))
-    (define (draw-column tile x)
-      (model-move (vector2 (* x tile-size) 0)
-                  (draw-tile tile)))
+    (define (render-column tile x)
+      (move (vector2 (* x tile-size) 0)
+            (render-tile tile)))
 
-    (define (draw-row row y)
-      (chain (enumerate-map draw-column row)
-        (list->model)
-        (model-move (vector2 0 (* y tile-size)))))
+    (define (render-row row y)
+      (move (vector2 0 (* y tile-size))
+            (list->renderer (enumerate-map render-column row))))
 
-    (list->model (enumerate-map draw-row board))))
+    (list->renderer (enumerate-map render-row board))))
 
-(define-signal status-message
-  (signal-let ((board board))
-    (define (make-message message)
-      (label font message #:anchor 'center))
+(define (render-message message)
+  (move (vector2 (/ (vx resolution) 2)
+                 (- (vy resolution) 64))
+        (render-sprite
+         (make-label font message #:anchor 'center))))
 
-    (model-move
-     (vector2 (/ (vx resolution) 2) (- (vy resolution) 64))
-     (list->model
+(define-signal status-message
+  (let ((game-over (render-message "GAME OVER - Press N to play again"))
+        (you-win   (render-message "YOU WIN! - Press N to play again")))
+    (signal-let ((board board))
       (cond
-       ((board-lose? board)
-        (list (make-message "GAME OVER - Press N to play again")))
-       ((board-win? board)
-        (list (make-message "YOU WIN! - Press N to play again")))
-       (else '()))))))
-
-(define-signal model
-  (signal-let ((view   board-view)
-               (status status-message)
-               (center center-position))
-    (model-group status (model-move center view))))
+       ((board-lose? board) game-over)
+       ((board-win? board) you-win)
+       (else render-nothing)))))
 
 (define camera
-  (orthographic-camera
-   (vx resolution) (vy resolution)
-   #:viewport (make-viewport (make-rect (vector2 0 0) resolution)
-                             #:clear-color tango-dark-plum)))
+  (2d-camera #:area (make-rect (vector2 0 0) resolution)
+             #:clear-color tango-dark-plum))
 
 (define-signal scene
-  (signal-map (lambda (model) (make-scene camera model)) model))
+  (signal-let ((view   board-view)
+               (status status-message)
+               (center center-position))
+    (with-camera camera
+      (render-begin
+       status
+       (move center view)))))
 
 ;;;
 ;;; Initialization
-- 
cgit v1.2.3