From 309fd1ac41cb1dffe65599743bf884871287e508 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 15 Dec 2022 09:06:47 -0500 Subject: First commit! --- .gitignore | 9 ++ Makefile.am | 25 +++ assets/CREDITS | 131 ++++++++++++++++ assets/images/cabbage.png | Bin 0 -> 1407 bytes assets/images/sunflower.png | Bin 0 -> 1199 bytes bootstrap | 3 + community-garden.scm | 362 ++++++++++++++++++++++++++++++++++++++++++++ community-garden/dummy.scm | 1 + configure.ac | 17 +++ guix.scm | 209 +++++++++++++++++++++++++ pre-inst-env.in | 10 ++ 11 files changed, 767 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile.am create mode 100644 assets/CREDITS create mode 100644 assets/images/cabbage.png create mode 100644 assets/images/sunflower.png create mode 100755 bootstrap create mode 100644 community-garden.scm create mode 100644 community-garden/dummy.scm create mode 100644 configure.ac create mode 100644 guix.scm create mode 100644 pre-inst-env.in diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fe8a487 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +/Makefile +/Makefile.in +/aclocal.m4 +/autom4te.cache/ +/build-aux/ +/config.log +/config.status +/configure +/pre-inst-env diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..a571bce --- /dev/null +++ b/Makefile.am @@ -0,0 +1,25 @@ +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +CLEANFILES = $(GOBJECTS) +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +SOURCES = \ + community-garden.scm diff --git a/assets/CREDITS b/assets/CREDITS new file mode 100644 index 0000000..97f89b8 --- /dev/null +++ b/assets/CREDITS @@ -0,0 +1,131 @@ +# Asset Credits + +## images/cabbage.png + +"[LPC] Crops" by bluecarrot16, Daniel Eddeland (daneeklu), Joshua Taylor, Richard Kettering (Jetrel). Commissioned by castelonia. License CC-BY-SA 3.0+ or GPL 3.0+. https://opengameart.org/content/lpc-crops + +BASED ON: + +[LPC] Farming tilesets, magic animations and UI elements +DE = Daniel Eddeland +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/rpg-item-set + +Fruit and Veggie Inventory +JT = Joshua Taylor +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/fruit-and-veggie-inventory + +RPG item set +RK = Richard Kettering (Jetrel) +CC0 +https://opengameart.org/content/rpg-item-set + +## images/sunflower.png + +https://opengameart.org/content/lpc-flowers-plants-fungi-wood + +"[LPC] Flowers / Plants / Fungi / Wood," by bluecarrot16, Guido Bos, Ivan Voirol (Silver IV), SpiderDave, William.Thompsonj, Yar, Stephen Challener and the Open Surge team (http://opensnc.sourceforge.net), Gaurav Munjal, Johann Charlot, Casper Nilsson, Jetrel, Zabin, Hyptosis, Surt, Lanea Zimmerman, George Bailey, ansimuz, Buch, and the Open Pixel Project contributors (OpenPixelProject.com). +CC-BY-SA 3.0. + +Based on: + +[LPC] Guido Bos entries cut up +Guido Bos +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/lpc-guido-bos-entries-cut-up + +Basic map 32x32 by Silver IV +Ivan Voirol (Silver IV) +CC-BY 3.0 / GPL 3.0 / GPL 2.0 +https://opengameart.org/content/basic-map-32x32-by-silver-iv + +Flowers +SpiderDave +CC0 +https://opengameart.org/content/flowers + +[LPC] Leaf Recolor +William.Thompsonj +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/lpc-leaf-recolor + +Isometric 64x64 Outside Tileset +Yar +CC-BY 3.0 +https://opengameart.org/content/isometric-64x64-outside-tileset + +32x32 (and 16x16) RPG Tiles--Forest and some Interior Tiles +Stephen Challener and the Open Surge team (http://opensnc.sourceforge.net)commissioned by Gaurav Munjal +CC-BY 3.0 +https://opengameart.org/content/32x32-and-16x16-rpg-tiles-forest-and-some-interior-tiles + +Lots of Hyptosis' tiles organized! +Hyptosis +CC-BY 3.0 +https://opengameart.org/content/lots-of-hyptosis-tiles-organized + +Generic Platformer Tiles +surt +CC0 +http://opengameart.org/content/generic-platformer-tiles + +old frogatto tile art +Guido Bos +CC0 +https://opengameart.org/content/old-frogatto-tile-art + +LPC: Interior Castle Tiles +Lanea Zimmerman +CC-BY-3.0 / GPL 3.0 +http://opengameart.org/content/lpc-interior-castle-tiles + +RPG item set +Jetrel +CC0 +https://opengameart.org/content/rpg-item-set + +Shoot'em up graphic kit +Johann Charlot +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/shootem-up-graphic-kit + +LPC C.Nilsson +Casper Nilsson +CC-BY-SA 3.0 / GPL 3.0 +https://opengameart.org/content/lpc-cnilsson + +Lots of trees and plants from OGA (DB32) tilesets pack 1 +Jetrel, Zabin, Hyptosis, Surt +CC0 +https://opengameart.org/content/lots-of-trees-and-plants-from-oga-db32-tilesets-pack-1 + +Trees & Bushes +ansimuz +CC0 +https://opengameart.org/content/trees-bushes + +Outdoor tiles, again +Buch +CC-BY 2.0 +https://opengameart.org/content/outdoor-tiles-again + +16x16 Game Assets +George Bailey +CC-BY 4.0 +https://opengameart.org/content/16x16-game-assets + +Tuxemon tileset +Buch +CC-BY-SA 3.0 +https://opengameart.org/content/tuxemon-tileset + +Orthographic outdoor tiles +Buch +CC0 +https://opengameart.org/content/orthographic-outdoor-tiles + +OPP2017 - Jungle and temple set +OpenPixelProject.com +CC0 +https://opengameart.org/content/opp2017-jungle-and-temple-set diff --git a/assets/images/cabbage.png b/assets/images/cabbage.png new file mode 100644 index 0000000..e01b67b Binary files /dev/null and b/assets/images/cabbage.png differ diff --git a/assets/images/sunflower.png b/assets/images/sunflower.png new file mode 100644 index 0000000..18634ed Binary files /dev/null and b/assets/images/sunflower.png differ diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..e756b42 --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#! /bin/sh + +autoreconf -vif diff --git a/community-garden.scm b/community-garden.scm new file mode 100644 index 0000000..f0429c9 --- /dev/null +++ b/community-garden.scm @@ -0,0 +1,362 @@ +(setenv "CATBIRD_DEV_MODE" "1") + +(use-modules (catbird) + (catbird asset) + (catbird camera) + (catbird kernel) + (catbird node) + (catbird node-2d) + (catbird region) + ((catbird scene) #:select ()) + (chickadee config) + (chickadee graphics color) + (chickadee graphics path) + (chickadee graphics text) + (chickadee graphics texture) + (chickadee math vector) + (chickadee scripting) + (goblins) + (goblins actor-lib cell) + (goblins actor-lib methods) + (goblins utils simple-sealers) + (goblins vrun) + (ice-9 atomic) + (ice-9 match) + (oop goops) + (srfi srfi-1) + (srfi srfi-9) + (srfi srfi-43)) + +(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-record-type + (make-plant name char) + plant? + (name plant-name) + (char plant-char)) + +(define sunflower (make-plant "Sunflower" #\S)) +(define cabbage (make-plant "Cabbage" #\C)) +(define winter-squash (make-plant "Winter Squash" #\W)) + +(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 + (%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))) + +(define (^botanist bcom) + (define-values (seal-plant unseal-plant approved-plant?) + (make-sealer-triplet)) + (methods + ((approve-plant plant) + (seal-plant plant)) + ((check-plant plant) + (if (approved-plant? plant) + (unseal-plant plant) + (error "plant is not allowed" plant))))) + +(define (^garden-guard bcom botanist) + (methods + ((check-plant plant) + ($ botanist 'check-plant plant)))) + +(define (^garden bcom name garden-bed garden-guard) + (define (ensure-empty x y) + (when (garden-bed-ref garden-bed x y) + (error "tile already has something planted in it" x y))) + (methods + ((get-name) name) + ((get-bed) garden-bed) + ((plant x y sealed-plant) + (ensure-empty x y) + (let* ((plant ($ garden-guard 'check-plant sealed-plant)) + (new-bed (garden-bed-set garden-bed x y plant))) + (bcom (^garden bcom name new-bed garden-guard)))) + ((dig-up x y) + (let ((new-bed (garden-bed-set garden-bed x y #f))) + (bcom (^garden bcom name new-bed garden-guard)))))) + +(define (^visitor bcom name garden) + (methods + ((get-name) name) + ((get-garden-name) + (<- garden 'get-name)) + ((inspect-garden) + (<- garden 'get-bed)))) + +(define (^gardener bcom name garden) + (methods + ((get-name) name) + ((get-garden-name) + (<- garden 'get-name)) + ((inspect-garden) + (<- garden 'get-bed)) + ((plant x y plant) + (<- garden 'plant x y plant)) + ((dig-up x y) + (<- garden 'dig-up x y)))) + +(define the-botanist (garden-run (spawn ^botanist))) +(define the-garden-guard (garden-run (spawn ^garden-guard 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-guard))) + +(define alice (alice-run (spawn ^gardener "Alice" our-garden))) +(alice-run ($ alice 'plant 1 1 sunflower/approved)) +(alice-run ($ alice 'plant 2 1 sunflower/approved)) +(alice-run ($ alice 'plant 1 2 sunflower/approved)) +(alice-run ($ alice 'plant 2 2 sunflower/approved)) +(alice-run ($ alice 'plant 5 1 cabbage/approved)) +(alice-run ($ alice 'plant 6 1 cabbage/approved)) +(alice-run ($ alice 'plant 5 2 cabbage/approved)) +(alice-run ($ alice 'plant 6 2 cabbage/approved)) + + +(define catbird-visitor (catbird-run (spawn ^visitor "Catbird UI" our-garden))) +(define catbird-garden-bed (make-atomic-box #f)) +(define catbird-garden-name (make-atomic-box #f)) +(catbird-run + (on ($ catbird-visitor 'get-garden-name) + (lambda (name) + (atomic-box-set! catbird-garden-name name)))) +(catbird-run + (on ($ catbird-visitor 'inspect-garden) + (lambda (garden-bed) + (atomic-box-set! catbird-garden-bed garden-bed)))) + +(define %window-width 1024) +(define %window-height 768) +(define %tile-width 64.0) +(define %tile-height 64.0) +(define font-file (scope-datadir "fonts/Inconsolata-Regular.otf")) +(define-asset (title-font (f font-file)) + (load-font f 24)) +(define-asset (plant-tile-font (f font-file)) + (load-font f 32)) +(define-asset (sunflower-texture (f "assets/images/sunflower.png")) + (load-image f)) +(define-asset (cabbage-texture (f "assets/images/cabbage.png")) + (load-image f)) + +(define-class () + (vat #:getter vat #:init-keyword #:vat) + (visitor #:getter visitor #:init-keyword #:visitor) + (name-box #:getter name-box #:init-keyword #:name-box) + (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 #())) + +(define (make-garden-view) + (make + #:rank 1 + #:vat catbird-vat + #:visitor catbird-visitor + #:name-box catbird-garden-name + #:garden-bed-box catbird-garden-bed)) + +(define-method (garden-bed (garden )) + (atomic-box-ref (garden-bed-box garden))) + +(define-method (garden-name (garden )) + (atomic-box-ref (name-box garden))) + +(define-method (on-boot (garden )) + (define title + (make