summaryrefslogtreecommitdiff
path: root/community-garden/edit.scm
blob: 01addd6169d40466c2c2ed4a42755ab1cee65f11 (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
(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))
  (while running?
    (match (read*)
      (('quit)
       (set! running? #f))
      (('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)))))