( MUF-Cribbage Version 2.00. Concept and code by Sjade ) ( Main card scoring routine [lines 446-592] by der Mouse ) ( Copyright 1993 by Sjade of HoloMUCK and der Mouse ) () ( This code is freely usable by permission of both of ) ( the co-authors listed above with the following stip- ) ( ulations. [1] This header is to be left intact and ) ( all mention of the authors associated with this game ) ( must be left in place and unaltered. [2] All changes ) ( made to the stock code as distributed in this file be ) ( sent via mail to either sjade@hobbes.cs.mcgill.ca or ) ( mouse@collatz.mcrcim.mcgill.edu. Thank you. ) () ( Include the following word if using on fuzzball server ) ( : & ) ( bitand ) ( ; ) () : say ( s -- ) me @ swap notify ; : sayall ( s -- ) loc @ me @ rot notify_except ; : announce ( s -- ) loc @ #-1 rot notify_except ; : strip ( s -- s ) dup not if exit then begin dup 1 strcut pop " " stringcmp not while 1 strcut swap pop repeat begin dup dup strlen 1 - strcut swap pop " " stringcmp not while dup strlen 1 - strcut pop repeat ; : cmd ( s -- s ) dup dup " " instr dup if 1 - strcut pop else pop then ; : arg ( s -- s ) dup " " instr dup if strcut swap pop strip else pop pop "" then ; : board ( -- d ) trigger @ location ; : turn ( -- i ) board ".turn" getpropstr atoi ; : pegturn ( -- i ) board ".pegturn" getpropstr atoi ; : !pegturn ( -- i ) pegturn 1 = if 2 else 1 then ; : next_turn ( -- ) turn 1 = if board ".turn" "2" 0 addprop else board ".turn" "1" 0 addprop then ; : next_pegturn ( -- ) pegturn 1 = if board ".pegturn" "2" 0 addprop else board ".pegturn" "1" 0 addprop then ; : cp ( -- d ) ".player" turn intostr strcat board swap getpropstr atoi dbref ; : op ( -- d ) turn 1 = if "2" else "1" then ".player" swap strcat board swap getpropstr atoi dbref ; : playing? ( d -- i ) board ".player1" getpropstr atoi dbref over dbcmp board ".player2" getpropstr atoi dbref rot dbcmp or ; : player ( d -- i ) dup playing? not if pop 0 exit then board ".player1" getpropstr atoi dbref swap dbcmp if 1 else 2 then ; : p1 ( -- d ) board ".player1" getpropstr atoi dbref ; : p2 ( -- d ) board ".player2" getpropstr atoi dbref ; : announce_pegturn ( -- ) pegturn 1 = if p1 else p2 then "## It is now %t's turn." over name "%t" subst announce "## Your hand is [%h]" board ".hand" pegturn intostr strcat getpropstr "%h" subst notify ; : game_ready? ( -- i ) board ".player1" getpropstr board ".player2" getpropstr and ; : pegging_display ( -- ) "## " p1 name strcat " [" strcat board ".played1" getpropstr strip dup strlen " " swap strcut swap pop strcat strcat "] => " strcat board ".total" getpropstr atoi intostr dup strlen " " swap strcut swap pop swap strcat strcat " <= [" strcat board ".played2" getpropstr strip dup strlen " " swap strcut swap pop strcat strcat "] " strcat p2 name strcat announce ; : lap ( i -- i ) board ".peg" 3 pick intostr strcat "1" strcat getpropstr board ".peg" 4 rotate intostr strcat "2" strcat getpropstr over not over not and if pop pop 0 exit then over atoi 60 > over atoi 60 > or if 2 else 1 then swap pop swap pop ; : unparse_card ( s -- s ) 1 strcut ".sn" swap strcat board swap getpropstr swap ".cn" swap strcat board swap getpropstr " of " strcat swap strcat ; : face_value ( s -- i ) 1 strcut pop dup atoi if atoi exit then dup "A" stringcmp not if pop 1 exit then pop 10 ; : cut_face_value ( s -- i ) 1 strcut pop dup atoi if atoi exit then dup "A" stringcmp not if pop 1 exit then dup "K" stringcmp not if pop 13 exit then dup "Q" stringcmp not if pop 12 exit then dup "J" stringcmp not if pop 11 exit then pop 10 ; : suit_value ( s -- i ) 1 strcut swap pop tolower "1" "s" subst "2" "d" subst "3" "c" subst "4" "h" subst atoi ; : game_full? ( -- i ) board ".player1" getpropstr board ".player2" getpropstr and ; : crib? ( -- i ) board ".crib1" getpropstr board ".crib2" getpropstr and ; : explode_clear ( x1 x2 .. xN N -- ) begin dup while swap pop 1 - repeat pop ; : can_play? ( i -- i ) board ".hand" 3 pick intostr strcat getpropstr dup not if pop pop 0 exit then strip " " explode begin dup while board ".total" getpropstr atoi 3 pick face_value + 31 <= if explode_clear pop 1 exit then swap pop 1 - repeat pop pop 0 ; : repair_card ( s -- s ) 1 strcut tolower swap toupper swap strcat ; : pegval ( i i -- i ) board ".peg" 4 rotate intostr strcat rot intostr strcat getpropstr atoi ; : hipeg ( i -- i ) dup 1 pegval swap 2 pegval over over >= if pop else swap pop then ; : lopeg ( i -- i ) dup 1 pegval swap pegval over over >= if swap pop else pop then ; : winner? ( i -- i ) board ".length" getpropstr if dup 1 pegval 60 > swap 2 pegval 60 > or else dup 1 pegval 120 > swap 2 pegval 120 > or then ; : game_over ( i -- ) dup 1 = if 2 else 1 then board ".length" getpropstr over hipeg 90 > or if pop "## " board ".player" 4 rotate intostr strcat getpropstr atoi dbref name strcat " has won the game!" strcat announce else "## %w has won the game and %s %l!" over hipeg 91 < if "skunked" "%s" subst then over hipeg 61 < if "double skunked" "%s" subst then board ".player" 4 rotate intostr strcat getpropstr atoi dbref name "%l" subst board ".player" 4 rotate intostr strcat getpropstr atoi dbref name "%w" subst announce then board ".game_over" "yes" 0 addprop ; : peg ( i i -- i ) dup not if pop "## " board ".player" 4 rotate intostr strcat getpropstr atoi dbref name strcat " has a '19' hand, " strcat "worth no points." strcat announce 0 exit then swap dup rot board ".peg" 4 pick intostr strcat "1" strcat getpropstr atoi board ".peg" 5 pick intostr strcat "2" strcat getpropstr atoi >= if ".peg" 3 pick intostr strcat "1" strcat else ".peg" 3 pick intostr strcat "2" strcat then board over getpropstr atoi 3 pick + dup 121 >= if pop 121 then intostr swap dup strlen 1 - strcut "2" stringcmp not if "1" else "2" then strcat board swap rot 0 addprop "## " rot 1 = if p1 else p2 then name strcat " pegs off " strcat over intostr strcat " points." strcat swap 1 = if "point" "points" subst then announce winner? ; : shuffle ( -- ) board ".suit1" "As2s3s4s5s6s7s8s9sTsJsQsKs" 0 addprop board ".suit2" "Ac2c3c4c5c6c7c8c9cTcJcQcKc" 0 addprop board ".suit3" "Ah2h3h4h5h6h7h8h9hThJhQhKh" 0 addprop board ".suit4" "Ad2d3d4d5d6d7d8d9dTdJdQdKd" 0 addprop ; : pick_cards ( i -- s ) "" begin over while random 4 % 1 + intostr ".suit" swap strcat board over getpropstr dup strlen 2 / random swap % 2 * strcut 2 strcut rot swap strcat board 4 rotate rot 0 addprop strcat " " strcat swap 1 - swap repeat swap pop dup strlen 1 - strcut pop ; : hand_reset ( -- ) shuffle board ".hand1" remove_prop board ".hand2" remove_prop board ".dealt" remove_prop board ".played1" remove_prop board ".played2" remove_prop board ".crib1" remove_prop board ".crib2" remove_prop board ".cc" remove_prop board ".total" remove_prop board ".seq" remove_prop board ".pegturn" remove_prop ; : do_reset ( -- ) arg tolower "h" 1 strncmp not if board ".length" "half" 0 addprop else board ".length" remove_prop then board ".player1" remove_prop board ".player2" remove_prop board ".turn" remove_prop board ".cut1" remove_prop board ".cut2" remove_prop board ".peg11" remove_prop board ".peg12" remove_prop board ".peg21" remove_prop board ".peg22" remove_prop board ".game_over" remove_prop board ".sns" "spades" 0 addprop board ".snd" "diamonds" 0 addprop board ".snc" "clubs" 0 addprop board ".snh" "hearts" 0 addprop board ".cnA" "Ace" 0 addprop board ".cn2" "2" 0 addprop board ".cn3" "3" 0 addprop board ".cn4" "4" 0 addprop board ".cn5" "5" 0 addprop board ".cn6" "6" 0 addprop board ".cn7" "7" 0 addprop board ".cn8" "8" 0 addprop board ".cn9" "9" 0 addprop board ".cnT" "10" 0 addprop board ".cnJ" "Jack" 0 addprop board ".cnQ" "Queen" 0 addprop board ".cnK" "King" 0 addprop hand_reset "## " me @ name strcat " resets the game." strcat sayall "## You reset the game." say board ".length" getpropstr if "## Next game has been set to half length." announce else "## Next game has been set to full length." announce then ; : do_join ( -- ) me @ playing? if "## You are already joined." say exit then game_full? if "## Two people are already joined." say exit then board ".player1" getpropstr if board ".player2" me @ intostr 0 addprop else board ".player1" me @ intostr 0 addprop then "## " me @ name strcat " joins the game." strcat sayall "## You join the game." say ; : do_deal ( -- ) board ".dealt" getpropstr if "## Hand is in progress." say exit then me @ player not if "## You're not in this game!" say exit then me @ player turn = not if "## It's not your turn to deal." say exit then "## " me @ name strcat " deals the hand." strcat sayall "## You deal the hand." say 6 pick_cards "## Your hand is [" over strcat "]" strcat p1 swap notify board ".hand1" rot 0 addprop 6 pick_cards "## Your hand is [" over strcat "]" strcat p2 swap notify board ".hand2" rot 0 addprop board ".dealt" "yes" 0 addprop ; : do_cutcard ( -- ) me @ player not if "## You're not playing!" say exit then me @ op dbcmp not if "## It's not your turn to cut." say exit then crib? not if "## A crib must be decided first." say exit then board ".cc" getpropstr if "## A cut card has already been chosen!" say exit then 1 pick_cards "## " me @ name strcat " cuts the " strcat over unparse_card strcat "." strcat sayall "## You cut the " over unparse_card strcat "." strcat say board ".cc" 3 pick 0 addprop "J" 1 strncmp not if "## Lead cut is a Jack." announce cp player 2 peg if cp player game_over exit then then "## Pegging play begins with " op name strcat "." strcat announce op player intostr board ".pegturn" rot 0 addprop op "## Your hand is [%h]" board ".hand" pegturn intostr strcat getpropstr "%h" subst notify ; : do_cut ( -- ) board ".dealt" getpropstr if do_cutcard exit then me @ player dup not if pop "## You're not playing!" say exit then turn if pop "## Lead deal is already determined." say exit then board ".cut" 3 pick intostr strcat getpropstr if pop "## You have already cut for deal." say exit then game_ready? not if pop "## Two people must join first." say exit then 1 pick_cards "## " me @ name strcat " cuts the " strcat over unparse_card strcat "." strcat sayall "## You cut the " over unparse_card strcat "." strcat say ".cut" rot intostr strcat board swap rot 0 addprop board ".cut1" getpropstr board ".cut2" getpropstr and if board ".cut1" getpropstr cut_face_value board ".cut2" getpropstr cut_face_value over over = if pop pop "## Cards tie. Cut again." announce board ".cut1" remove_prop board ".cut2" remove_prop exit then < if "## Player 1, " p1 name strcat ", has first deal and crib." strcat announce board ".turn" "1" 0 addprop else "## Player 2, " p2 name strcat ", has first deal and crib." strcat announce board ".turn" "2" 0 addprop then then ; : dump_row ( -- s ) ".............................." dup strcat ; : place_peg ( s i -- s ) 1 - strcut 1 strcut swap pop "!" swap strcat strcat ; : insert_spaces ( s -- s ) 60 begin dup while dup dup 30 % swap 5 % not and if swap over strcut " " swap strcat strcat swap then 1 - repeat pop ; : reverse ( s -- s ) "" swap 1 begin dup 35 <= while swap dup strlen 1 - strcut 4 rotate swap strcat swap rot 1 + repeat pop pop ; : card-suit 1 strcut swap pop ; : card-value-15 1 strcut pop dup "A" strcmp not if pop "1" then "TJQK" over instr if pop "10" then atoi ; : card-value-run 1 strcut pop dup "A" strcmp not if pop "1" then dup "T" strcmp not if pop "10" then dup "J" strcmp not if pop "11" then dup "Q" strcmp not if pop "12" then dup "K" strcmp not if pop "13" then atoi ; : compute-select-sum (n16 n8 n4 n2 n1 x n -- n16 n8 n4 n2 n1 x n sum) 0 over 1 & if 4 pick + then over 2 & if 5 pick + then over 4 & if 6 pick + then over 8 & if 7 pick + then over 16 & if 8 pick + then ; : sort-2 over over > if swap then ; : sort-3 over over < if swap then rot sort-2 rot sort-2 ; : sort-5 sort-3 -5 rotate -5 rotate sort-3 5 rotate sort-3 rot 5 rotate sort-3 4 rotate sort-3 ; : score-15s " " explode pop 5 rotate card-value-15 5 rotate card-value-15 5 rotate card-value-15 5 rotate card-value-15 5 rotate card-value-15 0 3 begin (should be "0 begin" for completeness - we optimize) compute-select-sum 15 = if swap 1 + swap then 1 + dup 31 <= while repeat pop -6 rotate pop pop pop pop pop 2 * ; : score-pairs " " explode pop 0 1 begin dup 1 + begin over 3 + pick over 4 + pick 1 strncmp not if rot 1 + rot rot then 1 + dup 5 <= while repeat pop 1 + dup 4 <= while repeat pop -6 rotate pop pop pop pop pop 2 * ; : run-maybe-pick (n16 n8 n4 n2 n1 s n o b -- ... s [nb] n o b) 3 pick over & if over pick 4 rotate 4 rotate 1 + 4 rotate then ; : check-run (n16 n8 n4 n2 n1 s n -- n16 n8 n4 n2 n1 s 1/0) 9 16 begin run-maybe-pick 2 / swap 1 - swap dup 0 > while repeat pop swap pop begin dup 5 > while 1 - swap 3 pick 1 + = not if begin dup 4 > while 1 - swap pop repeat pop 0 exit then repeat pop pop 1 ; : score-runs " " explode pop 5 rotate card-value-run 5 rotate card-value-run 5 rotate card-value-run 5 rotate card-value-run 5 rotate card-value-run sort-5 0 31 check-run if 5 + then dup 0 = if 15 check-run if 4 + then 23 check-run if 4 + then 27 check-run if 4 + then 29 check-run if 4 + then 30 check-run if 4 + then then dup 0 = if 7 check-run if 3 + then 11 check-run if 3 + then 13 check-run if 3 + then 14 check-run if 3 + then 19 check-run if 3 + then 21 check-run if 3 + then 22 check-run if 3 + then 25 check-run if 3 + then 26 check-run if 3 + then 28 check-run if 3 + then then -6 rotate pop pop pop pop pop ; : score-flushes- " " explode pop card-suit swap card-suit strcat swap card-suit strcat swap card-suit strcat swap card-suit strcat dup "ccccc" strcmp not if pop 5 exit then dup "ddddd" strcmp not if pop 5 exit then dup "hhhhh" strcmp not if pop 5 exit then dup "sssss" strcmp not if pop 5 exit then 4 strcut pop dup "cccc" strcmp not if pop 4 exit then dup "dddd" strcmp not if pop 4 exit then dup "hhhh" strcmp not if pop 4 exit then dup "ssss" strcmp not if pop 4 exit then pop 0 ; : score-flushes score-flushes- ; : score-jack 13 strcut "J" swap strcat instr if 1 else 0 then ; : count_cards ( cards -- score ) "## Determining the value of %n's hand, [%h (%c)]..." swap 3 = if "the crib" "%n's hand" subst else rot name "%n" subst then board ".played" 4 rotate intostr strcat getpropstr strip swap over "%h" subst board ".cc" getpropstr strip swap over "%c" subst announce " " swap strcat strcat dup score-15s over score-pairs + over score-runs + over score-flushes + over score-jack + swap pop ; : check_pairs ( s1 ... sN N i -- i ) over 2 > if 4 pick cut_face_value 6 pick cut_face_value = if pop 6 else pop explode_clear 2 exit then else pop explode_clear 2 exit then over 3 > if 5 pick cut_face_value 7 pick cut_face_value = if pop 12 else pop explode_clear 6 exit then else pop explode_clear 6 exit then over 2 + 0 swap - rotate explode_clear ; : check_run_up ( s1 ... sN N i -- i ) 2 begin dup 4 pick < while dup 3 + pick cut_face_value over 5 + pick cut_face_value 1 + = if swap 1 + swap 1 + else pop over 2 + 0 swap - rotate explode_clear exit then repeat pop over 2 + 0 swap - rotate explode_clear ; : check_run_down ( s1 ... sN N i -- i ) 2 begin dup 4 pick < while dup 3 + pick cut_face_value over 5 + pick cut_face_value 1 - = if swap 1 + swap 1 + else pop over 2 + 0 swap - rotate explode_clear exit then repeat pop over 2 + 0 swap - rotate explode_clear ; : count_sequence ( cards -- score ) board ".seq" getpropstr strip " " explode dup 2 > if over cut_face_value 4 pick cut_face_value 1 + = if 2 check_run_up dup 2 = if pop 0 then exit then over cut_face_value 4 pick cut_face_value 1 - = if 2 check_run_down dup 2 = if pop 0 then exit then then dup 1 > if over cut_face_value 4 pick cut_face_value = if 2 check_pairs exit then then explode_clear 0 ; : do_display ( -- ) "## .-------------------------------------." say dump_row board ".peg11" getpropstr atoi dup if dup 60 > if 60 - then place_peg else pop then board ".peg12" getpropstr atoi dup if dup 60 > if 60 - then place_peg else pop then insert_spaces 35 strcut reverse swap "## | " swap strcat " | P1: " strcat board ".player1" getpropstr dup if atoi dbref name strcat " (L=" strcat 1 lap intostr strcat ",HP=" strcat 1 hipeg intostr strcat ")" strcat else pop then say "## | " swap strcat " |" strcat say "## | | CC: " board ".cc" getpropstr strcat say dump_row board ".peg21" getpropstr atoi dup if dup 60 > if 60 - then place_peg else pop then board ".peg22" getpropstr atoi dup if dup 60 > if 60 - then place_peg else pop then insert_spaces 35 strcut reverse "## | " swap strcat " |" strcat say "## | " swap strcat " | P2: " strcat board ".player2" getpropstr dup if atoi dbref name strcat " (L=" strcat 2 lap intostr strcat ",HP=" strcat 2 hipeg intostr strcat ")" strcat else pop then say "## |_____________________________________|" say ; : do_crib ( s -- ) me @ playing? not if pop "## You're not playing!" say exit then " " explode dup 2 = not if explode_clear "## Invalid number of cards." say exit then me @ player ".crib" swap intostr strcat board swap getpropstr if explode_clear "## You've already cribbed two cards." say exit then board ".dealt" getpropstr not if explode_clear "## No hand has been dealt yet." say exit then me @ player ".hand" swap intostr strcat board swap getpropstr swap pop dup tolower 3 pick tolower instr not over tolower 5 pick tolower instr not or if pop pop pop "## One or both cards invalid." say exit then over 4 pick stringcmp not if pop pop pop "## Those two cards are identical!" say exit then swap repair_card rot repair_card rot "" 3 pick subst "" 4 pick subst " " " " subst " " " " subst strip me @ player ".hand" swap intostr strcat board swap rot 0 addprop " " swap strcat strcat me @ player ".crib" swap intostr strcat board swap rot 0 addprop "## You submit two cards to the crib." say "## " me @ name strcat " submits two cards to the crib." strcat sayall board ".crib1" getpropstr board ".crib2" getpropstr and if "## It is " op name strcat "'s cut." strcat announce then ; : do_play ( s -- ) pegturn not if pop "## Pegging play has not begun." say exit then me @ player pegturn = not if pop "## It is not your turn to play." say exit then dup strlen 2 = not if pop "## Play what?" say exit then board ".hand" pegturn intostr strcat getpropstr dup tolower 3 pick tolower instr not if pop pop "## You don't have that card." say exit then swap repair_card swap board ".total" getpropstr atoi 3 pick face_value + 31 > if pop pop "## Total would exceed 31." say exit then "" 3 pick subst " " " " subst strip board ".hand" pegturn intostr strcat rot 0 addprop board ".played" pegturn intostr strcat getpropstr over " " strcat strcat board ".seq" getpropstr 3 pick " " strcat swap strcat board ".seq" rot strip 0 addprop board ".played" pegturn intostr strcat rot 0 addprop "## You play the " over unparse_card strcat "." strcat say "## " me @ name strcat " plays the " strcat over unparse_card strcat "." strcat sayall board ".seq" getpropstr strip count_sequence dup if pegturn swap peg if pop pegturn game_over exit then else pop then board ".total" getpropstr atoi over face_value + board ".total" 3 pick intostr 0 addprop dup 31 = if board ".total" "0" 0 addprop board ".seq" remove_prop pegturn 2 peg if pegturn game_over exit then then dup 15 = if pegturn 2 peg if pegturn game_over exit then then pop board ".hand1" getpropstr not board ".hand2" getpropstr not and if "## %t plays the last card in the hand." board ".player" pegturn intostr strcat getpropstr atoi dbref name "%t" subst announce pegturn 1 peg if pop pegturn game_over exit then pop op dup player dup count_cards op player swap peg if op player game_over exit then cp dup player dup count_cards cp player swap peg if cp player game_over exit then board ".crib1" getpropstr strip " " strcat board ".crib2" getpropstr strip strcat board ".played" cp player intostr strcat rot 0 addprop cp dup player 3 count_cards cp player swap peg if cp player game_over exit then next_turn hand_reset "## It is now %p's turn to deal." cp name "%p" subst announce exit then next_pegturn pegturn can_play? not if next_pegturn pegturn can_play? not if board ".total" "0" 0 addprop board ".seq" remove_prop "## %p takes a go." board ".player" pegturn intostr strcat getpropstr atoi dbref name "%p" subst announce pegturn 1 peg if pegturn game_over exit then next_pegturn pegturn can_play? not if next_pegturn then pegging_display announce_pegturn exit then then pegging_display announce_pegturn ; : do_status ( -- ) "## Status:" say board ".game_over" getpropstr if "## Game has ended, type '%tdisplay' for results." trigger @ "PREFIX" flag? if trigger @ name "%t" subst else trigger @ name " " strcat "%t" subst then say exit then board ".length" getpropstr if "## Game is set to be half length." say else "## Game is set to be full length." say then game_ready? if "## Two people are joined: " p1 name strcat " and " strcat p2 name strcat "." strcat say then board ".player1" getpropstr board ".player2" getpropstr not and if "## One person has joined: " p1 name strcat "." strcat say exit then board ".player1" getpropstr not board ".player2" getpropstr not and if "## No players have joined." say exit then turn not game_ready? and if board ".cut1" getpropstr dup if "## " p1 name strcat " has cut the " strcat swap unparse_card strcat " for deal." strcat say else pop then board ".cut2" getpropstr dup if "## " p2 name strcat " has cut the " strcat swap unparse_card strcat " for deal." strcat say else pop then then turn game_ready? and if "## First deal and crib has been determined." say "## It is now " cp name strcat "'s deal and crib." strcat say then board ".dealt" getpropstr if "## A hand is in progress." say then board ".crib1" getpropstr board ".crib2" getpropstr and if "## A crib has been determined." say else "## A crib has not yet been determined." say then me @ playing? if "## Your hand is [" me @ player ".hand" swap intostr strcat board swap getpropstr strcat "]" strcat say then board ".pegturn" getpropstr if "## " p1 name strcat " [" strcat board ".played1" getpropstr strip dup strlen " " swap strcut swap pop strcat strcat "] => " strcat board ".total" getpropstr atoi intostr dup strlen " " swap strcut swap pop swap strcat strcat " <= [" strcat board ".played2" getpropstr strip dup strlen " " swap strcut swap pop strcat strcat "] " strcat p2 name strcat say "## It is %t's turn to play a card." board ".player" pegturn intostr strcat getpropstr atoi dbref name "%t" subst say then ; : do_hand ( -- ) me @ playing? not if "## You're not playing!" say exit then board ".dealt" getpropstr not if "## There is no hand in progress." say exit then me @ player ".hand" swap intostr strcat board swap getpropstr "## Your hand is [" swap strcat "]" strcat say ; : addc ( s -- s ) trigger @ dup "PREFIX" flag? swap name strlen 1 = and if trigger @ name "%c" subst else " " "%c" subst then ; : do_rules ( -- ) "+-----------------------------------------------+" say "| MUF-Cribbage 2.00 |" say "+-----------------------------------------------+" say "| Concept, design and code by Sjade of HoloMUCK |" say "| Major scoring routines created by der Mouse |" say "+-----------+-----------------------------------+" say "| %creset h | Reset the game (h for 1/2 game) |" addc say "| %cjoin | Join in the game |" addc say "| %cdeal | Deal a hand |" addc say "| %ccut | Cut for deal or for extra card |" addc say "| %cdisplay | Show the board |" addc say "| %ccrib x y | Submit two cards to the crib |" addc say "| %cplay x | Play a card |" addc say "| %cstatus | Show status of game in progress |" addc say "| %chand | Show your hand |" addc say "| %chelp | This help screen |" addc say "+-----------+-----------------------------------+" say ; : main ( s -- ) board location room? not if pop "## Board must be set down first." say exit then strip cmd "reset" stringcmp not if do_reset exit then cmd "status" stringcmp not if pop do_status exit then cmd "help" stringcmp not if pop do_rules exit then cmd "display" stringcmp not if pop do_display exit then board ".game_over" getpropstr if pop "## You must reset the game first." say exit then cmd "cut" stringcmp not if pop do_cut exit then cmd "hand" stringcmp not if pop do_hand exit then cmd "deal" stringcmp not if pop do_deal exit then cmd "crib" stringcmp not if arg do_crib exit then cmd "play" stringcmp not if arg do_play exit then cmd "join" stringcmp not if pop do_join exit then "## Command \"%t%p%c\" not understood, try \"%t%phelp\"." trigger @ "PREFIX" flag? if "" "%p" subst else " " "%p" subst then swap "%c" subst trigger @ name "%t" subst say ;