garden.scm

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