From fc94d84ac464e6c69b34240e0506ae59d3d90a13 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 7 Sep 2022 22:51:34 -0500 Subject: Initial commit --- potato.scm | 223 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100755 potato.scm diff --git a/potato.scm b/potato.scm new file mode 100755 index 0000000..68d0f2c --- /dev/null +++ b/potato.scm @@ -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)))) -- cgit 1.4.1-21-gabe81