blob: 71cf6e65a379b146f53f2bf0b5d7208acb27457a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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)))
|
