blob: cfd3c44baeb5057500197a822bb65a62596342e5 (
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
|
(define-module (community-garden edit)
#:use-module (community-garden actors)
#:use-module (goblins)
#:use-module (goblins vrun)
#:use-module (goblins ocapn ids)
#:use-module (goblins ocapn captp)
#:use-module (goblins ocapn netlayer onion)
#:use-module (ice-9 match)
#:export (edit-garden))
(define (edit-garden name community-address)
(define community-sref (string->ocapn-id community-address))
(define vat (spawn-vat))
(define-vat-run vat-run vat)
(define onion-netlayer (vat-run (new-onion-netlayer)))
(define mycapn (vat-run (spawn-mycapn onion-netlayer)))
(define community-vow (vat-run ($ mycapn 'enliven community-sref)))
(define gardener (vat-run (<- community-vow 'register-gardener name)))
(define approved-plants-vow (vat-run (<- gardener 'get-approved-plants)))
(define running? #t)
(define (plant-ref plants name)
(let loop ((plants plants))
(match plants
(() #f)
(((k v) . rest)
(if (string=? k name)
v
(loop rest))))))
(define (read*)
(display "> ")
(read))
(format #t ">>> Community Garden Command Console <<<
Enter (help) for a list of commands.
")
(while running?
(match (read*)
(('quit)
(set! running? #f))
(('help)
(format #t "Available commands:
(get-garden-name) - display current garden name
(list-plants) - list available plant names
(dig-up x y) - dig up plant at tile (x, y)
(plant x y name) - plant at tile (x, y)
"))
(('get-garden-name)
(vat-run (on (<- gardener 'get-garden-name)
(lambda (name)
(format #t "Garden name: ~a\n"
name)))))
(('list-plants)
(vat-run
(on approved-plants-vow
(lambda (plants)
(for-each (match-lambda
((name _)
(format #t "~a\n" name)))
plants)))))
(('dig-up x y)
(format #t "dig up tile (~a, ~a)\n" x y)
(vat-run (<- gardener 'dig-up x y)))
(('plant x y name)
(format #t "plant in tile (~a, ~a)\n" x y)
(vat-run
(on approved-plants-vow
(lambda (plants)
(<- gardener 'plant x y (plant-ref plants name))))))
(exp
(format #t "unrecognized command: ~a\n" exp)))))
|