Basic combat

modules/grid.scm

@@ -0,0 +1,74 @@
+(module (bd grid) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	raylib
+	(imugi core)
+	(imugi drawing)
+	(imugi math)
+	(srfi 1)
+	(srfi 99))
+
+(export grid)
+(define (grid len wid default)
+  (define (iter i acc)
+    (if (= len i)
+	acc
+	(iter
+	 (+ 1 i)
+	 (cons (make-list wid default) acc))))
+  (iter 0 '()))
+
+(export gv)
+(define (gv grd x y)
+  (list-ref (list-ref grd y) x))
+
+(export gv!)
+(define (gv! grd x y val)
+  (set! (list-ref (list-ref grd y) x) val))
+
+(define (draw-grid-square offset width x y entity)
+  (let ((square-pos (v+ offset
+			(vec (* x width)
+			     (* y width)))))
+    (push-render-object
+     'screen
+     0
+     (lambda ()
+       (draw-rectangle-2d
+	square-pos
+	width
+	width
+	(cond
+	 ((eqv? entity 'player) (make-color 0 0 1 1))
+	 ((eqv? entity 'foe) (make-color 1 0 0 1))
+	 (else (make-color 0 0 0 1)))
+	(not (eqv? entity 'none))
+	2)))))
+
+(export draw-grid)
+(define draw-grid
+  (make-system
+   'draw-grid
+   10
+   'entity
+   '(<grid-view>)
+   (lambda (_ grid-view)
+     (let ((gd (grid-view-grid grid-view))
+	   (width (grid-view-width grid-view))
+	   (pos (grid-view-pos grid-view)))
+       (do ((i 0 (+ 1 i)))
+	   ((= i (length gd)) gd)
+	 (let ((row (list-ref gd i)))
+	   (do ((j 0 (+ 1 j)))
+	       ((= j (length row)) row)
+	     (draw-grid-square pos width i j (list-ref row j)))))))))
+
+(export grid-view grid-view-grid)
+(define-record-type <grid-view>
+  (grid-view start-pos gd width)
+  grid-view?
+  (start-pos grid-view-pos set-grid-view-pos!)
+  (gd grid-view-grid set-grid-view-grid!)
+  (width grid-view-width set-grid-view-width!))
+)