render: Merge <group> into <model>.

* sly/render/model.scm (<model>): Add 'transform' and 'children' fields.
  (model-transform, model-children): New accessors.
  (make-model): Add 'transform' and 'children' keyword arguments.
  (set-transform-identity!): New procedure.
  (draw-model): Recursively draw model and all children.
  (model-paint, model-blend): Renamed.
  (paint, blend, group, group*, move, place): New procedures.
* sly/render/group.scm: Delete.
* Makefile.am (SOURCES): Remove it.
* examples/2048/2048.scm: Update example.
* examples/animation.scm: Likewise.
* examples/font.scm: Likewise.
* examples/joystick.scm: Likewise.
* examples/mines/mines.scm: Likewise.
* examples/simple.scm: Likewise.
* examples/tilemap.scm: Likewise.
* README.org (Example): Update sample code.

2 files changed, 93 insertions, 166 deletions

diff --git a/sly/render/group.scm b/sly/render/group.scm
deleted file mode 100644
index 9cfc062..0000000
--- a/sly/render/group.scm
+++ /dev/null
@@ -1,137 +0,0 @@
-;;; Sly
-;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
-;;;
-;;; Sly 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.
-;;;
-;;; Sly 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:
-;;
-;; Hierarchy of renderable objects using a directed acyclic graph
-;; structure.
-;;
-;;; Code:
-
-(define-module (sly render group)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-9)
-  #:use-module (sly math transform)
-  #:use-module (sly render shader)
-  #:use-module (sly render texture)
-  #:use-module (sly render utils)
-  #:use-module (sly render camera)
-  #:use-module (sly render context)
-  #:use-module (sly render model)
-  #:export (make-group group
-            group?
-            group-transform group-visible? group-children
-            draw-group
-            group-move group-place group-show))
-
-;;;
-;;; Group
-;;;
-
-;; The composite object of the scene graph.  Groups have zero or more
-;; children, which may be groups or models.
-(define-record-type <group>
-  (%make-group transform visible? children)
-  group?
-  (transform group-transform)
-  (visible? group-visible?)
-  (children group-children))
-
-(define* (make-group children #:optional #:key (transform identity-transform)
-                     (visible? #t))
-  "Create a new group containing CHILDREN in which each child is
-rendered relative to TRANSFORM.  The VISIBLE? flag determines whether
-or not to render child nodes."
-  (%make-group transform visible? children))
-
-(define (%draw-group group parent-transform view context)
-  (match group
-    (($ <group> transform visible? children)
-     (when visible?
-       (with-temp-transform context world-transform
-         (transform*! world-transform transform parent-transform)
-         (for-each (lambda (child)
-                     (let ((draw (match child
-                                   ((? group? group) %draw-group)
-                                   ((? model? model) draw-model))))
-                       (draw child world-transform view context)))
-                   children))))))
-
-(define (set-transform-identity! t)
-  (let ((matrix (transform-matrix t)))
-    (array-set! matrix 1 0 0)
-    (array-set! matrix 0 0 1)
-    (array-set! matrix 0 0 2)
-    (array-set! matrix 0 0 3)
-    (array-set! matrix 0 1 0)
-    (array-set! matrix 1 1 1)
-    (array-set! matrix 0 1 2)
-    (array-set! matrix 0 1 3)
-    (array-set! matrix 0 2 0)
-    (array-set! matrix 0 2 1)
-    (array-set! matrix 1 2 2)
-    (array-set! matrix 0 2 3)
-    (array-set! matrix 0 3 0)
-    (array-set! matrix 0 3 1)
-    (array-set! matrix 0 3 2)
-    (array-set! matrix 1 3 3)))
-
-(define draw-group
-  (let ((context (make-render-context)))
-    (lambda* (group camera #:optional (context context))
-      "Draw the scene defined by GROUP as viewed by CAMERA, with the given
-render CONTEXT."
-      (with-render-context context
-        (with-temp-transform context view
-          (transform*! view
-                       (camera-location camera)
-                       (camera-projection camera))
-          (with-temp-transform context base-transform
-            (set-transform-identity! base-transform)
-            (apply-viewport (camera-viewport camera))
-            (%draw-group group base-transform view context)))))))
-
-;;;
-;;; Utility Procedures
-;;;
-
-(define (group . children)
-  "Create a new group containing the list of CHILDREN."
-  (make-group children))
-
-(define (group-move position group)
-  "Create a new group in which the list of CHILDREN are translated by
-the vector POSITION."
-  (match group
-    (($ <group> transform visible? children)
-     (%make-group (transform* transform (translate position))
-                  visible? children))))
-
-(define (group-place transform group)
-  "Create a new group in which the tranformation matrices of the
-CHILDREN are multiplied by TRANSFORM."
-  (match group
-    (($ <group> original-transform visible? children)
-     (%make-group (transform* original-transform transform)
-                  visible? children))))
-
-(define (group-show visible? group)
-  "Create a new group in which the visibility of the list of
-CHILDREN is determined by the VISIBLE? flag."
-  (match group
-    (($ <group> transform _ children)
-     (%make-group transform visible? children))))
diff --git a/sly/render/model.scm b/sly/render/model.scm
index b42dd64..01c1223 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -40,29 +40,35 @@
   #:use-module (sly render mesh)
   #:export (make-model model model-inherit
             model?
-            model-mesh model-texture model-shader model-color
-            model-blend-mode model-depth-test?
+            model-mesh model-transform model-texture model-shader model-color
+            model-blend-mode model-depth-test? model-children
             draw-model
-            model-paint model-blend))
+            paint blend group group* move place))
 
 ;; Representation of a single OpenGL render call.
 (define-record-type <model>
-  (%make-model mesh texture shader color blend-mode depth-test?)
+  (%make-model mesh transform texture shader color blend-mode
+               depth-test? children)
   model?
   (mesh model-mesh)
+  (transform model-transform)
   (texture model-texture)
   (shader model-shader)
   (color model-color)
   (blend-mode model-blend-mode)
-  (depth-test? model-depth-test?))
+  (depth-test? model-depth-test?)
+  (children model-children))
 
