garden.scm

   1 (import (chicken random)
   2         (chicken time)
   3         (chicken time posix)
   4         (chicken pathname)
   5         (chicken io)
   6         (chicken string)
   7         (chicken format)
   8         (chicken file)
   9         (chicken condition)
  10         srfi-1 uri-common simple-sha1)
  11
  12 (define rand-double pseudo-random-real)
  13
  14 (define (rand-weighted weights)
  15   (let* ((tot (apply + weights)))
  16     (let loop ((u (* (rand-double) tot))
  17                (rest weights)
  18                (idx 0))
  19       (if (null? rest)
  20           (error "Loop fell through")
  21           (let ((head (car rest)))
  22             (if (< u head)
  23                 idx
  24                 (loop (- u head)
  25                       (cdr rest)
  26                       (+ idx 1))))))))
  27
  28 (define (rand-choice l . weights)
  29   (list-ref l
  30             (if (null? weights)
  31                 (pseudo-random-integer (length l))
  32                 (rand-weighted weights))))
  33
  34 (define (make-garden user)
  35   `((user . ,user)
  36     (visits . 0)
  37     (created . ,(current-seconds))
  38     (age . 0)
  39     (last-updated . ,(current-seconds))
  40     (species . ,(rand-choice species))
  41     (colour . ,(rand-choice colours))
  42     (rarity . ,(rand-choice rarities 0.666666667 0.222222222 0.074074074 0.024691358 0.01234568))
  43     (last-watered . #f)
  44     (stage-idx . 0)))
  45
  46 (define (garden-prop p g)
  47   (cdr (assoc p g)))
  48
  49 (define (garden-prop-set! p v g)
  50   (alist-update! p v g))
  51
  52 (define (water-garden! g)
  53   (garden-prop-set! 'last-watered (current-seconds) g))
  54
  55 (define (garden-stage g)
  56   (let ((stage-idx (garden-prop 'stage-idx g)))
  57     (if (= stage-idx -1)
  58         'dead
  59         (list-ref stages stage-idx))))
  60
  61 (define (display-garden g)
  62   (let* ((idx (garden-prop 'stage-idx g))
  63          (basename (case idx
  64                      ((-1) "dead")
  65                      ((0) "seed")
  66                      ((1) "seedling")
  67                      (else
  68                       (conc (symbol->string (garden-prop 'species g)) (- (min idx 4) 1))))))
  69     (print (with-input-from-file (make-pathname "art" basename "txt") read-string))))
  70
  71 (define (describe-garden g)
  72   (let ((idx (garden-prop 'stage-idx g)))
  73     (cond
  74      ((= idx -1)
  75       (print (rand-choice (list-ref stage-descriptions (- (length stage-descriptions) 1)))))
  76      ((= idx 4)
  77       (print (format (rand-choice (list-ref stage-descriptions 4))
  78                      (garden-prop 'colour g)
  79                      (garden-prop 'species g))))
  80      (else
  81       (print (format (rand-choice (list-ref stage-descriptions idx))
  82                      (garden-prop 'species g))))')))
  83
  84 (define (display-water-level g)
  85   (let* ((last-watered (garden-prop 'last-watered g)))
  86     (if last-watered
  87         (let* ((now (current-seconds))
  88                (1day (* 24 3600))
  89                (remaining-pc (quotient (* 100 (max 0 (- 1day (- now last-watered)))) 1day))
  90                (filled (quotient remaining-pc 4))
  91                (unfilled (- 25 filled)))
  92           (print "["
  93                  (make-string filled #\~)
  94                  (make-string unfilled #\.)
  95                  "] " remaining-pc "%"))
  96         (print "[" (make-string 25 #\.) "]\n"
  97                "Your plant hasn't been watered!"))))
  98
  99 ;; Growth
 100
 101 (define (update-garden! g)
 102   (let* ((now (current-seconds))
 103          (created (garden-prop 'created g))
 104          (last-watered (garden-prop 'last-watered g)))
 105     (if (not last-watered)
 106         (if (> (- now created) (* 3600 24))
 107             (garden-prop-set! 'stage-idx -1 g))
 108         (let* ((time-since-last-watered (- now last-watered))
 109                (last-updated (garden-prop 'last-updated g))
 110                (1day (* 24 3600))
 111                (5days (* 5 1day))
 112                (growing-time (max (- (min now (+ last-watered 1day))
 113                                      last-updated)
 114                                   0)))
 115           (if (> time-since-last-watered 5days)
 116               (garden-prop-set! 'stage-idx -1 g)
 117               (let* ((new-age (+ (garden-prop 'age g) growing-time))
 118                      (new-stage-idx-raw (list-index (lambda (max-age) (> max-age new-age))
 119                                                     stage-transition-times))
 120                      (new-stage-idx (if new-stage-idx-raw
 121                                         new-stage-idx-raw
 122                                         (length stage-transition-times))))
 123                 (garden-prop-set! 'age new-age g)
 124                 (garden-prop-set! 'stage-idx new-stage-idx g)))))
 125     (garden-prop-set! 'last-updated now g)))
 126
 127
 128 ;;; Data
 129
 130 (define stage-transition-times
 131   ;; '(10 20 30 40 50)) ; for debugging
 132   (list (* 3600 24)
 133         (* 3600 24 3)
 134         (* 3600 24 10)
 135         (* 3600 24 20)
 136         (* 3600 24 30)))
 137
 138 (define stages
 139   '(seed seedling young mature flowering seed-bearing))
 140
 141 (define colours
 142   '(red orange yellow green blue indigo violet white black gold rainbow))
 143
 144 (define rarities
 145   '(common uncommon rare legendary godly))
 146
 147 (define species
 148   '(poppy
 149     cactus
 150     aloe
 151     venus\ flytrap
 152     jade\ plant
 153     fern
 154     daffodil
 155     sunflower
 156     baobab
 157     lithops
 158     hemp
 159     pansy
 160     iris
 161     agave
 162     ficus
 163     moss
 164     sage
 165     snapdragon
 166     columbine
 167     brugmansia
 168     palm
 169     pachypodium))
 170
 171
 172 (define mutation
 173   '(humming
 174     noxious
 175     vorpal
 176     glowing
 177     electric
 178     icy
 179     flaming
 180     psychic
 181     screaming
 182     chaotic
 183     hissing
 184     gelatinous
 185     deformed
 186     shaggy
 187     scaly
 188     depressed
 189     anxious
 190     metallic
 191     glossy
 192     psychedelic
 193     bonsai
 194     foamy
 195     singing
 196     fractal
 197     crunchy
 198     goth
 199     oozing
 200     stinky
 201     aromatic
 202     juicy
 203     smug
 204     vibrating
 205     lithe
 206     chalky
 207     naive
 208     ersatz
 209     disco
 210     levitating
 211     colossal
 212     luminous
 213     cosmic
 214     ethereal
 215     cursed
 216     buff
 217     narcotic
 218     gnu/linux
 219     abraxan))
 220
 221 (define stage-descriptions
 222   '(("You're excited about your new seed."
 223      "You wonder what kind of plant your seed will grow into."
 224      "You're ready for a new start with this plant."
 225      "You're tired of waiting for your seed to grow."
 226      "You wish your seed could tell you what it needs."
 227      "You can feel the spirit inside your seed."
 228      "These pretzels are making you thirsty."
 229      "Way to plant, Ann!"
 230      "'To see things in the seed, that is genius' - Lao Tzu")
 231
 232     ("The seedling fills you with hope."
 233      "The seedling shakes in the wind."
 234      "You can make out a tiny leaf - or is that a thorn?"
 235      "You can feel the seedling looking back at you."
 236      "You blow a kiss to your seedling."
 237      "You think about all the seedlings who came before it."
 238      "You and your seedling make a great team."
 239      "Your seedling grows slowly and quietly."
 240      "You meditate on the paths your plant's life could take.")
 241
 242     ("The ~A makes you feel relaxed."
 243      "You sing a song to your ~A."
 244      "You quietly sit with your ~A for a few minutes."
 245      "Your ~A looks pretty good."
 246      "You play loud techno to your ~A."
 247      "You play piano to your ~A."
 248      "You play rap music to your ~A."
 249      "You whistle a tune to your ~A."
 250      "You read a poem to your ~A."
 251      "You tell a secret to your ~A."
 252      "You play your favorite record for your ~A.")
 253
 254     ("Your ~A is growing nicely!"
 255      "You're proud of the dedication it took to grow your ~A."
 256      "You take a deep breath with your ~A."
 257      "You think of all the words that rhyme with ~A."
 258      "The ~A looks full of life."
 259      "The ~A inspires you."
 260      "Your ~A makes you forget about your problems."
 261      "Your ~A gives you a reason to keep going."
 262      "Looking at your ~A helps you focus on what matters."
 263      "You think about how nice this ~A looks here."
 264      "The buds of your ~A might bloom soon.")
 265
 266     ("The ~A flowers look nice on your ~A!"
 267      "The ~A flowers have bloomed and fill you with positivity."
 268      "The ~A flowers remind you of your childhood."
 269      "The ~A flowers remind you of spring mornings."
 270      "The ~A flowers remind you of a forgotten memory."
 271      "The ~A flowers remind you of your happy place."
 272      "The aroma of the ~A flowers energize you."
 273      "The ~A has grown beautiful ~A flowers."
 274      "The ~A petals remind you of that favorite shirt you lost."
 275      "The ~A flowers remind you of your crush."
 276      "You smell the ~A flowers and are filled with peace.")
 277
 278     ("You fondly remember the time you spent caring for your ~A."
 279      "Seed pods have grown on your ~A."
 280      "You feel like your ~A appreciates your care."
 281      "The ~A fills you with love."
 282      "You're ready for whatever comes after your ~A."
 283      "You're excited to start growing your next plant."
 284      "You reflect on when your ~A was just a seedling."
 285      "You grow nostalgic about the early days with your ~A.")
 286
 287     ("You wish you had taken better care of your plant."
 288      "If only you had watered your plant more often.."
 289      "Your plant is dead, there's always next time."
 290      "You cry over the withered leaves of your plant."
 291      "Your plant died. Maybe you need a fresh start.")))