@program bowling.muf
1 10000 d
i
( Alynna's bowling daemon v2.0 )
$include $lib/alynna
$def notify_exclude ansi_notify_exclude
$def BOWLDIR "/~bowl/"
$def getstatint BOWLDIR swap strcat getpropval
$def setstat swap BOWLDIR swap strcat swap setprop
lvar firstball
lvar secondball
lvar tenthframe
lvar scoreboard
: initgame
{ 0 0 0 0 0 0 0 0 0 0 } array_make firstball !
{ 0 0 0 0 0 0 0 0 0 0 } array_make secondball !
{ 0 0 0 0 0 0 0 0 0 0 } array_make scoreboard !
0 tenthframe !
;
lvar skill
lvar chance
: genstatroll ( -- i )
( return 1 to 100 )
( 1d[80+perception+dexterity+[intelligence/3]]+1d[enhanced-senses+[athletics*1.5]+[ranged*2]+[mathmematics/3]+sqrt[total games bowled]] )
me @ "Perception" getstatint
me @ "Dexterity" getstatint + 
me @ "Intelligence" getstatint 3 / + skill !
me @ "Special/Enhanced-Senses" getstatint 
me @ "Athletics" getstatint 3 * 2 / +
me @ "Ranged" getstatint 2 * + 
me @ "Mathematics" getstatint 3 / + 
me @ "_bowldebug" getpropstr toint +
me @ "bgames" getstatint sqrt toint 3 * + chance !
0 random 80 skill @ + % + random chance @ % + dup 100 > if pop 100 then
;
lvar framenumber
lvar totalscore
: rollfirstball ( -- i )
( returns 1d10 on genstatroll/10 )
genstatroll 10 /
;
: rollsecondball ( -- i )
( returns 1d10-<firstball> on genstatroll/10 : second ball is harder than the first, less pins )
genstatroll 10 / dup firstball @ framenumber @ [] 10 swap - > if pop firstball @ framenumber @ [] 10 swap - then
;
: genscoreboard ( -- )
( me @ "rp/bgames/ball1" array_get_propvals array_vals firstball ! )
( me @ "rp/bgames/ball2" array_get_propvals array_vals secondball ! )
0 framenumber !
begin
framenumber @ 9 < if ( frames 1-9 ) 
 firstball @ framenumber @ [] ( add the first frame )
 secondball @ framenumber @ [] + ( to the second frame )
 dup 10 = if 
  secondball @ framenumber @ [] 0 = if ( strike ? )
   firstball @ framenumber @ 1 + [] + ( add the next frames first ball )
   ( is this a strike? )
   firstball @ framenumber @ 1 + [] 10 = if
    framenumber @ 8 < if ( are we checking into the 10th frame? )
     firstball @ framenumber @ 2 + [] + ( process turkey )
    else
     secondball @ framenumber @ 1 + [] + ( process turkey )
    then
   else
    secondball @ framenumber @ 1 + [] + ( add the next frames second ball )
   then
  else ( spare )
   firstball @ framenumber @ 1 + [] + ( add the next frames first ball )
  then
 then
 framenumber @ 0 > if ( frame 1-9, retrieve last score )
  scoreboard @ framenumber @ 1 - [] +
 then
 scoreboard @ framenumber @ array_setitem scoreboard !
else ( frame 10 )
 scoreboard @ framenumber @ 1 - []
 firstball @ framenumber @ [] + ( add the first frame )
 secondball @ framenumber @ [] + ( to the second frame )
 firstball @ framenumber @ [] secondball @ framenumber @ [] + 9 > if ( spare or strike )
  tenthframe @ + ( add the extra ball in the tenth frame )
 then
 scoreboard @ framenumber @ array_setitem scoreboard !
then
framenumber @ 1 + framenumber ! 
framenumber @ 9 > until
me @ "rp/bgames/scores" scoreboard @ array_put_propvals
str
0 framenumber ! begin
"^WHITE^"
framenumber @ 1 + intostr 4 rj
framenumber @ 1 + framenumber ! 
"^ ^ " 
(first 9 frames)
framenumber @ 9 > until
"    [" me @ "]" cat 0 parse_ansi 1 parse_ansi 2 parse_ansi 3 parse_ansi tellhere
str
0 framenumber ! begin
 firstball @ framenumber @ [] 10 = if ( strike )
  "^BRED^^WHITE^  ^BBLUE^^WHITE^ X" 
 then
 firstball @ framenumber @ [] 10 < if
  firstball @ framenumber @ [] secondball @ framenumber @ [] + 10 = if
  "^BRED^^WHITE^" firstball @ framenumber @ [] intostr 2 rj 
  "^BBLUE^^WHITE^ /"  
 then then
 firstball @ framenumber @ [] secondball @ framenumber @ [] + 10 < if 
  "^BRED^^WHITE^" firstball @ framenumber @ [] intostr 2 rj 
  "^BBLUE^^WHITE^" secondball @ framenumber @ [] intostr 2 rj 
 then
framenumber @ 1 + framenumber ! 
framenumber @ 10 < if "^ ^ " then
framenumber @ 8 > until
9 framenumber !
( handle 10th frame )
( ball 1 )
firstball @ framenumber @ [] 10 = if ( strike 1 )
 "^BRED^^WHITE^ X"
else 
 "^BRED^^WHITE^" firstball @ framenumber @ [] intostr 2 rj 
then
( ball 2 )  
secondball @ framenumber @ [] 10 = if ( strike 1 )
 "^BBLUE^^WHITE^ X"
else 
 firstball @ framenumber @ [] secondball @ framenumber @ [] + 10 = if
  "^BBLUE^^WHITE^ /"
 else
  "^BBLUE^^WHITE^" secondball @ framenumber @ [] intostr 2 rj 
 then
then
( ball 3 if spare or strike )
firstball @ framenumber @ [] secondball @ framenumber @ [] + 9 > if
 secondball @ framenumber @ [] 10 = if ( second ball was a strike )
  tenthframe @ 10 = if ( third was a strike )
   "^BRED^^WHITE^ X"
  else 
   "^BRED^^WHITE^" tenthframe @ intostr 2 rj 
  then
 else ( second ball was a spare )
  tenthframe @ 10 = if ( third was a spare )
   "^BRED^^WHITE^ X"
  else 
   "^BRED^^WHITE^" tenthframe @ intostr 2 rj 
  then
 then
else
 "^BRED^^WHITE^ -"
then
cat 0 parse_ansi 1 parse_ansi 2 parse_ansi 3 parse_ansi tellhere
str 
0 framenumber ! begin
"^BRED^^WHITE^"
scoreboard @ framenumber @ [] intostr 4 rj
framenumber @ 1 + framenumber ! 
framenumber @ 10 < if "^ ^ " else "  ^ ^" then
framenumber @ 9 > until
cat 0 parse_ansi 1 parse_ansi 2 parse_ansi 3 parse_ansi tellhere
;
: rollgame ( -- )
( fill the arrays with a valid game )
0 framenumber !
begin
str "[Bowl/" me @ "] Frame " framenumber @ 1 + ":  First ball ["
 rollfirstball firstball @ framenumber @ array_setitem firstball !
 firstball @ framenumber @ [] 10 = if "Strike!" else firstball @ framenumber @ [] then
 "]  Second ball [" 
 rollsecondball secondball @ framenumber @ array_setitem secondball !
 firstball @ framenumber @ [] secondball @ framenumber @ [] +
 10 = if "Spare!" else secondball @ framenumber @ [] then
 "]" cat pop
framenumber @ 1 + framenumber ! 
framenumber @ 8 > until
( bowl the 10th frame seperately )
9 framenumber !
rollfirstball firstball @ framenumber @ array_setitem firstball !
firstball @ framenumber @ [] 10 = if ( strike )
 rollfirstball secondball @ framenumber @ array_setitem secondball !
else
 rollsecondball secondball @ framenumber @ array_setitem secondball !
then
secondball @ framenumber @ [] 10 = if ( strike )
 rollfirstball tenthframe ! 
else
 rollsecondball tenthframe !
then
 
rollfirstball tenthframe !
me @ "rp/bgames/ball1" firstball @ array_put_propvals
me @ "rp/bgames/ball2" secondball @ array_put_propvals
me @ "rp/bgames/tenthframe" tenthframe @ setprop
me @ "bgames" getstatint 1 + me @ swap "bgames" swap setstat
genscoreboard
me @ "btotal" getstatint scoreboard @ 9 [] + me @ swap "btotal" swap setstat
scoreboard @ 9 [] me @ "bhigh" getstatint > if
 str "[Bowl] " me @ " has broken their previous high score!" cat tellhere
 me @ "bhigh" scoreboard @ 9 [] setstat
then
;
: statter
me @ "Perception" getstatint
me @ "Dexterity" getstatint + 
me @ "Intelligence" getstatint 3 / + skill !
me @ "Special/Enhanced-Senses" getstatint 
me @ "Athletics" getstatint 3 * 2 / +
me @ "Ranged" getstatint 2 * + 
me @ "Mathematics" getstatint 3 / + 
me @ "_bowldebug" getpropstr toint +
me @ "bgames" getstatint sqrt toint 3 * + chance !
str "[Bowl] " me @ " has earned " me @ "btotal" getstatint " points in " me @ "bgames" getstatint " games." cat tellme
str "[Bowl] " me @ "'s bowling average is [" me @ "btotal" getstatint me @ "bgames" getstatint / "]" cat tellme
str "[Bowl] " me @ "'s highest score ever is [" me @ "bhigh" getstatint "]" cat tellme
str "[Bowl] " me @ "'s stats cause a roll against the pins of 1d" skill @ 80 + "+1d" chance @ "." cat tellme
me @ "_bowldebug" getpropstr "" stringcmp if
 str "[Bowl] " me @ " is using a bowldebug of " me @ "_bowldebug" getpropstr " to tweak their bowling game." cat tellme
then
;
: helper
"Bowling v2.0 by Kisaragi Kitashi" tellme
"Just type 'bowl' to bowl a game.  Maximum score is 300." tellme
" bowl #stats - shows how many games you played and how many points you scored." tellme
"" tellme
"Bowling formula: 1d[80+perception+dexterity+[intelligence/3]]+1d[enhanced-senses+[athletics*1.5]+[ranged* 2]+[mathmematics/3]+[sqrt[total games bowled]*3]]/10 for pins knocked down." tellme
;
lvar arguments
: main ( s -- )
arguments !
arguments @ not if initgame rollgame exit then
arguments @ "#stats" instring if statter exit then 
arguments @ "#help" instring if helper exit then 
;
.
c
q