about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rwxr-xr-xpotato.scm223
1 files changed, 223 insertions, 0 deletions
diff --git a/potato.scm b/potato.scm new file mode 100755 index 0000000..68d0f2c --- /dev/null +++ b/potato.scm
@@ -0,0 +1,223 @@
1#!/bin/sh
2#| -*- scheme -*-
3exec csi -s $0 "$@"
4; POTATO: a one-file single-player RPG ;
5; based on https://twitter.com/deathbybadger/status/1567425842526945280 ;
6; (a one-page single-player RPG by Oliver Darkshire) ;
7; NOTE: the game play will not work in Geiser! ;
8; ... something to do with (read-char) and Geiser injecting input.
9|#
10
11(import (chicken io)
12 (chicken random)
13 (chicken string))
14
15;;; Global variables
16
17(define destiny 0)
18(define potatoes 0)
19(define orcs 0)
20(define orc-cost 1)
21
22;;; Utilities
23
24(define (roll)
25 (+ 1 (pseudo-random-integer 6)))
26
27(define-syntax inc!
28 (syntax-rules ()
29 ((_ x) (begin (set! x (+ x 1)) x))
30 ((_ x n) (begin (set! x (+ x n)) x))))
31
32(define-syntax dec!
33 (syntax-rules ()
34 ((_ x) (begin (set! x (if (< (- x 1) 0) 0 (- x 1))) x))
35 ((_ x n) (begin (set! x (if (< (- x n) 0) 0 (- x n))) x))))
36
37;;; UI
38
39(define (prln . strs)
40 (apply string-append
41 (append (intersperse
42 (map (lambda (s)
43 (if (list? s)
44 (apply string-append (map ->string s))
45 (->string s)))
46 strs)
47 "\n")
48 '("\n"))))
49
50(define (char-line c n)
51 (string-append (make-string n c)
52 (make-string (- 10 n) #\-)))
53
54(define (scores)
55 (prln `("DESTINY " ,(char-line #\* destiny))
56 `("POTATOES " ,(char-line #\o potatoes))
57 `("ORCS " ,(char-line #\x orcs))))
58
59(define (display-columns a b)
60 (let loop ((a (string-split a "\n"))
61 (a-max 0)
62 (b (string-split b "\n")))
63 (cond
64 ((and (null? a) (null? b)) 'done)
65 ((null? a)
66 (display (make-string a-max #\space))
67 (display #\tab)
68 (display (car b))
69 (newline)
70 (loop '() a-max (cdr b)))
71 ((null? b)
72 (display (car a))
73 (newline)
74 (loop (cdr a)
75 (if (> (string-length (car a)) a-max)
76 (string-length (car a))
77 a-max)
78 '()))
79 (else
80 (display (car a))
81 (display #\tab)
82 (display (car b))
83 (newline)
84 (loop (cdr a)
85 (if (> (string-length (car a)) a-max)
86 (string-length (car a))
87 a-max)
88 (cdr b))))))
89
90;;; Gameplay
91
92(define (event)
93 (case (roll)
94 ((1 2)
95 (display (prln "You head out to the garden."))
96 (garden))
97 ((3 4)
98 (display (prln "You hear a knock at the door."))
99 (door))
100 ((5 6) (dangerous))))
101
102(define (garden)
103 (case (roll)
104 ((1)
105 (inc! potatoes)
106 (prln "You happily root about all day in your garden."))
107 ((2)
108 (inc! potatoes)
109 (inc! destiny)
110 (prln "You narrowly avoid a visitor by hiding in a potato sack."))
111 ((3)
112 (inc! destiny)
113 (inc! orcs)
114 (prln "A hooded stranger lingers outside your farm."))
115 ((4)
116 (inc! orcs)
117 (dec! potatoes)
118 (prln "Your field is ravaged in the night by unseen enemies."))
119 ((5)
120 (dec! potatoes)
121 (prln "You trade potatoes for other delicious foodstuffs."))
122 ((6)
123 (inc! potatoes 2)
124 (prln "You burrow into a bumper crop of potatoes."
125 "Do you cry with joy? Possibly."))))
126
127(define (door)
128 (case (roll)
129 ((1)
130 (inc! orcs)
131 (prln "It's a distant cousin. They are after your potatoes."
132 "They may snitch on you."))
133 ((2)
134 (inc! destiny)
135 (prln "It's a dwarven stranger. You refuse them entry."
136 "Ghastly creatures."))
137 ((3)
138 (dec! orcs)
139 (inc! destiny)
140 (prln "A wizard strolls by."
141 "You pointedly draw the curtains."))
142 ((4)
143 (dec! potatoes)
144 (inc! orcs 2)
145 (prln "There are rumors of war in the reaches."
146 "You eat some potatoes."))
147 ((5)
148 (inc! destiny)
149 (prln "It's an elf."
150 "They are not serious people."))
151 ((6)
152 (inc! potatoes 2)
153 (prln "It's a sack of potatoes from a generous neighbor."
154 "You really must remember to to pay them a visit.."
155 "one of these years."))))
156
157(define (dangerous)
158 (inc! orc-cost)
159 (prln "The world has become a darker, more dangerous place."
160 `("[ Removing an ORC now takes " ,orc-cost " POTATOES. ]")))
161
162(define (game)
163 (set! destiny 0)
164 (set! potatoes 0)
165 (set! orcs 0)
166 (set! orc-cost 1)
167 (display (prln "You are a halfling, just trying to exist."
168 "Meanwhile, the dark lord rampages across the world."
169 "You do not care about this. You are trying to farm potatoes."
170 "What could a halfling possibly do about it, anyway?"
171 ""
172 "Press ENTER to begin."))
173 (read-char)
174 (case (turns)
175 ('potatoes
176 (display
177 (prln "You have enough potatoes to go underground until the danger is past."
178 "You nestle down into your burrow and enjoy your well-earned rest.")))
179 ('destiny
180 (let ((interloper (if (< (pseudo-random-real) 0.5)
181 "wizard"
182 "bard")))
183 (display
184 (prln `("An interfering " interloper " turns up at your doorstep with a quest."
185 "You are whisked away against your will on an adventure, where"
186 "you will probably be eaten by orcs.")))))
187 ('orcs
188 (display
189 (prln "Orcs have found your potato farm."
190 "Alas, orcs are not so interested in potatoes as they are in halfling flesh."
191 "You end up in a cookpot.")))))
192
193(define (turns)
194 (cond
195 ((>= potatoes 10) 'potatoes)
196 ((>= destiny 10) 'destiny)
197 ((>= orcs 10) 'orcs)
198 (else (let ((desc (event)))
199 (display-columns (scores) desc))
200 (newline)
201
202 (when (and (> orcs 0)
203 (>= potatoes orc-cost))
204 (let ((es (if (> orc-cost 1) "ES" "")))
205 (display (prln `("You can hurl " ,orc-cost " POTATO" ,es
206 " at an ORC to make them go away.")
207 `("Press H to hurl POTATO" ,es ".")))))
208 (display "Press ENTER to advance.\n")
209
210 (case (char-downcase (read-char))
211 ((#\h)
212 (if (and (> orcs 0)
213 (> potatoes orc-cost))
214 (begin (display "The ORC runs away.")
215 (dec! potatoes orc-cost)
216 (dec! orcs))
217 (display "You don't have enough POTATOES to hurl!")))
218 ;; (else => (lambda (c) (display c) (newline)))
219 )
220
221 (newline)
222 (read-buffered)
223 (turns))))