The "Retro" Tofu Shop Game in Iscandar

tofu.lisp

;;; -*- 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?")))