From 7c5135bfa7e568f5ffe3c7feb53b0a8ea7cbe475 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 2 Sep 2018 22:12:27 -0400
Subject: math: Add grid module.

* chickadee/math/grid.scm: New file.
* examples/grid.scm: New file.
* Makefile.am (SOURCES): Add grid module.
(EXTRA_DIST): Add grid example.
---
 examples/grid.scm | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 87 insertions(+)
 create mode 100644 examples/grid.scm

(limited to 'examples/grid.scm')

diff --git a/examples/grid.scm b/examples/grid.scm
new file mode 100644
index 0000000..39ad50e
--- /dev/null
+++ b/examples/grid.scm
@@ -0,0 +1,87 @@
+(use-modules (chickadee)
+             (chickadee math grid)
+             (chickadee math vector)
+             (chickadee math rect)
+             (chickadee render)
+             (chickadee render color)
+             (chickadee render font)
+             (chickadee render shapes)
+             (chickadee render sprite)
+             (chickadee sdl)
+             (sdl2 input keyboard))
+
+(define font #f)
+(define grid (make-grid))
+(define item-color (make-color 0.7 0.0 0.0 0.5))
+(define cell-color (make-color 0.0 0.7 0.0 0.2))
+(define player-color (make-color 0.0 0.0 0.7 0.8))
+(define player-pos #v(32.0 32.0))
+(define player-speed 2)
+(define player-velocity #v(0.0 0.0))
+
+(define (load)
+  (set! font (load-font "fonts/good_neighbors_starling.xml"))
+  (grid-add grid 'wall-left 0 0 32 480)
+  (grid-add grid 'wall-top 32 448 576 32)
+  (grid-add grid 'wall-right 608 0 32 480)
+  (grid-add grid 'wall-bottom 32 0 576 32)
+  (grid-add grid 'box-1 100 100 100 50)
+  (grid-add grid 'box-2 300 300 50 100)
+  (grid-add grid 'box-3 350 150 200 75)
+  (grid-add grid 'box-4 150 140 130 75)
+  (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32))
+
+(define (update dt)
+  (set-vec2-x! player-velocity 0.0)
+  (set-vec2-y! player-velocity 0.0)
+  (when (key-pressed? 'up)
+    (set-vec2-y! player-velocity player-speed))
+  (when (key-pressed? 'down)
+    (set-vec2-y! player-velocity (- player-speed)))
+  (when (key-pressed? 'right)
+    (set-vec2-x! player-velocity player-speed))
+  (when (key-pressed? 'left)
+    (set-vec2-x! player-velocity (- player-speed)))
+  (vec2-add! player-pos player-velocity)
+  (grid-move grid 'player player-pos
+             (lambda (a b)
+               (if (eq? a 'player)
+                   slide
+                   #f))))
+
+(define %cell-rect
+  (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
+(define %cell-count-pos
+  #v(0.0 0.0))
+
+(define number->string*
+  (let ((cache (make-hash-table)))
+    (lambda (n)
+      (or (hashv-ref cache n)
+          (begin
+            (let ((s (number->string n)))
+              (hashv-set! cache n s)
+              s))))))
+
+(define (draw alpha)
+  (with-blend-mode 'alpha
+    (let ((size (grid-cell-size grid)))
+      (for-each-cell (lambda (cell x y)
+                       (set-rect-x! %cell-rect (* x size))
+                       (set-rect-y! %cell-rect (* y size))
+                       (draw-filled-rect %cell-rect cell-color))
+                     grid)
+      (with-batched-sprites
+       (for-each-cell (lambda (cell x y)
+                        (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
+                        (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
+                        (draw-text font (number->string* (cell-count cell))
+                                   %cell-count-pos))
+                      grid)))
+    (for-each-item (lambda (item rect)
+                     (if (eq? item 'player)
+                         (draw-filled-rect rect player-color)
+                         (draw-filled-rect rect item-color)))
+                   grid)))
+
+(run-game/sdl #:load load #:draw draw #:update update)
-- 
cgit v1.2.3