Initial commit

1 files changed, 223 insertions, 0 deletions

@@ -0,0 +1,223 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec csi -s $0 "$@"
+; POTATO: a one-file single-player RPG  ;
+; based on https://twitter.com/deathbybadger/status/1567425842526945280 ;
+; (a one-page single-player RPG by Oliver Darkshire) ;
+; NOTE: the game play will not work in Geiser! ;
+; ... something to do with (read-char) and Geiser injecting input.
+|#
+
+(import (chicken io)
+        (chicken random)
+        (chicken string))
+
+;;; Global variables
+
+(define destiny 0)
+(define potatoes 0)
+(define orcs 0)
+(define orc-cost 1)
+
+;;; Utilities
+
+(define (roll)
+  (+ 1 (pseudo-random-integer 6)))
+
+(define-syntax inc!
+  (syntax-rules ()
+    ((_ x) (begin (set! x (+ x 1)) x))
+    ((_ x n) (begin (set! x (+ x n)) x))))
+
+(define-syntax dec!
+  (syntax-rules ()
+    ((_ x) (begin (set! x (if (< (- x 1) 0) 0 (- x 1))) x))
+    ((_ x n) (begin (set! x (if (< (- x n) 0) 0 (- x n))) x))))
+
+;;; UI
+
+(define (prln . strs)
+  (apply string-append
+         (append (intersperse
+                  (map (lambda (s)
+                         (if (list? s)
+                             (apply string-append (map ->string s))
+                             (->string s)))
+                       strs)
+                  "\n")
+                 '("\n"))))
+
+(define (char-line c n)
+  (string-append (make-string n c)
+                   (make-string (- 10 n) #\-)))
+
+(define (scores)
+  (prln `("DESTINY  " ,(char-line #\* destiny))
+        `("POTATOES " ,(char-line #\o potatoes))
+        `("ORCS     " ,(char-line #\x orcs))))
+
+(define (display-columns a b)
+  (let loop ((a (string-split a "\n"))
+             (a-max 0)
+             (b (string-split b "\n")))
+    (cond
+     ((and (null? a) (null? b)) 'done)
+     ((null? a)
+      (display (make-string a-max #\space))
+      (display #\tab)
+      (display (car b))
+      (newline)
+      (loop '() a-max (cdr b)))
+     ((null? b)
+      (display (car a))
+      (newline)
+      (loop (cdr a)
+            (if (> (string-length (car a)) a-max)
+                (string-length (car a))
+                a-max)
+            '()))
+     (else
+      (display (car a))
+      (display #\tab)
+      (display (car b))
+      (newline)
+      (loop (cdr a)
+            (if (> (string-length (car a)) a-max)
+                (string-length (car a))
+                a-max)
+            (cdr b))))))
+
+;;; Gameplay
+
+(define (event)
+  (case (roll)
+    ((1 2)
+     (display (prln "You head out to the garden."))
+     (garden))
+    ((3 4)
+     (display (prln "You hear a knock at the door."))
+     (door))
+    ((5 6) (dangerous))))
+
+(define (garden)
+  (case (roll)
+    ((1)
+     (inc! potatoes)
+     (prln "You happily root about all day in your garden."))
+    ((2)
+     (inc! potatoes)
+     (inc! destiny)
+     (prln "You narrowly avoid a visitor by hiding in a potato sack."))
+    ((3)
+     (inc! destiny)
+     (inc! orcs)
+     (prln "A hooded stranger lingers outside your farm."))
+    ((4)
+     (inc! orcs)
+     (dec! potatoes)
+     (prln "Your field is ravaged in the night by unseen enemies."))
+    ((5)
+     (dec! potatoes)
+     (prln "You trade potatoes for other delicious foodstuffs."))
+    ((6)
+     (inc! potatoes 2)
+     (prln "You burrow into a bumper crop of potatoes."
+           "Do you cry with joy?  Possibly."))))
+
+(define (door)
+  (case (roll)
+    ((1)
+     (inc! orcs)
+     (prln "It's a distant cousin.  They are after your potatoes."
+           "They may snitch on you."))
+    ((2)
+     (inc! destiny)
+     (prln "It's a dwarven stranger.  You refuse them entry."
+           "Ghastly creatures."))
+    ((3)
+     (dec! orcs)
+     (inc! destiny)
+     (prln "A wizard strolls by."
+           "You pointedly draw the curtains."))
+    ((4)
+     (dec! potatoes)
+     (inc! orcs 2)
+     (prln "There are rumors of war in the reaches."
+           "You eat some potatoes."))
+    ((5)
+     (inc! destiny)
+     (prln "It's an elf."
+           "They are not serious people."))
+    ((6)
+     (inc! potatoes 2)
+     (prln "It's a sack of potatoes from a generous neighbor."
+           "You really must remember to to pay them a visit.."
+           "one of these years."))))
+
+(define (dangerous)
+  (inc! orc-cost)
+  (prln "The world has become a darker, more dangerous place."
+        `("[ Removing an ORC now takes " ,orc-cost " POTATOES. ]")))
+
+(define (game)
+  (set! destiny 0)
+  (set! potatoes 0)
+  (set! orcs 0)
+  (set! orc-cost 1)
+  (display (prln "You are a halfling, just trying to exist."
+                 "Meanwhile, the dark lord rampages across the world."
+                 "You do not care about this.  You are trying to farm potatoes."
+                 "What could a halfling possibly do about it, anyway?"
+                 ""
+                 "Press ENTER to begin."))
+  (read-char)
+  (case (turns)
+    ('potatoes
+     (display
+      (prln "You have enough potatoes to go underground until the danger is past."
+            "You nestle down into your burrow and enjoy your well-earned rest.")))
+    ('destiny
+     (let ((interloper (if (< (pseudo-random-real) 0.5)
+                           "wizard"
+                           "bard")))
+       (display
+        (prln `("An interfering " interloper " turns up at your doorstep with a quest."
+                "You are whisked away against your will on an adventure, where"
+                "you will probably be eaten by orcs.")))))
+    ('orcs
+     (display
+      (prln "Orcs have found your potato farm."
+            "Alas, orcs are not so interested in potatoes as they are in halfling flesh."
+            "You end up in a cookpot.")))))
+
+(define (turns)
+  (cond
+   ((>= potatoes 10) 'potatoes)
+   ((>= destiny 10) 'destiny)
+   ((>= orcs 10) 'orcs)
+   (else (let ((desc (event)))
+           (display-columns (scores) desc))
+         (newline)
+
+         (when (and (> orcs 0)
+                    (>= potatoes orc-cost))
+           (let ((es (if (> orc-cost 1) "ES" "")))
+             (display (prln `("You can hurl " ,orc-cost " POTATO" ,es
+                              " at an ORC to make them go away.")
+                            `("Press H to hurl POTATO" ,es ".")))))
+         (display "Press ENTER to advance.\n")
+
+         (case (char-downcase (read-char))
+          ((#\h)
+           (if (and (> orcs 0)
+                    (> potatoes orc-cost))
+               (begin (display "The ORC runs away.")
+                      (dec! potatoes orc-cost)
+                      (dec! orcs))
+               (display "You don't have enough POTATOES to hurl!")))
+          ;; (else => (lambda (c) (display c) (newline)))
+          )
+
+         (newline)
+         (read-buffered)
+         (turns))))