public
Last active

The "Retro" Tofu Shop Game in Iscandar

  • Download Gist
tofu.lisp
Common Lisp
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
;;; -*- Mode: Lisp -*-
 
;;; The Tofu Shop Game in Iscandar
;;; Copyright (C) 1978-2012 by Nobuhide Tsuda
;;; (see also http://vivi.dyndns.org/tofu/tofu.html)
;;;
;;; Revision History:
;;; 1978 Design & Implemented by Nobuhide Tuda (ntsuda at beam.ne.jp),
;;; as a sort of business strategy simulation game, assuming
;;; MC6800(1MHz) and RAM 4-32K bytes w/o secondary storage
;;; as a typical target environment.
;;; 2000? Perl version by Keiichiroh Nagano (gano at is.s.u-tokyo.ac.jp).
;;; TheMatrix mode is also added at that time.
;;; 2012 CL version from Perl version by Shozo Takeoka (take at takeoka.net).
;;; 2012 This version: revised by @nfunato from Mr. Takeoka's version,
;;; http://www.takeoka.org/~take/ailabo/gcl/tofu.lisp (in UTF-8).
;;; As for license, it should follow the same policy specified in
;;; http://vivi.dyndns.org/tofu/tofu.html.
;;;
;;; Usage:
;;; Just load this file and execute the function MAIN w/o args.
 
;;; Environmental settings
 
(defvar *tofu-locale* :english ; :english or :japanese
"Current locale -- TODO: backport Mr. Takeoka's japanese version.")
 
(defparameter *millisleep-count*
#+sbcl 9
#+ccl 10
#+clisp 0.5
#-(or sbcl ccl clisp) 1
)
 
(defparameter *activate-post-disp-pause-p* t)
 
;;; General utilities
 
(defun millisleep (x)
(sleep (/ x 1000)))
 
(defun post-disp-pause (nunit)
(when *activate-post-disp-pause-p*
(millisleep (* nunit *millisleep-count*))))
 
(defmacro awhen (test &body body)
`(let ((it ,test)) (when it ,@body)))
 
(defmacro aprog1 (expr . rest-exprs)
`(let ((it ,expr)) (progn ,@rest-exprs) it))
 
(defun make-str (n ch)
(make-string n :initial-element ch))
 
(defvar *tofu-random-state* (make-random-state t))
 
(defun rand100 ()
"Return randomized integer in [0,100], i.e. the both ends inclusive."
(random 101 *tofu-random-state*))
 
;;; Display text utility which support TheMatrix mode
 
(defvar *slow-tty-mode-p* t
"If non-nil, output by #'disp is done slowly as in TheMatrix.")
 
(defun toggle-slow-tty-mode-p ()
"Currently this toggle can be called during inquiry as to the number of tofu."
(setq *slow-tty-mode-p* (not *slow-tty-mode-p*)))
 
(defun disp (fmt &rest args)
"Display a given string according to *slow-tty-mode-p* setting."
(flet ((princ-n-flush (x) (princ x) (finish-output)))
(let ((str (with-output-to-string (st) (apply #'format st fmt args))))
(if (not *slow-tty-mode-p*)
(princ-n-flush str)
(loop for ch across str
do (princ-n-flush ch)
do (millisleep *millisleep-count*))))))
 
(defun get-limited-int (low high &optional msg)
"Input an integer from console. You can answer :tty for changing tty-mode."
(flet ((prompt () (disp "~a (~d--~d) " msg low high) (finish-output)))
(loop
(when msg (prompt))
(let ((n (read)))
(cond ((and (integerp n)
(<= low n high)) (return n))
((eql n :tty) (toggle-slow-tty-mode-p)))))))
 
;;; Some explanations of the game
 
(defun show-credit ()
(format t "~:
The Tofu Shop Game in Iscandar (Common Lisp Version)
Copyright (C) 1978-2012 by Nobuhide Tsuda
Port to Perl and add TheMatrix mode by Keiichiroh Nagano
Port to CL by Shozo Takeoka
This Revised CL version by Nobuhiko Funato~2%"))
 
(defun disp-goal ()
"Display the goal of the game."
(disp "~%~:
Welcome to the planet ISCANDAR !~%
You are the person who runs a tofu shop to make money for the cost of
returning your mother planet, the EARTH.
(If you don't know well about ISCANDAR, you may want to see
http://en.wikipedia.org/wiki/Space_Battleship_Yamato_planets .)~%
But, on the other side of the street, there is the other shop run
by a computer. The goal of the game is to compete against the
computer for earning 30,000-yen sooner, necessary amount of money
to the EARTH. The cash for each initially starts from 5,000-yen.~%
Here the cost price of a tofu is 40-yen, and the retail price of a
tofu is 50-yen. Daily sales depend on the weather, i.e.
upto 500 on sunny, upto 300 on cloudy, and upto 100 on rainy days.~%
Tofu spoils rapidly, so unsold tofus in a day must be thrown away.
Hence you should decide how many tofus you make for the next day,
with close watching the weather forecast for tomorrow.~2%"))
 
;;; domain knowledge, i.e the parameters embedded in the game rule
 
(defparameter *start-cash-of-you* 5000)
(defparameter *start-cash-of-com* 5000)
(defparameter *saving-target* 30000)
 
(defun sold-upto (weather)
(ecase weather (:sunny 500) (:cloudy 300) (:rainy 100)))
 
(defparameter *unit-retail-price* 50)
(defparameter *unit-cost-price* 40)
 
(defun profit (prepared-stock sold-upto)
"Calculate profit."
(let ((sold (min prepared-stock sold-upto)))
(- (* *unit-retail-price* sold)
;; subtract cost for all stock, for all unsold items will be abandoned
(* *unit-cost-price* prepared-stock))))
 
;;; Essential descriptions of the game
 
(defun disp-money (you com)
(flet ((disp-money-with-bar (name cash)
(multiple-value-bind (money no-money)
(let ((c/1k (floor cash 1000)))
(values (make-str c/1k #\#)
(make-str (max 0 (- 30 c/1k)) #\-)))
(disp " ~a: ~5d-yen ~a~a~%" name cash money no-money))))
(disp "Fundage:~%")
(disp-money-with-bar "you" you)
(disp-money-with-bar "com" com)))
 
(defun winner (you com &aux (st *saving-target*))
;; zerop tests might be redundant ...
(cond ((and (<= st you) (<= st com)) :draw)
((and (zerop you) (zerop com)) :draw)
((or (<= st you) (zerop com)) :you)
((or (<= st com) (zerop you)) :com)
(t nil)))
 
(defun make-forecast (sunny cloudy rainy)
(list sunny cloudy rainy))
 
(defmacro with-forecast ((s c r) &body body)
`(destructuring-bind (,s ,c ,r) ,@body))
 
(defun get-weather-forecast (&aux (pr1 (rand100)) (pr2 (rand100)))
(let* ((sunny (- 100 (max pr1 pr2)))
(rainy (min pr1 pr2))
(cloudy (- 100 sunny rainy)))
(make-forecast sunny cloudy rainy)))
 
(defun disp-forecast (forecast)
(with-forecast (sunny cloudy rainy) forecast
(flet ((scaling (centile) (floor (* centile 10) 25)))
(let* ((slen (scaling sunny))
(clen (scaling cloudy))
(rlen (- (scaling 100) slen clen)))
(disp "~%Tomorrow weather: ~
Sunny ~2d% , Cloudy ~2d% , Rainy ~2d%~%"
sunny cloudy rainy)
(disp " ~a~a~a~2%"
(make-str slen #\O) (make-str clen #\^) (make-str rlen #\X))
forecast))))
 
(defun ask-your-plan (you forecast &aux (limit (floor you 40)))
(declare (ignore forecast))
(get-limited-int 1 limit "How many tofus you will make?"))
 
(defun disp-computer-plan (com forecast &aux (limit (floor com 40)))
(with-forecast (sunny cloudy rainy) forecast
(declare (ignore cloudy))
(aprog1
;; TODO?: introduce Bayesian estimation or such things
(min limit
(cond ((<= 50 sunny) 500)
((< 30 rainy) 100)
(t 300)))
(disp "Computer will make ~d tofus.~%" it))))
 
(defun get-next-weather (forecast &aux (r (rand100)))
(with-forecast (sunny cloudy rainy) forecast
(declare (ignore sunny))
(cond ((<= r rainy) :rainy)
((<= r (+ rainy cloudy)) :cloudy)
(t :sunny))))
 
(defun get-mood (weather)
(ecase weather (:sunny "\\(^o^)/") (:cloudy "(~_~)") (:rainy "(;_;)")))
 
(defun disp-weather (weather &aux (mood (get-mood weather)))
(disp "Today's weather is ")
(post-disp-pause 60)
(dolist(i '(80 80 110))
(disp ". ")
(post-disp-pause i))
(disp " ~a " weather)
(finish-output)
(post-disp-pause 50)
(disp " ~a~%" mood))
 
(defun tofu (&optional (you0 *start-cash-of-you*) (com0 *start-cash-of-com*))
"the main loop of the game."
(labels ((one-day-session (nth-day you com)
(disp-money you com)
(awhen (winner you com) (return-from tofu it))
 
(let* ((forecast (disp-forecast (get-weather-forecast)))
(your-plan (ask-your-plan you forecast))
(com-plan (disp-computer-plan com forecast)))
(post-disp-pause 20)
 
(disp "~%* * * * * * Day ~2d * * * * * *~%" nth-day)
(let* ((weather (get-next-weather forecast))
(sold-upto (sold-upto weather)))
(disp-weather weather)
(disp "Tofus are sold up to ~a !~2%" sold-upto)
(post-disp-pause 20)
 
(one-day-session (1+ nth-day)
(+ you (profit your-plan sold-upto))
(+ com (profit com-plan sold-upto)))))))
(one-day-session 1 you0 com0)))
 
(defun main ()
(show-credit)
(setq *slow-tty-mode-p*
(y-or-n-p "Do you want TheMatrix display mode?"))
(if (y-or-n-p "Do you want to read the rule of the game?")
(disp-goal)
(disp "~%"))
(loop for winner = (tofu)
do (ecase winner
(:draw (disp "It is a draw."))
(:you (disp "You win!"))
(:com (disp "Computer win!")))
while (yes-or-no-p "Play another game?")))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.