-(define* (make-model #:optional #:key (mesh #f) (texture #f) (shader #f)
-                     (color white) (blend-mode default-blend-mode)
-                     (depth-test? #t))
+(define* (make-model #:optional #:key (mesh null-mesh)
+                     (transform identity-transform) (texture null-texture)
+                     (shader (load-default-shader)) (color white)
+                     (blend-mode default-blend-mode) (depth-test? #t)
+                     (children '()))
   "Create a new model from MESH and the given rendering state.  When
 rendering, TEXTURE and SHADER are bound, BLEND-MODE and DEPTH-TEST?
 are set, and the COLOR uniform variable is set."
-  (%make-model mesh texture shader color blend-mode depth-test?))
+  (%make-model mesh transform texture shader color blend-mode
+               depth-test? children))
 
 (define model make-model)
 
@@ -90,35 +96,93 @@ changing the fields specified in KWARGS."
                             (struct-ref original index))))
                     fields field-indices))))))
 
-(define (draw-model model world-transform view context)
-  "Render MODEL by applying its transform (multiplied by VIEW), texture,
+(define (set-transform-identity! t)
+  (let ((matrix (transform-matrix t)))
+    (array-set! matrix 1 0 0)
+    (array-set! matrix 0 0 1)
+    (array-set! matrix 0 0 2)
+    (array-set! matrix 0 0 3)
+    (array-set! matrix 0 1 0)
+    (array-set! matrix 1 1 1)
+    (array-set! matrix 0 1 2)
+    (array-set! matrix 0 1 3)
+    (array-set! matrix 0 2 0)
+    (array-set! matrix 0 2 1)
+    (array-set! matrix 1 2 2)
+    (array-set! matrix 0 2 3)
+    (array-set! matrix 0 3 0)
+    (array-set! matrix 0 3 1)
+    (array-set! matrix 0 3 2)
+    (array-set! matrix 1 3 3)))
+
+(define draw-model
+  (let ((context (make-render-context)))
+    (lambda* (model camera #:optional (context context))
+      "Render MODEL by applying its transform (multiplied by VIEW), texture,
 shader, vertex array, uniforms, blend mode, etc. to the render
 CONTEXT."
-  (match model
-    (($ <model> mesh texture shader color blend-mode depth-test?)
-     (with-temp-transform context mvp
-       (transform*! mvp world-transform view)
-       (set-render-context-depth-test?! context depth-test?)
-       (set-render-context-blend-mode! context blend-mode)
-       (set-render-context-shader! context shader)
-       (set-render-context-mesh! context mesh)
-       (set-render-context-texture! context texture)
-       ;; TODO: Support user-defined uniforms.
-       (uniform-set! shader "mvp" mvp)
-       (uniform-set! shader "color" color)
-       (glDrawElements (begin-mode triangles)
-                       (mesh-length mesh)
-                       (data-type unsigned-int)
-                       %null-pointer)))))
+      (define (iter model world-transform view context)
+        (match model
+          (($ <model> mesh transform texture shader color blend-mode
+                      depth-test? children)
+           (with-temp-transform context new-transform
+             (transform*! new-transform transform world-transform)
+             (with-temp-transform context mvp
+              (transform*! mvp new-transform view)
+              (set-render-context-depth-test?! context depth-test?)
+              (set-render-context-blend-mode! context blend-mode)
+              (set-render-context-shader! context shader)
+              (set-render-context-mesh! context mesh)
+              (set-render-context-texture! context texture)
+              ;; TODO: Support user-defined uniforms.
+              (uniform-set! shader "mvp" mvp)
+              (uniform-set! shader "color" color)
+              (glDrawElements (begin-mode triangles)
+                              (mesh-length mesh)
+                              (data-type unsigned-int)
+                              %null-pointer))
+             (for-each (lambda (child)
+                         (iter child new-transform view context))
+                       children)))))
+
+      (with-render-context context
+        (with-temp-transform context view
+          (transform*! view
+                       (camera-location camera)
+                       (camera-projection camera))
+          (with-temp-transform context base-transform
+            (set-transform-identity! base-transform)
+            (apply-viewport (camera-viewport camera))
+            (iter model base-transform view context)))))))
 
 ;;;
 ;;; Utility Procedures
 ;;;
 
-(define (model-paint color model)
+(define (paint color model)
   "Create a copy of MODEL, but with a new COLOR."
   (model-inherit model #:color color))
 
-(define (model-blend blend-mode model)
+(define (blend blend-mode model)
   "Create a copy of MODEL, but with a new BLEND-MODE."
   (model-inherit model #:blend-mode blend-mode))
+
+(define (group . children)
+  "Create a new group containing the list of CHILDREN."
+  (make-model #:children children))
+
+(define (group* children)
+  "Create a new group containing the list of CHILDREN."
+  (make-model #:children children))
+
+(define (move position model)
+  "Create a new group in which the list of CHILDREN are translated by
+the vector POSITION."
+  (model-inherit model #:transform (transform* (model-transform model)
+                                               (translate position))))
+
+(define (place transform model)
+  "Create a new group in which the tranformation matrices of the
+CHILDREN are multiplied by TRANSFORM."
+  (model-inherit model #:transform (transform* (model-transform model)
+                                               transform)))