Skip to content

@nfunato /tofu.lisp
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
The "Retro" Tofu Shop Game in Iscandar
;;; -*- 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?")))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.