|
\ -*- Mode: Forth -*- |
|
\ Main program of the Tofu Shop Game in Iscandar |
|
\ |
|
\ Copyright (C) 1978-2012 for the original version by Nobuhide Tsuda |
|
\ See also http://vivi.dyndns.org/tofu/tofu.html for license |
|
\ |
|
\ Copyright (C) 2013,2019,2020 for this Forth version by Nobuhiko Funato, |
|
\ which is meant to be almost ANS94-compliant, and tested on gforth 0.7.0 |
|
\ and 0.7.3 (64bit word, Mac OSX). |
|
\ |
|
\ Usage on gforth: $ gforth prelude.fth tofu.fth |
|
\ |
|
\ Source files are prelude.fth, anew.fth, editor.fth, tofu_lib.fth, |
|
\ and tofu.fth. Typically they can be placed in the same directories |
|
\ for the usage above. The first three files are very short utilities, |
|
\ and non-essential for this application. |
|
\ |
|
\ prelude.fth just loads anew.fth and editor.fth |
|
\ anew.fth gives Wil Baden's utility word ANEW (need to be preloaded) |
|
\ editor.fth gives a word EDITOR which invokes an external editor vim |
|
\ tofu_lib.fth gives general (and non-app-oriented) utility words |
|
\ tofu.fth this file |
|
|
|
\ ToDo (from more important to less): |
|
\ - TWEAK GET-REAL-WEATHER TO REDUCE PROFIT MODERATELY |
|
\ - make get-com-plan' wiser |
|
|
|
\ Bugs |
|
\ - a small value might have no presence in .forecast-in-bar and .cash-bar, |
|
\ especially it tends to occur in the former, e.g. |
|
\ sunny/cloudy/rainy 6%,92%,2% => no rainy part |
|
|
|
ANEW --TOFU-- |
|
|
|
: this-file s" tofu.fth" ; |
|
' this-file is editor-target |
|
|
|
s" tofu_lib.fth" included \ quasi-general utilities |
|
|
|
\ =================================================================== |
|
\ local utilities |
|
|
|
: under-swap ( x y z -- y x z ) |
|
>r swap r> ; |
|
|
|
: tu~ck ( a b c -- c a b c ) |
|
-rot 2 pick ; |
|
|
|
: two-map/1 ( x y f -- fx fy ) |
|
tuck 2>r execute 2r> execute ; |
|
|
|
: two-map/2 ( x1 x2 y1 y2 f -- fx1x2 fy1y2 ) |
|
tu~ck >r 2>r execute 2r> r> execute ; |
|
|
|
: two-map/3 ( x1 x2 x3 y1 y2 y3 f -- fx1x2x3 fy1y2y3 ) |
|
-rot 2>r tuck 2>r execute 2r> 2r> rot execute ; |
|
|
|
: recover-1of3 ( x1 x2 total -- x1 x2 total-x1-x2 ) |
|
>r 2dup + r> swap - ; |
|
|
|
: recover-1of2 ( x1 total -- x1 total-x1 ) |
|
over - ; |
|
|
|
\ assume Bi ranges between 0 and 255 (so we need at-least 32bit word Forth) |
|
: pack3b ( b3 b2 b1 -- packed-num ) 256 * + 256 * + ; |
|
: unpack3b ( packed-num -- b3 b2 b1 ) 256 /mod 256 /mod ; |
|
|
|
\ =================================================================== |
|
\ Display utilities |
|
|
|
variable 'ms-count |
|
7 'ms-count ! |
|
: pauses ( u -- ) ?dup if 'ms-count @ * ms then ; |
|
: pause 1 pauses ; \ pause one unit of time |
|
|
|
\ slow-tty-mode |
|
variable 'slow-tty? |
|
'slow-tty? off |
|
: pauses' ( u -- ) 'slow-tty? @ if pauses else drop then ; |
|
: emit' ( x -- ) 'slow-tty? @ if pause then emit ; |
|
: type' ( ca u -- ) ?dup if bounds do i c@ emit' loop else drop then ; |
|
: .nchars ( n ch -- ) swap 0 ?do dup emit' loop drop ; |
|
|
|
\ the following three lines defines |
|
\ : ." ( "w" -- ) [char] " parse type' ; |
|
\ in gforth dependent way |
|
:noname '"' parse type' ; |
|
:noname '"' parse postpone sliteral postpone type' ; |
|
interpret/compile: ." |
|
|
|
\ =================================================================== |
|
\ Some explanations of the game |
|
|
|
: show-credit ( -- ) |
|
cr |
|
cr ." The Tofu Shop Game in Iscandar (ANS Forth Version)" |
|
cr ." Copyright (C) 1978-2012 for the original version by Nobuhide Tsuda" |
|
cr ." Copyright (C) 2013,2019,2020 for the Forth version by Nobuhiko Funato" |
|
cr ; |
|
|
|
: show-goal ( -- ) |
|
cr |
|
cr ." Welcome to the planet ISCANDAR !" |
|
cr ." You are the person who runs a tofu shop to make money for the" |
|
cr ." cost of returning your mother planet, the EARTH." |
|
cr ." (If you don't know well about ISCANDAR, you may want to see" |
|
cr ." http://en.wikipedia.org/wiki/Space_Battleship_Yamato_planets .)" |
|
cr ." But, on the other side of the street, there is the other shop run" |
|
cr ." by a computer. The goal of the game is to compete against the " |
|
cr ." computer for earning 30,000-yen sooner, necessary amount of money" |
|
cr ." to the EARTH. The cash for each initially starts from 5,000-yen." |
|
cr ." Here the cost price of a tofu is 40-yen, and the retail price of" |
|
cr ." a tofu is 50-yen. Daily sales depend on the weather, i.e. " |
|
cr ." upto 500 on sunny, upto 300 on cloudy, and upto 100 on rainy days." |
|
cr ." Tofu spoils rapidly, so unsold tofus in a day must be thrown away." |
|
cr ." Hence you should decide how many tofus you make for the next day, " |
|
cr ." with close watching the weather forecast for tomorrow." |
|
cr ; |
|
|
|
\ =================================================================== |
|
\ And the main logic of the game |
|
|
|
\ Some predefined money amounts |
|
40 constant $UNIT_COST_PRICE |
|
50 constant $UNIT_RETAIL_PRICE |
|
5000 constant $INITIAL_MAN_CASH |
|
5000 constant $INITIAL_COM_CASH |
|
30000 constant $SAVINGS_TARGET |
|
|
|
: continue-game? ( cash -- bool ) |
|
\ underflow means bankruptcy, overflow means goal |
|
1 $SAVINGS_TARGET within ; |
|
|
|
: clip-cash-range ( cash -- cash' ) |
|
\ normalize cash, for cash<=0 to 0 and for $MAX<=cash to $MAX |
|
\ (used in .CASH-BAR and COMPARE-CASH) |
|
>r 0 $SAVINGS_TARGET r> clip-int ; |
|
|
|
: max-tofus-to-make ( cash -- n ) |
|
\ make at least one tofu even insufficient budget, and then |
|
\ go into bankrupt at the next settlement |
|
$UNIT_COST_PRICE / 1 max ; |
|
|
|
: calculate-profit/loss ( stock sales-limit -- pl ) |
|
over >r ( stock sales-limit ; r: stock ) |
|
min $UNIT_RETAIL_PRICE m* \ get real sales proceeds |
|
r> $UNIT_COST_PRICE m* \ get sales cost, including unsold tofus |
|
\ (note: unsold tofus will be abandoned) |
|
d- d>s \ get profit or loss |
|
; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
enum Weather |
|
Weather SUNNY |
|
Weather CLOUDY |
|
Weather RAINY |
|
|
|
begin-structure weather% \ Forth200x spec. (not Gforth's) |
|
field: ->name |
|
field: ->mood |
|
field: ->sales-limit |
|
end-structure |
|
|
|
: weather-vec |
|
create ( #elems -- ) weather% * allot |
|
does> ( i -- aadr ) swap weather% * + ; |
|
|
|
3 weather-vec wv |
|
|
|
: ;; ( weather-idx name-cs mood-cs sales-limit -- ) |
|
3 roll wv >r |
|
r@ ->sales-limit ! r@ ->mood ! r> ->name ! ; |
|
|
|
:noname |
|
\ idx name mood sales-limit |
|
SUNNY c" sunny " c" \(^o^)/" 500 ;; |
|
CLOUDY c" cloudy" c" (~_~) " 300 ;; |
|
RAINY c" rainy " c" (;_;) " 100 ;; |
|
; execute |
|
|
|
: .weather-name ( weather -- ) wv ->name @ count type ; |
|
: .weather-mood ( weather -- ) wv ->mood @ count type ; |
|
: weather-sales-limit ( weather -- limit ) wv ->sales-limit @ ; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
: dot [char] . emit ; |
|
|
|
: .weather ( weather -- ) |
|
dup |
|
cr ." Today's weather is " |
|
99 80 70 3 0 do pauses' dot space loop |
|
85 pauses' .weather-name |
|
65 pauses' .weather-mood |
|
; |
|
|
|
: get-real-weather' ( rPr/cPr/sPr -- weather ) |
|
\ remake sPr at random |
|
unpack3b drop rand100 ( rPr cPr sPr' ) |
|
locals| sPr' cPr rPr | |
|
sPr' rPr <= if RAINY exit then |
|
sPr' rPr cPr + <= if CLOUDY exit then |
|
SUNNY |
|
; |
|
|
|
: get-real-weather ( rPr/cPr/sPr -- weather ) |
|
get-real-weather' dup .weather ; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
40 constant WEATHER_BAR_WIDTH |
|
|
|
: scale-xPr ( xPr -- scaled-xPr ) \ scale prob for bar |
|
>r WEATHER_BAR_WIDTH 100 r> scaling ; |
|
|
|
: scale-probs-for-bar ( rPr cPr sPr -- scaled-rPr scaled-cPr scaled-sPr ) |
|
drop \ regenerate sPr later as scaled-sPr |
|
['] scale-xPr two-map/1 |
|
WEATHER_BAR_WIDTH recover-1of3 ; |
|
|
|
\ need 'tweak' forecast-bar for the issue in Bugs ? |
|
: .forecast-in-bar ( rPr/cPr/sPr -- ) |
|
unpack3b scale-probs-for-bar |
|
cr 18 spaces [char] O .nchars [char] ^ .nchars [char] X .nchars ; |
|
|
|
: .forecast-in-percent ( rPr/cPr/sPr -- ) |
|
unpack3b |
|
cr ." Tomorrow weather: " |
|
." Sunny " 2 u.r |
|
." % , Cloudy " 2 u.r |
|
." % , Rainy " 2 u.r |
|
." %" ; |
|
|
|
: .forecast ( rPr/cPr/sPr -- ) |
|
dup .forecast-in-percent .forecast-in-bar ; |
|
|
|
: get-weather-forecast' ( -- rPr/cPr/sPr ) |
|
\ make Probabilities for Rainy, Sunny (that for Cloudy is implicit) |
|
rand100 rand100 2>r |
|
2r@ min \ rPr : (min pr1 pr2) |
|
100 2r> max - \ sPr : (- 100 (max pr1 pr2)) |
|
\ ( rPr sPr ) |
|
\ add cPr |
|
100 recover-1of3 swap |
|
pack3b ; |
|
|
|
: get-weather-forecast ( -- rPr/cPr/sPr ) |
|
get-weather-forecast' dup .forecast ; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
30 constant CASH_BAR_WIDTH |
|
|
|
: scale-cash ( cash -- scaled-cash ) \ scale cash for bar |
|
>r CASH_BAR_WIDTH $SAVINGS_TARGET r> scaling ; |
|
|
|
: scaled-cash/nocash ( cash -- scaled-cash scaled-nocash ) |
|
scale-cash CASH_BAR_WIDTH recover-1of2 ; |
|
|
|
: .cash-bar ( cash -- ) |
|
\ without the clipping, either of scaled amounts might be minus, |
|
\ which will be intepreted as a huge unsigned number by .nchars. |
|
clip-cash-range |
|
scaled-cash/nocash swap |
|
\ output '#' CASH-BAR and '-' NOCASH-BAR |
|
[char] # .nchars [char] - .nchars ; |
|
|
|
: .cash ( cash -- ) |
|
5 .r ." -yen " ; |
|
|
|
: .wallet ( cash -- ) |
|
dup .cash .cash-bar ; |
|
|
|
\ print the wallets somewhat visually |
|
: .wallets ( man-cash com-cash -- ) |
|
swap |
|
cr ." wallets: " |
|
cr ." man: " .wallet |
|
cr ." com: " .wallet |
|
cr |
|
; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
\ FIXME: introducing Bayesian estimation or such things someday :) |
|
: get-com-plan' ( rPr/cPr/sPr -- com-plan ) |
|
unpack3b nip |
|
locals| sPr rPr | |
|
50 sPr <= if 500 exit then |
|
30 rPr < if 100 exit then |
|
300 |
|
; |
|
|
|
: .com-plan ( com-plan -- ) |
|
cr ." Computer will make " . space ." tofus." ; |
|
|
|
: get-com-plan ( cash rPr/cPr/sPr -- com-plan ) |
|
get-com-plan' >r max-tofus-to-make r> min |
|
dup .com-plan ; |
|
|
|
: get-man-plan ( cash _rPr/cPr/sPr -- man-plan ) |
|
drop max-tofus-to-make >r |
|
c" How many tofus will you make?" 1 r> get-int-within-range ; |
|
|
|
\ ------------------------------------------------------------------- |
|
|
|
: both-continue? ( cash1 cash2 -- bool ) |
|
['] continue-game? two-map/1 and ; |
|
|
|
\ We can think of variables 'wf and 'rw as closure-variables, |
|
\ which make our program clear -- although they make it non-reentrant. |
|
|
|
variable 'wf \ weather-forecast |
|
: get-plan ( cash flg -- stock ) |
|
'wf @ swap if get-man-plan else get-com-plan then ; |
|
|
|
variable 'rw \ real-weather |
|
: update-cash ( cash stock -- cash' ) |
|
'rw @ weather-sales-limit calculate-profit/loss + ; |
|
|
|
variable 'day |
|
: play-one-game ( man-cash com-cash -- man-cash' com-cash' ) |
|
randomize |
|
1 'day ! |
|
begin |
|
2dup .wallets |
|
2dup both-continue? while |
|
\ sell-tofus-for-one-day |
|
2dup true false ( m c m c #t #f ) |
|
get-weather-forecast 'wf ! |
|
under-swap ['] get-plan two-map/2 ( m c m-stock c-stock ) |
|
cr cr ." * * * * * * Day " 'day @ 2 u.r ." * * * * * *" |
|
'wf @ get-real-weather 'rw ! |
|
under-swap ['] update-cash two-map/2 ( m' c' ) |
|
1 'day +! |
|
repeat ; |
|
|
|
: compare-cash ( man-cash com-cash -- ordering ) |
|
\ clip args, since it's a draw when both go bankrupt or when both goal |
|
['] clip-cash-range two-map/1 - sgn ; |
|
|
|
: main ( -- ) |
|
show-credit |
|
s" Do you want TheMatrix display mode?" y-or-n-p 'slow-tty? ! |
|
s" Do you want to read the rule of the game?" y-or-n-p if show-goal then |
|
begin |
|
$INITIAL_MAN_CASH $INITIAL_COM_CASH play-one-game |
|
compare-cash case |
|
LT of cr ." Computer win!" endof |
|
EQ of cr ." It is a draw." endof |
|
GT of cr ." You win!" endof |
|
abort" main" |
|
endcase |
|
s" Play another game?" yes-or-no-p while |
|
repeat ; |
