@prog yahtzee.muf 1 9999 d 1 i ( This version is full of kludges to support Flux's MUF...no loops, not even tolower... ) : tolower "a" "A" subst "b" "B" subst "c" "C" subst "d" "D" subst "e" "E" subst "f" "F" subst "g" "G" subst "h" "H" subst "i" "I" subst "j" "J" subst "k" "K" subst "l" "L" subst "m" "M" subst "n" "N" subst "o" "O" subst "p" "P" subst "q" "Q" subst "r" "R" subst "s" "S" subst "t" "T" subst "u" "U" subst "v" "V" subst "w" "W" subst "x" "X" subst "y" "Y" subst "z" "Z" subst ; : obj trigger @ location ; : yp-prefix "% " ; : yp-bonus-point 63 ; : yp-bonus-amount 35 ; : yp-p "_yprop-p-" swap intostr strcat ; : -yp-# "_yprop-" swap intostr strcat "-" strcat ; : -yp-3kind "_yprop-3kind-" ; : -yp-4kind "_yprop-4kind-" ; : -yp-fh "_yprop-fh-" ; : -yp-ss "_yprop-ss-" ; : -yp-ls "_yprop-ls-" ; : -yp-chance "_yprop-chance-" ; : -yp-yahtzee "_yprop-yahtzee-" ; : -yp-top-sum "_yprop-top-sum-" ; : -yp-top-par "_yprop-top-par-" ; : -yp-top-bonus "_yprop-top-bonus-" ; : -yp-bottom-sum "_yprop-bottom-sum-" ; : -yp-total-sum "_yprop-total-sum-" ; : yp-# -yp-# swap intostr strcat ; : yp-3kind -yp-3kind swap intostr strcat ; : yp-4kind -yp-4kind swap intostr strcat ; : yp-fh -yp-fh swap intostr strcat ; : yp-ss -yp-ss swap intostr strcat ; : yp-ls -yp-ls swap intostr strcat ; : yp-chance -yp-chance swap intostr strcat ; : yp-yahtzee -yp-yahtzee swap intostr strcat ; : yp-top-sum -yp-top-sum swap intostr strcat ; : yp-top-par -yp-top-par swap intostr strcat ; : yp-top-bonus -yp-top-bonus swap intostr strcat ; : yp-bottom-sum -yp-bottom-sum swap intostr strcat ; : yp-total-sum -yp-total-sum swap intostr strcat ; : yp-open "_yprop-open" ; : yp-n "_yprop-n" ; : yp-turn "_yprop-turn" ; : yp-rolls "_yprop-rolls" ; : yp-plays "_yprop-plays" ; : yp-max-plays "_yprop-max-plays" ; : yp-dice "_yprop-dice" ; : yp-maxpnl "_yprop-maxpnl" ; : yp-mps "_yprop-mps" ; : yp-head-label "_yprop-head-label" ; : max over over < if swap then pop ; : setprop dup if 0 addprop else pop remove_prop then ; : p@ obj swap getpropstr ; : p! obj swap rot setprop ; : pi@ obj swap getpropstr atoi ; : pi! obj swap rot intostr setprop ; : p++ dup pi@ 1 + swap pi! ; : say me @ swap notify ; : sayhere loc @ swap #-1 swap notify_except ; : pfxsay yp-prefix swap strcat say ; : pfxsayhere yp-prefix swap strcat sayhere ; : p-name yp-p pi@ dbref name ; : pturn-name yp-turn pi@ p-name ; : read-yn read 1 strcut pop "y" "Y" subst "y" strcmp not ; : constant-string? dup strlen dup 2 < if pop pop 1 exit then over swap 1 - strcut pop swap 1 strcut swap pop strcmp not ; : =loop-stripwhite dup 1 > if 1 - swap rot strcat swap =loop-stripwhite then ; : stripwhite " " explode =loop-stripwhite pop ; : =loop-am-I-playing? dup yp-p pi@ dbref me @ dbcmp if pop pop 1 1 then dup 1 > if 1 - =loop-am-I-playing? else pop then ; : am-I-playing? 0 yp-n pi@ =loop-am-I-playing? ; : my-turn? yp-turn pi@ yp-p pi@ dbref me @ dbcmp ; : game-over? yp-open p@ not yp-turn pi@ 0 = and ; : roll-die yp-dice p@ swap 1 - strcut 1 strcut swap pop random 6 % 1 + intostr swap strcat strcat yp-dice p! ; : set-new-turn yp-turn pi! 0 yp-rolls pi! ; : announce-turn loc @ yp-turn pi@ yp-p pi@ dbref "It is " over name strcat "'s turn." strcat pfxsayhere ; : lpad3 dup strlen 3 < if " " swap strcat lpad3 then ; : bracket (s -- s) "[" swap "]" strcat strcat ; : ssctr (s -- s) dup strlen yp-maxpnl pi@ swap - dup 0 <= if pop exit then dup 2 / swap over - yp-mps p@ dup rot strcut pop swap rot strcut pop rot swap strcat strcat ; : =loop-score-sheet-head-str dup p-name ssctr rot swap strcat rot swap strcat swap " " swap 1 + dup yp-n pi@ <= if =loop-score-sheet-head-str then ; : score-sheet-head-str yp-head-label p@ "" 1 =loop-score-sheet-head-str pop pop ; : =loop-score-sheet-top-sums-str dup yp-top-sum pi@ intostr lpad3 bracket ssctr rot swap strcat rot swap strcat swap " " swap 1 + dup yp-n pi@ <= if =loop-score-sheet-top-sums-str then ; : score-sheet-top-sums-str -yp-top-sum "label" strcat p@ "" 1 =loop-score-sheet-top-sums-str pop pop ; : =loop-score-sheet-top-bonus-str dup yp-top-bonus p@ dup if swap pop atoi intostr lpad3 bracket else pop dup yp-top-sum pi@ swap yp-top-par pi@ - dup 0 < if intostr else intostr "+" swap strcat then "....." swap strcat dup strlen 5 - strcut swap pop then ssctr strcat strcat " " rot 1 + dup yp-n pi@ <= if rot rot 3 pick =loop-score-sheet-top-bonus-str else pop then ; : score-sheet-top-bonus-str -yp-top-bonus "label" strcat p@ "" 1 rot rot 1 =loop-score-sheet-top-bonus-str pop ; : =loop-score-sheet-bottom-sums-str dup yp-bottom-sum pi@ intostr lpad3 bracket ssctr rot swap strcat rot swap strcat swap " " swap 1 + dup yp-n pi@ <= if =loop-score-sheet-bottom-sums-str then ; : score-sheet-bottom-sums-str -yp-bottom-sum "label" strcat p@ "" 1 =loop-score-sheet-bottom-sums-str pop pop ; : =loop-score-sheet-total-sums-str dup yp-total-sum pi@ intostr lpad3 bracket ssctr rot swap strcat rot swap strcat swap " " swap 1 + dup yp-n pi@ <= if =loop-score-sheet-total-sums-str then ; : score-sheet-total-sums-str -yp-total-sum "label" strcat p@ "" 1 =loop-score-sheet-total-sums-str pop pop ; : =loop-score-sheet-line-str 4 pick swap intostr strcat p@ dup if atoi intostr lpad3 else pop "---" then ssctr strcat strcat " " 4 rotate 1 + dup yp-n pi@ <= if dup -5 rotate =loop-score-sheet-line-str else pop then ; : score-sheet-line-str (s -- s) dup "label" strcat p@ "" 1 -4 rotate 1 =loop-score-sheet-line-str pop swap pop ; : end-game "Game is over." pfxsayhere "Score totals:" pfxsayhere score-sheet-head-str pfxsayhere score-sheet-total-sums-str pfxsayhere 0 set-new-turn ; : advance-turn yp-plays p++ yp-plays pi@ yp-max-plays pi@ >= if end-game exit then yp-turn pi@ yp-n pi@ % 1 + set-new-turn announce-turn ; : =loop-dice-string dup if 1 strcut rot " " strcat rot strcat swap =loop-dice-string then ; : dice-string (first last -- string) yp-dice p@ swap strcut pop swap 1 - strcut swap pop dup strlen 1 > if "" swap =loop-dice-string pop 1 strcut swap pop then "<" swap ">" strcat strcat ; : =loop-dice-scan ( left to-roll arg ) dup if 1 strcut swap ( left to-roll arg-next arg-char ) 4 pick swap instr dup if ( left to-roll arg-next inx ) 4 rotate swap 1 - strcut 1 strcut ( to-roll arg-next pre-left die post-left ) rot swap strcat ( to-roll arg-next die new-left ) 4 rotate rot strcat rot ( new-left new-to-roll arg-next ) else pop then =loop-dice-scan then ; : dice-scan (dice arg -- new-dice first-to-roll 0 / 1) "" swap =loop-dice-scan ( left to-roll "" ) pop over swap strcat swap strlen 1 + 0 ; : score-sheet-head score-sheet-head-str pfxsay ; : score-sheet-line score-sheet-line-str pfxsay ; : score-sheet-top-sums score-sheet-top-sums-str pfxsay ; : score-sheet-top-bonus score-sheet-top-bonus-str pfxsay ; : score-sheet-bottom-sums score-sheet-bottom-sums-str pfxsay ; : score-sheet-total-sums score-sheet-total-sums-str pfxsay ; : =body-reset-sums ( pno par min cur max inx ) 6 pick over yp-# p@ dup if ( pno par min cur max inx sval ) atoi swap 3 * 6 rotate + swap 5 rotate over + swap 5 rotate over + swap 5 rotate + else ( pno par min cur max inx "" ) pop 5 * + then ; : =loop-reset-sums ( pno ) 0 0 0 0 ( pno par min cur max ) 1 =body-reset-sums 2 =body-reset-sums 3 =body-reset-sums 4 =body-reset-sums 5 =body-reset-sums 6 =body-reset-sums ( pno par min cur max ) swap 5 pick yp-top-sum pi! ( pno par min max ) yp-bonus-point < if pop "0" else yp-bonus-point >= if yp-bonus-amount intostr else "" then then 3 pick yp-top-bonus p! over yp-top-par pi! 0 ( pno sum ) over yp-3kind pi@ + over yp-4kind pi@ + over yp-fh pi@ + over yp-ss pi@ + over yp-ls pi@ + over yp-chance pi@ + over yp-yahtzee pi@ + over yp-bottom-sum pi! dup yp-top-sum pi@ over yp-top-bonus pi@ + over yp-bottom-sum pi@ + swap yp-total-sum pi! 1 + dup yp-n pi@ <= if dup =loop-reset-sums else pop then ; : reset-sums 1 dup =loop-reset-sums ; : =body-sort-dice-2 pick 3 pick = + ; : =loop-sort-dice rot dup 0 > if 1 - rot rot over strcat =loop-sort-dice else pop then ; : =body-sort-dice-1 ( d1 d2 d3 d4 d5 newstr die# ) 0 4 =body-sort-dice-2 5 =body-sort-dice-2 6 =body-sort-dice-2 7 =body-sort-dice-2 8 =body-sort-dice-2 ( d1 .. d5 newstr die# count ) dup if swap intostr rot =loop-sort-dice swap else pop then pop ; : =body-sort-dice-3 1 strcut swap atoi swap ; : sort-dice yp-dice p@ =body-sort-dice-3 =body-sort-dice-3 =body-sort-dice-3 =body-sort-dice-3 =body-sort-dice-3 1 =body-sort-dice-1 2 =body-sort-dice-1 3 =body-sort-dice-1 4 =body-sort-dice-1 5 =body-sort-dice-1 6 =body-sort-dice-1 yp-dice p! pop pop pop pop pop ; : =loop-sum-dice dup if 1 strcut swap atoi rot + swap =loop-sum-dice then ; : sum-dice 0 yp-dice p@ =loop-sum-dice pop ; : scorecmp (arg str -- arg 0 / 1) over strlen over strlen over < if pop pop 0 exit then strcut pop over strcmp if 0 else pop 1 then ; : scoreit (score slot) dup yp-turn pi@ intostr strcat ( score slot exact-slot ) dup p@ "" strcmp if "That score slot has already been filled!" pfxsay pop pop exit then 3 pick 1 < if "Score would be 0, are you sure?" pfxsay read-yn not if pop pop exit then then 3 pick swap pi! reset-sums ( score slot ) me @ name " scores " strcat rot intostr strcat " in " strcat swap "name" strcat p@ strcat "." strcat pfxsayhere advance-turn ; : =loop-score-as-# dup if ( # count dice ) 1 strcut swap atoi ( # count dice die ) 4 pick = if swap 1 + swap then =loop-score-as-# then ; : score-as-# 0 yp-dice p@ =loop-score-as-# pop over * ( # score ) swap -yp-# scoreit ; : score-as-3kind sort-dice yp-dice p@ dup 3 strcut pop constant-string? over 1 strcut 3 strcut pop swap pop constant-string? or swap 2 strcut swap pop constant-string? or if sum-dice else 0 then -yp-3kind scoreit ; : score-as-4kind sort-dice yp-dice p@ dup 4 strcut pop constant-string? swap 1 strcut swap pop constant-string? or if sum-dice else 0 then -yp-4kind scoreit ; : score-as-fh sort-dice yp-dice p@ dup 2 strcut constant-string? swap constant-string? and swap 3 strcut constant-string? swap constant-string? and or if 25 else 0 then -yp-fh scoreit ; : score-as-ss sort-dice yp-dice p@ dup "1234" instr over "2345" instr or over "3456" instr or over "12234" strcmp not or over "12334" strcmp not or over "23345" strcmp not or over "23445" strcmp not or over "34456" strcmp not or swap "34556" strcmp not or if 30 else 0 then -yp-ss scoreit ; : score-as-ls sort-dice yp-dice p@ dup "12345" instr swap "23456" instr or if 40 else 0 then -yp-ls scoreit ; : score-as-chance sum-dice -yp-chance scoreit ; : score-as-yahtzee yp-dice p@ constant-string? if 50 else 0 then -yp-yahtzee scoreit ; : score-ambiguous "Ambiguous slot name - please use another name or type more of the name." pfxsay ; : =body-doreset over swap yp-# "" swap p! ; : =loop-doreset dup yp-p p@ if "" over yp-p p! 1 =body-doreset 2 =body-doreset 3 =body-doreset 4 =body-doreset 5 =body-doreset 6 =body-doreset "" over yp-3kind p! "" over yp-4kind p! "" over yp-fh p! "" over yp-ss p! "" over yp-ls p! "" over yp-chance p! "" over yp-yahtzee p! "" over yp-top-sum p! "" over yp-top-par p! "" over yp-top-bonus p! "" over yp-bottom-sum p! "" over yp-total-sum p! 1 + =loop-doreset then ; : doreset swap "" strcmp if "Usage: " swap strcat pfxsay exit then pop 1 =loop-doreset pop "" yp-dice p! "" yp-maxpnl p! "" yp-mps p! "" yp-max-plays p! 0 yp-plays pi! 0 yp-n pi! "yes" yp-open p! "Game reset by " me @ name strcat "." strcat pfxsayhere ; : =loop-dojoin dup yp-p pi@ dbref me @ dbcmp if "You are already playing!" pfxsay pop 1 exit then 1 - 1 >= if =loop-dojoin else pop 0 then ; : dojoin swap "" strcmp if "Usage: " swap strcat pfxsay exit then pop yp-n pi@ 0 > if yp-n pi@ =loop-dojoin if exit then then yp-open p@ not if "The game has already begun!" pfxsay exit then yp-n p++ yp-n pi@ dup yp-p me @ int swap pi! me @ name " has joined the game." strcat pfxsayhere ; : =loop-dobegin-1 dup yp-p pi@ dbref me @ dbcmp if swap pop 0 swap then 1 - dup 1 >= if =loop-dobegin-1 else pop then ; : =loop-dobegin-2 dup p-name strlen rot max swap 1 - dup 1 >= if =loop-dobegin-2 else pop then ; : =loop-dobegin-3 dup 0 > if 1 - swap " " strcat swap =loop-dobegin-3 else pop then ; : dobegin swap "" strcmp if "Usage: " swap strcat pfxsay exit then pop 1 yp-n pi@ 0 > if yp-n pi@ =loop-dobegin-1 then if "You are not playing!" pfxsay exit then yp-open p@ not if "The game has already begun!" pfxsay exit then yp-n pi@ 1 < if "How did this happen? No players but we're here?!" pfxsay "Please don't touch this Yahtzee set, and report this to mouse." pfxsay exit then "Game begun by " me @ name strcat "." strcat pfxsayhere "" yp-open p! yp-n pi@ 13 * yp-max-plays pi! random yp-n pi@ % 1 + set-new-turn announce-turn 5 yp-n pi@ =loop-dobegin-2 yp-maxpnl pi! "" yp-maxpnl pi@ =loop-dobegin-3 yp-mps p! reset-sums ; : =loop-dostatus-1 p-name strcat strcat ", " rot 1 + dup yp-n pi@ <= if dup -4 rotate =loop-dostatus-1 else pop then ; : =loop-dostatus-2 p-name strcat strcat ", " rot 1 + dup yp-n pi@ <= if dup -4 rotate =loop-dostatus-2 else pop then ; : dostatus swap "" strcmp if "Usage: " swap strcat pfxsay exit then pop yp-open p@ if "Game is open to more players." pfxsay yp-n pi@ if "Players joined so far:" " " 1 dup -4 rotate =loop-dostatus-1 pop "." strcat else "No players have joined yet." then pfxsay exit then yp-turn pi@ if "Game has begun." else "Game has ended." then pfxsay "Players:" " " 1 dup -4 rotate =loop-dostatus-2 pop "." strcat pfxsay yp-turn pi@ if "It is " pturn-name strcat "'s turn." strcat pfxsay yp-rolls pi@ dup if pturn-name " has rolled " strcat over intostr "?" swap "times?" strcat strcat 3 pick 1 = if pop "once" then 3 pick 2 = if pop "twice" then 3 pick 3 = if pop "thrice" then "; dice show " 1 5 dice-string "." strcat strcat strcat else pop pturn-name " has not yet rolled." then strcat pfxsay else "Final scores:" pfxsay score-sheet-head-str pfxsay score-sheet-total-sums-str pfxsay then ; : =body-dosheet -yp-# score-sheet-line ; : dosheet swap "" strcmp if "Usage: " swap strcat pfxsay exit then pop yp-open p@ if "The game hasn't started yet!" pfxsay exit then score-sheet-head 1 =body-dosheet 2 =body-dosheet 3 =body-dosheet 4 =body-dosheet 5 =body-dosheet 6 =body-dosheet score-sheet-top-sums score-sheet-top-bonus -yp-3kind score-sheet-line -yp-4kind score-sheet-line -yp-fh score-sheet-line -yp-ss score-sheet-line -yp-ls score-sheet-line -yp-chance score-sheet-line -yp-yahtzee score-sheet-line score-sheet-bottom-sums score-sheet-total-sums ; : =loop-doroll dup 5 <= if dup roll-die 1 + =loop-doroll else pop then ; : doroll pop am-I-playing? not if "You're not playing!" pfxsay exit then my-turn? not if "It's not your turn!" pfxsay exit then yp-rolls pi@ 3 >= if "You're allowed only three rolls per turn." pfxsay "At this point you must choose a place to score this roll." pfxsay exit then yp-rolls pi@ 0 > if yp-dice p@ swap dice-scan if exit then dup 5 > if pop pop "You must specify at least one number to reroll!" pfxsay exit then swap yp-dice p! pturn-name " rolls " strcat over 5 dice-string strcat " and gets " strcat swap dup =loop-doroll 5 dice-string strcat "; dice now show " strcat 1 5 dice-string strcat "." strcat pfxsayhere else "" strcmp if "On the first roll of a turn, you can't specify dice to roll!" pfxsay exit then 1 roll-die 2 roll-die 3 roll-die 4 roll-die 5 roll-die pturn-name " rolls the dice and gets " strcat 1 5 dice-string strcat pfxsayhere then yp-rolls p++ ; : doscore over not if "Usage: " swap " " strcat strcat pfxsay exit then pop tolower stripwhite "3" scorecmp if score-ambiguous exit then "4" scorecmp if score-ambiguous exit then "four" scorecmp if score-ambiguous exit then "s" scorecmp if score-ambiguous exit then "three" scorecmp if score-ambiguous exit then "1s" scorecmp if 1 score-as-# exit then "2s" scorecmp if 2 score-as-# exit then "3s" scorecmp if 3 score-as-# exit then "4s" scorecmp if 4 score-as-# exit then "5s" scorecmp if 5 score-as-# exit then "6s" scorecmp if 6 score-as-# exit then "ones" scorecmp if 1 score-as-# exit then "twos" scorecmp if 2 score-as-# exit then "threes" scorecmp if 3 score-as-# exit then "fours" scorecmp if 4 score-as-# exit then "fives" scorecmp if 5 score-as-# exit then "sixes" scorecmp if 6 score-as-# exit then "3kind" scorecmp if score-as-3kind exit then "3ofakind" scorecmp if score-as-3kind exit then "threeofakind" scorecmp if score-as-3kind exit then "4kind" scorecmp if score-as-4kind exit then "4ofakind" scorecmp if score-as-4kind exit then "fourofakind" scorecmp if score-as-4kind exit then "fh" scorecmp if score-as-fh exit then "fullhouse" scorecmp if score-as-fh exit then "ss" scorecmp if score-as-ss exit then "smallstraight" scorecmp if score-as-ss exit then "ls" scorecmp if score-as-ls exit then "largestraight" scorecmp if score-as-ls exit then "chance" scorecmp if score-as-chance exit then "yahtzee" scorecmp if score-as-yahtzee exit then "`" swap "' is not a recognized space on the score sheet!" strcat strcat pfxsay ; : dorules pop dup "" strcmp not if pop "+-----------------------------------+" pfxsay "| Mouse MUF-Yahtzee |" pfxsay "+--------+--------------------------+" pfxsay "| reset | Reset the game |" pfxsay "| join | Join in a game |" pfxsay "| begin | Begin a game |" pfxsay "| status | Show the game status |" pfxsay "| sheet | Show the score sheet |" pfxsay "| roll | Roll the dice |" pfxsay "| score | Mark a roll on the sheet |" pfxsay "| rules | Print rules |" pfxsay "+--------+--------------------------+" pfxsay "| rules gives help for . |" pfxsay "| rules example gives an example. |" pfxsay "+-----------------------------------+" pfxsay exit then dup "reset" strcmp not if pop "reset - reset the game." pfxsay "This resets the game completely. Everything starts over; players" pfxsay "must join and the game must be begun again." pfxsay exit then dup "join" strcmp not if pop "join - join the game." pfxsay "Adds you to the list of people playing the game." pfxsay exit then dup "begin" strcmp not if pop "begin - begin a game." pfxsay "Begins a game. When one of the players issues this command, no" pfxsay "further join commands are permitted, a player is chosen randomly" pfxsay "to play first, and play starts." pfxsay exit then dup "status" strcmp not if pop "status - show game status." pfxsay "Shows the game status. Describes everything about the game's status" pfxsay "except the contents of the score sheet (see `sheet' for that)." pfxsay exit then dup "sheet" strcmp not if pop "sheet - show score sheet." pfxsay "Shows the score sheet for the game. Entries that are not yet filled" pfxsay "in are shown as ---." pfxsay exit then dup "roll" strcmp not if pop "roll - roll the dice." pfxsay "Rolls the dice. The first roll of a turn is just `roll'; to reroll" pfxsay "dice, give the numbers showing on the dice. For example, if you" pfxsay "rolled <4 2 2 6 1> and want to roll the 6 and one of the 2s, you" pfxsay "would `roll 2 6' or `roll 6 2'." pfxsay "Only two rerolls (a total of three rolls) are permitted per turn." pfxsay exit then dup "score" strcmp not if pop "score - write a score on the sheet." pfxsay "When you have rolled the dice and either are happy with the roll" pfxsay "or have used both your rerolls, use this command to enter a score" pfxsay "for the roll on the score sheet. The argument is the name of the" pfxsay "item on the score sheet you wish to enter the score in. Any roll" pfxsay "may be scored in any slot; if the roll is inappropriate for the" pfxsay "slot, the score will be 0. Any score that would be 0 requires" pfxsay "confirmation from the player." pfxsay "`rules slots' gives a list of score slot names." pfxsay "`rules scoring' describes how scores are calculated." pfxsay exit then dup "rules" strcmp not if pop "rules - show rules and command info." pfxsay "By itself, gives a list of commands; with a command name, gives help" pfxsay "on that command." pfxsay exit then dup "example" strcmp not if pop "example - example of use of commands." pfxsay "This is a short example showing the use of the commands." pfxsay "It describes the beginning of a game among three players, Herman," pfxsay "Airon, and Twibbit." pfxsay "" pfxsay "Player Command Everyone sees" pfxsay "Herman reset % Game reset by Herman." pfxsay "Herman join % Herman has joined the game." pfxsay "Twibbit join % Twibbit has joined the game." pfxsay "Airon join % Airon has joined the game." pfxsay "Twibbit begin % Game begun by Twibbit." pfxsay " % It is Airon's turn." pfxsay "Airon roll % Airon rolls the dice and gets <2 2 4 3 4>" pfxsay "Airon roll 2 2 3" pfxsay " % Airon rolls <2 2 3> and gets <1 6 4>; dice now show <4 4 1 6 4>" pfxsay "Airon roll 1 6" pfxsay " % Airon rolls <1 6> and gets <4 5>; dice now show <4 4 4 4 5>" pfxsay "Airon score 4 of a kind" pfxsay " % Airon scores 21 in four of a kind." pfxsay " % It is Herman's turn." pfxsay exit then dup "slots" strcmp not if pop "slots - names of score slots." pfxsay "All whitespace in the slot name is ignored, and uppercase letters are" pfxsay "converted to lowercase. Any unambiguous abbreviation is accepted." pfxsay "The names accepted are as follows. Names inside []s are equivalent." pfxsay "[1s, ones] [3kind, 3 of a kind, three of a kind]" pfxsay "[2s, twos] [4kind, 4 of a kind, four of a kind]" pfxsay "[3s, threes] [fh, full house]" pfxsay "[4s, fours] [ss, small straight]" pfxsay "[5s, fives] [ls, large straight]" pfxsay "[6s, sixes] [chance] [yahtzee]" pfxsay exit then dup "scoring" strcmp not if pop "scoring - rules for scoring." pfxsay "For 1s, 2s, 3s, 4s, 5s, 6s, the score is simply the sum of all the" pfxsay "dice of the appropriate kind (eg, for 3s, the score is the total of" pfxsay "all the 3s in the roll). Other dice are ignored. A total of 63 or" pfxsay "higher (three of each adds up to 63) is required for the bonus." pfxsay "When earned, the bonus scores 35. The game enters 0 or 35 in this" pfxsay "field automatically as soon as it becomes impossible or certain that" pfxsay "the sum will exceed 63." pfxsay "" pfxsay "For three and four of a kind, and chance, the score is the sum of all" pfxsay "five dice. Three and four of a kind, however, score 0 unless three or" pfxsay "four of the dice are identical. Chance has no restrictions." pfxsay "" pfxsay "Full house scores 25 for any roll having three dice the same and the" pfxsay "other two also the same (though possibly different), like <2 4 2 2 4>." pfxsay "Small straight scores 30 and can be earned for any roll having four" pfxsay "dice in a numerical sequence, ie, 1 2 3 4, 2 3 4 5, or 3 4 5 6. Large" pfxsay "straight is similar, but scores 40, and all five dice must be in sequence." pfxsay "" pfxsay "Yahtzee scores 50 for any roll with all five dice the same." pfxsay exit then ; : main trigger @ "action" getpropstr dup not if pop trigger @ name then dup "reset" strcmp not if doreset exit then dup "join" strcmp not if dojoin exit then dup "begin" strcmp not if dobegin exit then dup "status" strcmp not if dostatus exit then dup "sheet" strcmp not if dosheet exit then dup "roll" strcmp not if doroll exit then dup "score" strcmp not if doscore exit then dup "rules" strcmp not if dorules exit then "Unrecognized command `" swap strcat "'." strcat pfxsay ; . c q