summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2022-12-18 11:35:54 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-01-06 16:00:25 -0500
commit4c032a6593bd2f9da87801c210351691010154ec (patch)
tree7ba6cfd4677a31676408ccec0c89e4d52b11318b
parent806e19f450497f62237240fe5a7596d521c3a137 (diff)
Just for fun: Now both host/join programs are graphical.
-rw-r--r--.gitignore3
-rw-r--r--Makefile.am4
-rw-r--r--community-garden.scm86
-rw-r--r--community-garden/actors.scm3
-rw-r--r--community-garden/edit.scm72
-rw-r--r--community-garden/garden-bed.scm13
-rw-r--r--community-garden/host.scm38
-rw-r--r--community-garden/join.scm20
-rw-r--r--community-garden/view.scm297
-rw-r--r--configure.ac3
-rw-r--r--guix.scm4
-rwxr-xr-xscripts/edit-garden.in6
-rwxr-xr-xscripts/host-garden.in6
-rwxr-xr-xscripts/join-garden.in6
14 files changed, 298 insertions, 263 deletions
diff --git a/.gitignore b/.gitignore
index 0893b41..258d17d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,4 +8,5 @@
/config.status
/configure
/pre-inst-env
-/scripts/edit-garden
+/scripts/host-garden
+/scripts/join-garden
diff --git a/Makefile.am b/Makefile.am
index a93a305..5776d5d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -26,5 +26,5 @@ SOURCES = \
community-garden/garden-bed.scm \
community-garden/actors.scm \
community-garden/view.scm \
- community-garden/edit.scm \
- community-garden.scm
+ community-garden/host.scm \
+ community-garden/join.scm
diff --git a/community-garden.scm b/community-garden.scm
index 6d6af5d..b570e01 100644
--- a/community-garden.scm
+++ b/community-garden.scm
@@ -22,89 +22,3 @@
(goblins ocapn netlayer onion)
(ice-9 atomic)
(oop goops))
-
-(define garden-vat (spawn-vat))
-(define catbird-vat (spawn-vat))
-(define alice-vat (spawn-vat))
-(define-vat-run garden-run garden-vat)
-(define-vat-run catbird-run catbird-vat)
-(define-vat-run alice-run alice-vat)
-(define the-botanist (garden-run (spawn ^botanist)))
-(define the-garden-gate (garden-run (spawn ^garden-gate the-botanist)))
-(define sunflower/approved
- (garden-run ($ the-botanist 'approve-plant sunflower)))
-(define cabbage/approved
- (garden-run ($ the-botanist 'approve-plant cabbage)))
-(define our-garden
- (garden-run
- (spawn ^garden
- "Spritely Institute Community Garden"
- (make-garden-bed 8 8)
- the-garden-gate)))
-(define our-garden-community
- (garden-run
- (spawn ^garden-community our-garden)))
-(define onion-netlayer (garden-run (new-onion-netlayer)))
-(define mycapn
- (garden-run
- (let* ((mycapn (spawn-mycapn onion-netlayer))
- (community-sref ($ mycapn 'register our-garden-community 'onion)))
- (format #t "Connect to: ~a\n" (ocapn-id->string community-sref))
- mycapn)))
-
-(define alice
- (alice-run (<- our-garden-community 'register-gardener "Alice")))
-(define (alice-plant x y plant)
- (alice-run (on alice
- (lambda (alice)
- (<- alice 'plant x y plant)))))
-
-(alice-plant 1 1 sunflower/approved)
-(alice-plant 2 1 sunflower/approved)
-(alice-plant 1 2 sunflower/approved)
-(alice-plant 2 2 sunflower/approved)
-(alice-plant 5 1 cabbage/approved)
-(alice-plant 6 1 cabbage/approved)
-(alice-plant 5 2 cabbage/approved)
-(alice-plant 6 2 cabbage/approved)
-
-(define catbird-visitor
- (catbird-run (<- our-garden-community 'register-gardener "Catbird Viewer")))
-(define catbird-garden-bed (make-atomic-box #f))
-(define catbird-garden-name (make-atomic-box #f))
-(catbird-run
- (on catbird-visitor
- (lambda (visitor)
- (on (<- visitor 'get-garden-name)
- (lambda (name)
- (atomic-box-set! catbird-garden-name name))))))
-
-(run-catbird
- (lambda ()
- (let ((region (create-full-region #:name 'main))
- (scene (make <scene> #:name 'scratch)))
- (replace-scene region scene)
- (replace-major-mode scene (make <garden-mode>))
- (set! (camera region)
- (make <camera-2d>
- #:width %window-width
- #:height %window-height))
- (attach-to scene
- (make <canvas>
- #:name 'background
- #:painter
- (with-style ((fill-color db32-elf-green))
- (fill
- (rectangle (vec2 0.0 0.0)
- %window-width
- %window-height))))
- (make <garden-view>
- #:name 'garden
- #:vat catbird-vat
- #:user catbird-visitor
- #:name-box catbird-garden-name
- #:garden-bed-box catbird-garden-bed
- #:read-only? #f))))
- #:title "Community Garden"
- #:width %window-width
- #:height %window-height)
diff --git a/community-garden/actors.scm b/community-garden/actors.scm
index 5146047..64d4e58 100644
--- a/community-garden/actors.scm
+++ b/community-garden/actors.scm
@@ -43,7 +43,8 @@
(error "tile already has something planted in it" x y)))
(methods
((get-name) name)
- ((get-bed) garden-bed)
+ ((get-bed)
+ (serialize-garden-bed garden-bed))
((get-approved-plants)
($ garden-gate 'get-approved-plants))
((plant gardener-name x y sealed-plant)
diff --git a/community-garden/edit.scm b/community-garden/edit.scm
deleted file mode 100644
index 0a7cc3d..0000000
--- a/community-garden/edit.scm
+++ /dev/null
@@ -1,72 +0,0 @@
-(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.
-
-\"Hope you like cabbage and sunflowers!\" - admin
-
-")
- (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)))))
diff --git a/community-garden/garden-bed.scm b/community-garden/garden-bed.scm
index 71cf6e6..f6a5dde 100644
--- a/community-garden/garden-bed.scm
+++ b/community-garden/garden-bed.scm
@@ -9,7 +9,8 @@
garden-bed-height
garden-bed-tiles
garden-bed-ref
- garden-bed-set))
+ garden-bed-set
+ serialize-garden-bed))
(define (list-replace lst i o)
(let loop ((j 0)
@@ -61,6 +62,16 @@
(garden-bed-height garden)
(bed-set (garden-bed-tiles garden) x y o)))
+(define (serialize-garden-bed garden)
+ (list (garden-bed-width garden)
+ (garden-bed-height garden)
+ (map (lambda (row)
+ (map (lambda (tile)
+ (and (plant? tile)
+ (plant-name tile)))
+ row))
+ (garden-bed-tiles garden))))
+
(define (display-garden-bed garden)
(for-each (lambda (row)
(for-each (lambda (tile)
diff --git a/community-garden/host.scm b/community-garden/host.scm
new file mode 100644
index 0000000..c2bc4a9
--- /dev/null
+++ b/community-garden/host.scm
@@ -0,0 +1,38 @@
+(define-module (community-garden host)
+ #:use-module (community-garden actors)
+ #:use-module (community-garden garden-bed)
+ #:use-module (community-garden plant)
+ #:use-module (community-garden view)
+ #:use-module (goblins)
+ #:use-module (goblins vrun)
+ #:use-module (goblins ocapn ids)
+ #:use-module (goblins ocapn captp)
+ #:use-module (goblins ocapn netlayer onion)
+ #:export (host-garden))
+
+(define (host-garden garden-name user-name)
+ (define garden-vat (spawn-vat))
+ (define user-vat (spawn-vat))
+ (define-vat-run garden-run garden-vat)
+ (define-vat-run user-run user-vat)
+ (define the-botanist (garden-run (spawn ^botanist)))
+ (define the-garden-gate (garden-run (spawn ^garden-gate the-botanist)))
+ (define sunflower/approved
+ (garden-run ($ the-botanist 'approve-plant sunflower)))
+ (define cabbage/approved
+ (garden-run ($ the-botanist 'approve-plant cabbage)))
+ (define our-garden
+ (garden-run
+ (spawn ^garden garden-name (make-garden-bed 8 8) the-garden-gate)))
+ (define our-garden-community
+ (garden-run
+ (spawn ^garden-community our-garden)))
+ (define user
+ (user-run (<- our-garden-community 'register-gardener user-name)))
+ (define onion-netlayer (garden-run (new-onion-netlayer)))
+ (define mycapn (garden-run (spawn-mycapn onion-netlayer)))
+
+ (garden-run
+ (let ((community-sref ($ mycapn 'register our-garden-community 'onion)))
+ (format #t "Connect to: ~a\n" (ocapn-id->string community-sref))))
+ (view-garden user-vat user))
diff --git a/community-garden/join.scm b/community-garden/join.scm
new file mode 100644
index 0000000..8e11aa2
--- /dev/null
+++ b/community-garden/join.scm
@@ -0,0 +1,20 @@
+(define-module (community-garden join)
+ #:use-module (community-garden actors)
+ #:use-module (community-garden view)
+ #: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 (join-garden))
+
+(define (join-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)))
+ (view-garden vat gardener))
diff --git a/community-garden/view.scm b/community-garden/view.scm
index ad93f45..9d7a2bb 100644
--- a/community-garden/view.scm
+++ b/community-garden/view.scm
@@ -1,10 +1,15 @@
(define-module (community-garden view)
+ #:use-module (catbird)
#:use-module (catbird asset)
+ #:use-module (catbird camera)
#:use-module (catbird input-map)
+ #:use-module (catbird kernel)
#:use-module (catbird mode)
#:use-module (catbird node)
#:use-module (catbird node-2d)
- #:use-module ((catbird scene) #:select (current-scene))
+ #:use-module (catbird region)
+ #:use-module ((catbird scene)
+ #:select (<scene> current-scene replace-major-mode))
#:use-module (chickadee config)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics path)
@@ -19,10 +24,7 @@
#:use-module (ice-9 match)
#:use-module (oop goops)
#:use-module (srfi srfi-43)
- #:export (%window-width
- %window-height
- <garden-view>
- <garden-mode>))
+ #:export (view-garden))
(define %window-width 1024)
(define %window-height 768)
@@ -38,6 +40,11 @@
(define-asset (cabbage-texture (f "assets/images/cabbage.png"))
(load-image f))
+(define-class <button> (<node-2d>)
+ (on-click #:accessor on-click
+ #:init-keyword #:on-click
+ #:init-value (const #t)))
+
(define-class <garden-tile> (<node-2d>)
(tile-x #:getter tile-x #:init-keyword #:tile-x)
(tile-y #:getter tile-y #:init-keyword #:tile-y))
@@ -49,6 +56,7 @@
(garden-bed-box #:getter garden-bed-box #:init-keyword #:garden-bed-box)
(prev-garden #:accessor prev-garden #:init-value #f)
(tiles #:accessor tiles #:init-value #())
+ (current-plant #:accessor current-plant #:init-value "Cabbage")
(read-only? #:getter read-only? #:init-keyword #:read-only? #:init-value #t))
(define-method (garden-bed (garden <garden-view>))
@@ -61,7 +69,7 @@
(define title
(make <label>
#:name 'name
- #:text (or (garden-name garden) "Untitled")
+ #:text "Connecting..."
#:font title-font
#:position (vec2 32.0 (- %window-height 72.0))))
(define tile-container
@@ -70,19 +78,69 @@
(set! (width garden) %window-width)
(set! (height garden) %window-height)
(attach-to garden title tile-container)
- (center-horizontal-in-parent title)
+ (center-horizontal-in-parent (& garden name))
(refresh-garden garden)
+ ;; Add buttons for selecting what to plant.
+ (let loop ((plants '("Cabbage" "Sunflower"))
+ (prev #f))
+ (match plants
+ (() #t)
+ ((plant . rest)
+ (let ((button (make <button>
+ #:on-click (lambda ()
+ (set! (current-plant garden) plant))))
+ (bg (make <canvas> #:name 'background))
+ (sprite (make <sprite>
+ #:name 'sprite
+ #:texture (plant->texture plant)
+ #:position (vec2 8.0 0.0)))
+ (label (make <label>
+ #:name 'label
+ #:text plant
+ #:font title-font))
+ (pad 8.0))
+ (set! (height button) 64.0)
+ (set! (width button)
+ (+ (* pad 3.0) (width sprite) (width label)))
+ (set! (painter bg)
+ (with-style ((fill-color db32-rope)
+ (stroke-color db32-oiled-cedar))
+ (fill-and-stroke
+ (rounded-rectangle (vec2 0.0 0.0)
+ (width button)
+ (height button)
+ #:radius 2.0))))
+ (attach-to button bg sprite label)
+ (center-vertical-in-parent sprite)
+ (center-vertical-in-parent label)
+ (place-right sprite label #:padding pad)
+ (if prev
+ (begin
+ (place-right prev button #:padding 32.0)
+ (align-bottom prev button))
+ (teleport button 32.0 32.0))
+ (attach-to garden button)
+ (loop rest button)))))
(run-script garden
(forever
- ((vat garden)
- (lambda ()
- (on (user garden)
- (lambda (user)
- (on (<- user 'inspect-garden)
- (lambda (garden-bed)
- (atomic-box-set! (garden-bed-box garden) garden-bed)))))))
+ ;; Do not start asking for the garden bed information until the
+ ;; name come across the network. This is a really hacky way of
+ ;; waiting until we've connected to the remote garden.
+ (when (atomic-box-ref (name-box garden))
+ (refresh-name garden)
+ ((vat garden)
+ (lambda ()
+ (on (user garden)
+ (lambda (user)
+ (on (<- user 'inspect-garden)
+ (lambda (garden-bed)
+ (atomic-box-set! (garden-bed-box garden) garden-bed))))))))
(sleep 0.5))))
+(define-method (refresh-name (garden <garden-view>))
+ (set! (text (& garden name)) (garden-name garden))
+ (center-horizontal-in-parent (& garden name)))
+
(define (for-each-tile proc tiles)
(vector-for-each
(lambda (y row)
@@ -98,71 +156,83 @@
(define-method (rebuild-tiles (garden <garden-view>))
(let ((g (garden-bed garden))
(container (& garden tile-container)))
- (for-each-tile
- (lambda (x y tile)
- (detach tile))
- (tiles garden))
- (set! (tiles garden)
- (vector-unfold
- (lambda (y)
+ (match g
+ ((bed-width bed-height bed-tiles)
+ (for-each-tile
+ (lambda (x y tile)
+ (detach tile))
+ (tiles garden))
+ (set! (tiles garden)
(vector-unfold
- (lambda (x)
- (let* ((painter (with-style ((fill-color db32-rope)
- (stroke-color db32-oiled-cedar))
- (fill-and-stroke
- (rectangle (vec2 0.0 0.0)
- %tile-width
- %tile-height))))
- (bg (make <canvas>
- #:name 'background
- #:painter painter))
- (sprite (make <sprite>
- #:name 'sprite
- #:texture null-texture))
- (tile (make <garden-tile>
- #:tile-x x
- #:tile-y y)))
- (set! (width tile) %tile-width)
- (set! (height tile) %tile-height)
- (attach-to tile bg sprite)
- (attach-to container tile)
- tile))
- (garden-bed-width g)))
- (garden-bed-height g)))
- (for-each-tile
- (lambda (x y tile)
- (if (= y 0)
- (set! (position-y tile) (* %tile-height (- (garden-bed-height g) 1)))
- (place-below (tile-ref garden x (- y 1)) tile))
- (unless (= x 0)
- (place-right (tile-ref garden (- x 1) y) tile)))
- (tiles garden))
- (set! (width container) (* (garden-bed-width g) %tile-width))
- (set! (height container) (* (garden-bed-height g) %tile-height))
- (center-in-parent container)))
+ (lambda (y)
+ (vector-unfold
+ (lambda (x)
+ (let* ((painter (with-style ((fill-color db32-rope)
+ (stroke-color db32-oiled-cedar))
+ (fill-and-stroke
+ (rectangle (vec2 0.0 0.0)
+ %tile-width
+ %tile-height))))
+ (bg (make <canvas>
+ #:name 'background
+ #:painter painter))
+ (sprite (make <sprite>
+ #:name 'sprite
+ #:texture null-texture))
+ (tile (make <garden-tile>
+ #:tile-x x
+ #:tile-y y)))
+ (set! (width tile) %tile-width)
+ (set! (height tile) %tile-height)
+ (attach-to tile bg sprite)
+ (attach-to container tile)
+ tile))
+ bed-width))
+ bed-height))
+ (for-each-tile
+ (lambda (x y tile)
+ (if (= y 0)
+ (set! (position-y tile)
+ (* %tile-height (- bed-height 1)))
+ (place-below (tile-ref garden x (- y 1)) tile))
+ (unless (= x 0)
+ (place-right (tile-ref garden (- x 1) y) tile)))
+ (tiles garden))
+ (set! (width container) (* bed-width %tile-width))
+ (set! (height container) (* bed-height %tile-height))
+ (center-in-parent container)))))
+
+(define (plant->texture plant)
+ (match plant
+ ("Cabbage" cabbage-texture)
+ ("Sunflower" sunflower-texture)
+ (_ null-texture)))
(define-method (refresh-garden (garden <garden-view>))
(let ((g (garden-bed garden))
(prev-g (prev-garden garden)))
- (unless (eq? g prev-g)
- (unless (and prev-g
- (= (garden-bed-width g) (garden-bed-width prev-g))
- (= (garden-bed-height g) (garden-bed-height prev-g)))
- (rebuild-tiles garden))
- (for-each-tile
- (lambda (x y tile)
- (let ((plant (garden-bed-ref g x y))
- (sprite (& tile sprite)))
- (set! (texture sprite)
- (if plant
- (match (plant-name plant)
- ("Cabbage" cabbage-texture)
- ("Sunflower" sunflower-texture)
- (_ null-texture))
- null-texture))
- (center-in-parent sprite)))
- (tiles garden))
- (set! (prev-garden garden) g))))
+ (match g
+ ((bed-width bed-height bed-tiles)
+ (unless (match prev-g
+ ((_ _ prev-tiles)
+ (equal? prev-tiles bed-tiles))
+ (_ #f))
+ (unless (match prev-g
+ ((prev-width prev-height _)
+ (and prev-width prev-height
+ (= bed-width prev-width)
+ (= bed-height prev-height)))
+ (_ #f))
+ (rebuild-tiles garden))
+ (for-each-tile
+ (lambda (x y tile)
+ (let ((plant (list-ref (list-ref bed-tiles y) x))
+ (sprite (& tile sprite)))
+ (set! (texture sprite) (plant->texture plant))
+ (center-in-parent sprite)))
+ (tiles garden))
+ (set! (prev-garden garden) g)))
+ (_ #f))))
(define-method (update (garden <garden-view>) dt)
(refresh-garden garden))
@@ -176,16 +246,17 @@
(if (string=? k name)
v
(loop rest))))))
- ((vat garden)
- (lambda ()
- (on (user garden)
- (lambda (user)
- (on (<- user 'get-approved-plants)
- (lambda (plants)
- (<- user 'plant
- (tile-x tile)
- (tile-y tile)
- (plant-ref plants "Cabbage")))))))))
+ (when (current-plant garden)
+ ((vat garden)
+ (lambda ()
+ (on (user garden)
+ (lambda (user)
+ (on (<- user 'get-approved-plants)
+ (lambda (plants)
+ (<- user 'plant
+ (tile-x tile)
+ (tile-y tile)
+ (plant-ref plants (current-plant garden)))))))))))
(define-method (dig-up-tile (garden <garden-view>) (tile <garden-tile>))
((vat garden)
@@ -199,19 +270,25 @@
(cond
((not node)
#f)
- ((is-a? node <garden-tile>)
+ ((or (is-a? node <garden-tile>)
+ (is-a? node <button>))
node)
((parent node)
- (find-tile (parent node)))))
+ (find-tile (parent node)))
+ (else #f)))
(find-tile (pick garden (vec2 x y) (lambda _ #t))))
(define-class <garden-mode> (<major-mode>))
-(define-method (do-plant (mode <garden-mode>) x y)
+(define-method (do-plant-or-select (mode <garden-mode>) x y)
(define garden (& (current-scene) garden))
- (define tile (garden-pick garden x y))
- (when (and tile (not (read-only? garden)))
- (plant-in-tile garden tile)))
+ (define node (garden-pick garden x y))
+ (cond
+ ((is-a? node <button>)
+ ((on-click node)))
+ ((is-a? node <garden-tile>)
+ (unless (read-only? garden)
+ (plant-in-tile garden node)))))
(define-method (do-dig (mode <garden-mode>) x y)
(define garden (& (current-scene) garden))
@@ -219,5 +296,43 @@
(when (and tile (not (read-only? garden)))
(dig-up-tile garden tile)))
-(bind-input <garden-mode> (mouse-press 'left) do-plant)
+(bind-input <garden-mode> (mouse-press 'left) do-plant-or-select)
(bind-input <garden-mode> (mouse-press 'right) do-dig)
+
+(define* (view-garden vat user #:key read-only?)
+ (define garden-bed-box (make-atomic-box #f))
+ (define garden-name-box (make-atomic-box #f))
+ (vat
+ (lambda ()
+ (on (<- user 'get-garden-name)
+ (lambda (name)
+ (atomic-box-set! garden-name-box name)))))
+ (run-catbird
+ (lambda ()
+ (let ((region (create-full-region #:name 'main))
+ (scene (make <scene> #:name 'scratch)))
+ (replace-scene region scene)
+ (replace-major-mode scene (make <garden-mode>))
+ (set! (camera region)
+ (make <camera-2d>
+ #:width %window-width
+ #:height %window-height))
+ (attach-to scene
+ (make <canvas>
+ #:name 'background
+ #:painter
+ (with-style ((fill-color db32-elf-green))
+ (fill
+ (rectangle (vec2 0.0 0.0)
+ %window-width
+ %window-height))))
+ (make <garden-view>
+ #:name 'garden
+ #:vat vat
+ #:user user
+ #:name-box garden-name-box
+ #:garden-bed-box garden-bed-box
+ #:read-only? read-only?))))
+ #:title "Community Garden"
+ #:width %window-width
+ #:height %window-height))
diff --git a/configure.ac b/configure.ac
index a5c4ae3..087dcde 100644
--- a/configure.ac
+++ b/configure.ac
@@ -7,7 +7,8 @@ AM_SILENT_RULES([yes])
AC_PATH_PROG([GUILE], [guile])
AC_CONFIG_FILES([Makefile])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
-AC_CONFIG_FILES([scripts/edit-garden], [chmod +x scripts/edit-garden])
+AC_CONFIG_FILES([scripts/host-garden], [chmod +x scripts/host-garden])
+AC_CONFIG_FILES([scripts/join-garden], [chmod +x scripts/join-garden])
GUILE_PKG([3.0])
GUILE_PROGS
diff --git a/guix.scm b/guix.scm
index 8d2bceb..93b2b77 100644
--- a/guix.scm
+++ b/guix.scm
@@ -178,11 +178,11 @@ Scheme. It contains all of the basic components needed to develop
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/spritely/guile-goblins.git")
- (commit "5bd72a910ea16ad6179a6de03e326527f29fad3e")))
+ (commit "9cbcd0614107e013aafea58fce0608f3b8baf635")))
(file-name (string-append name "-" version))
(sha256
(base32
- "1vp0d73nkzg9fkpd992irdbysdifdd0gf8jx01jhhiy216xv8hp9"))))))
+ "1k41gqd499q4vfpyzvk36syznn8k5qi7w6l8nq33z91g2bmqmz2v"))))))
(define %source-dir (dirname (current-filename)))
diff --git a/scripts/edit-garden.in b/scripts/edit-garden.in
deleted file mode 100755
index f01d312..0000000
--- a/scripts/edit-garden.in
+++ /dev/null
@@ -1,6 +0,0 @@
-#!@GUILE@ --no-auto-compile
--*- scheme -*-
-!#
-(use-modules (community-garden edit))
-
-(apply edit-garden (cdr (command-line)))
diff --git a/scripts/host-garden.in b/scripts/host-garden.in
new file mode 100755
index 0000000..55e8977
--- /dev/null
+++ b/scripts/host-garden.in
@@ -0,0 +1,6 @@
+#!@GUILE@ --no-auto-compile
+-*- scheme -*-
+!#
+(use-modules (community-garden host))
+
+(apply host-garden (cdr (command-line)))
diff --git a/scripts/join-garden.in b/scripts/join-garden.in
new file mode 100755
index 0000000..dedc262
--- /dev/null
+++ b/scripts/join-garden.in
@@ -0,0 +1,6 @@
+#!@GUILE@ --no-auto-compile
+-*- scheme -*-
+!#
+(use-modules (community-garden join))
+
+(apply join-garden (cdr (command-line)))