1 files changed, 74 insertions, 0 deletions
diff --git a/community-garden/garden-bed.scm b/community-garden/garden-bed.scm
new file mode 100644
index 0000000..71cf6e6
--- /dev/null
+++ b/community-garden/garden-bed.scm
@@ -0,0 +1,74 @@
+(define-module (community-garden garden-bed)
+  #:use-module (community-garden plant)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (make-garden-bed
+            garden-bed?
+            garden-bed-width
+            garden-bed-height
+            garden-bed-tiles
+            garden-bed-ref
+            garden-bed-set))
+
+(define (list-replace lst i o)
+  (let loop ((j 0)
+             (lst lst))
+    (match lst
+      ((head . rest)
+       (if (= i j)
+           (cons o rest)
+           (cons head (loop (+ j 1) rest)))))))
+
+(define (make-empty-row width)
+  (make-list width #f))
+
+(define (make-empty-bed width height)
+  (list-tabulate height
+                 (lambda (_i)
+                   (make-empty-row width))))
+
+(define (bed-ref bed x y)
+  (list-ref (list-ref bed y) x))
+
+(define (bed-set bed x y o)
+  (list-replace bed y (list-replace (list-ref bed y) x o)))
+
+(define-record-type <garden-bed>
+  (%make-garden-bed width height tiles)
+  garden-bed?
+  (width garden-bed-width)
+  (height garden-bed-height)
+  (tiles garden-bed-tiles))
+
+(define (make-garden-bed width height)
+  (%make-garden-bed width height (make-empty-bed width height)))
+
+(define (bounds-check garden x y)
+  (unless (and (>= x 0)
+               (>= y 0)
+               (< x (garden-bed-width garden))
+               (< y (garden-bed-height garden)))
+    (error "garden tile out of bounds" x y)))
+
+(define (garden-bed-ref garden x y)
+  (bounds-check garden x y)
+  (bed-ref (garden-bed-tiles garden) x y))
+
+(define (garden-bed-set garden x y o)
+  (bounds-check garden x y)
+  (%make-garden-bed (garden-bed-width garden)
+                    (garden-bed-height garden)
+                    (bed-set (garden-bed-tiles garden) x y o)))
+
+(define (display-garden-bed garden)
+  (for-each (lambda (row)
+              (for-each (lambda (tile)
+                          (display
+                           (if (plant? tile)
+                               (plant-char tile)
+                               "."))
+                          (display " "))
+                        row)
+              (newline))
+            (garden-bed-tiles garden)))