@tel #243=me @edit #243 1 10000 del i (Header, 17 lines -- Huckster.muf Jordan Greywolf, 14 May 2001 - updated 26 Jun 2001 http://greywolf.critter.net Hucksters and the Deadlands RPG are {c} Pinnacle Games http://www.peginc.com : This program is meant to simulate the card deck used by a Huckster player in the Deadlands RPG, for the purpose of determining the success or failure of "Hexes" and "Tricks". The following command should be linked to this program as a local global: : huck;huckster : To set up this action so it doesn't generate html tags and doesn't record on cambots, set the action to "D" {Dark}. ) lvar deck ( object that holds props ) lvar jokers ( counter for wild cards ) lvar flush-flag ( a kludge to avoid calculating flushes twice ) () : tell ( s -- : sends message to user ) me @ swap notify ; () : tell-all ( s -- : sends message to room ) loc @ #-1 rot notify_except ; () : tell-exclude ( s -- : sends message to room, excluding user ) loc @ me @ rot notify_except ; () : help "-=-+-=-+-=-+-=-+- Deadlands Huckster Deck -+-=-+-=-+-=-+-=-" tell "- Deadlands is (c) Pinnacle Games / www.peginc.com -" tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell "- This program is a tool for online roleplay of Deadlands -" tell "- for the player of a Huckster character. It simulates a -" tell "- deck of cards used by the Huckster player, from which -" tell "- cards are drawn to determine the success or failure of -" tell "- a 'Hex' or 'Trick'. The following commands can be used: -" tell "- -" tell "- huck #HELP - displays this help screen -" tell "- huck #SHUFfle - shuffles the deck -" tell trigger @ name "shuf" instring if "- SHUFfle - shuffles the deck (alternate) -" tell then "- huck #CLEAr - removes props used by this program -" tell "- huck #CHEAt - peeks at the deck -" tell "- huck #DRAW (N) - draws a card -" tell "- 'n' specifies how many cards to draw, default of 1 -" tell trigger @ name "draw" instring if "- DRAW (n) - draws a card (alternate) -" tell then "- huck #LOOK - quietly look at your hand again -" tell "- huck #RULEs - a refresher on the rules for Hexes -" tell "- huck #HAND - show your hand to the room -" tell "- huck #REFerence - a refresher on Huckster winning hands -" tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell ; () : huckster-rules "-=-+-=-+-=-+-=-+ Deadlands Huckster Rules +-=-+-=-+-=-+-=-" tell "- Deadlands is (c) Pinnacle Games / www.peginc.com -" tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell "- HEXES: To cast a Hex, the Trait type of the Hex -" tell "- determines what die type you use, and Hexslingin' -" tell "- determines how many dice you roll. Example: You cast -" tell "- 'Trinkets', based on Knowledge, your Knowledge die -" tell "- type is d10, and your Hexslingin' level is 5. So, you -" tell "- type 'dlroll 5d10' and note the result. -" tell "- If you Botch, you suffer Backlash. If you can't beat 5, -" tell "- the Hex fails. If you get 5 or better, you get to -" tell "- draw 5 cards. For every Raise of 5 you get over your -" tell "- TN of 5, you get to draw an extra card, IF YOU WANT. -" tell "- Try to build a winning hand, to beat the minimum hand -" tell "- specified for the Hex. Red Jokers are wild. Black -" tell "- Jokers are wild, but also cause Backlash. -" tell "- TRICKS: A Trick costs you 2 Wind, and you roll as above -" tell "- and Black Jokers and Botches still cause Backlash. -" tell "- For every 5 points you get on your roll, you may draw -" tell "- one card. If you draw ANY red card, you succeed. If -" tell "- you don't get any, you fail." tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell ; () : huckster-hands "-=-+-=-+-=-+-=-+ Deadlands Huckster Hands +-=-+-=-+-=-+-=-" tell "- Deadlands is (c) Pinnacle Games / www.peginc.com -" tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell "- From highest to lowest, here are the Huckster hands: -" tell "- ROYAL FLUSH - Ten, Jack, Queen, King, Ace, one suit -" tell "- STRAIGHT - five cards, in order, any suit -" tell "- FOUR OF A KIND - four cards, same face, any suit -" tell "- FULL HOUSE - three of one value, two of another -" tell "- FLUSH - five cards, any face, same suit -" tell "- STRAIGHT - five cards, any suit, in order -" tell "- THREE OF A KIND - three cards, same face, any suit -" tell "- TWO PAIR - two pairs, any suit -" tell "- JACKS - two cards, any suit, Jack or better -" tell "- PAIR - two cards of same value, any suit -" tell "- ACE - one Ace, any suit -" tell "- Jokers are wild, and the Black Joker causes backlash. -" tell "-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-+-=-" tell ; () : random-num ( i1 -- i2 : returns a value from 1 to i1, randomly determined ) random 1003 / ( divides "random" number by 1003 ) ( to get around low-bit random error ) swap % ( then divide by i1, take remainder ) 1 + ( and add 1 ) ; () : shuffle-msg "Shuffle the deck first. (" command @ strcat " #shuf)" strcat tell ; () : return-suit ( i -- s : returns the suit of the card ) dup 1 < over 54 > or if "Error: return-suit value out of range: " over intostr strcat tell pop "Error" exit then dup 53 = if pop "Red" exit then dup 54 = if pop "Black" exit then 1 - 13 / dup 0 = if pop "Clubs" else dup 1 = if pop "Diamonds" else dup 2 = if pop "Hearts" else dup 3 = if pop "Spades" else "ERROR (" swap intostr strcat ")" strcat then then then then ; () : is-joker? ( i1 -- i2 : returns '1' if card is a Joker ) dup 53 = swap 54 = or if 1 else 0 then ; () : return-face ( i -- s : returns face value of card ) dup 1 < over 54 > or if "Error: return-face value out of range: " over intostr strcat tell pop "Error" exit then dup 53 = over 54 = or if pop "Joker" exit then 1 - 13 % 1 + dup 13 = if pop "Ace" else dup 1 = if pop "Deuce" else dup 2 = if pop "Three" else dup 3 = if pop "Four" else dup 4 = if pop "Five" else dup 5 = if pop "Six" else dup 6 = if pop "Seven" else dup 7 = if pop "Eight" else dup 8 = if pop "Nine" else dup 9 = if pop "Ten" else dup 10 = if pop "Jack" else dup 11 = if pop "Queen" else dup 12 = if pop "King" else "Error (" swap intostr strcat ")" strcat then then then then then then then then then then then then then ; () : return-card ( i -- s : returns the name of the card ) dup 1 < over 54 > or if "Error: return-card value out of range: " over intostr strcat tell pop "Error" exit then dup 53 = if pop "Red Joker" exit then dup 54 = if pop "Black Joker" exit then dup return-suit " of " swap strcat swap return-face swap strcat ; () : hand-held ( - i : returns number of cards held ) deck @ "_huckster#" getpropstr atoi ; () : card-value ( i1 - i2 : returns card in position i1 ) deck @ "_huckster#/" rot intostr strcat getpropstr atoi ; () : suit-in-hand ( s - i : returns number of occurrences of suit - any face - in hand ) 0 hand-held 0 ( stack: suit cards-found number-cards-in-hand loop-counter ) begin 1 + over over < if pop pop swap pop break ( remove all from stack except # cards found ) then dup card-value return-suit ( stack: suit cards-found number-cards-in-hand loop-counter suit-string ) 5 pick stringcmp not if rot 1 + rot rot ( increment number of cards found ) then repeat ; () : face-in-hand ( s - i : returns number of occurrences of card - any suit - in hand ) 0 hand-held 0 ( stack: face cards-found number-cards-in-hand loop-counter ) begin 1 + over over < if pop pop swap pop break ( remove all from stack except # cards found ) then dup card-value return-face ( stack: face cards-found number-cards-in-hand loop-counter face-string ) 5 pick stringcmp not if rot 1 + rot rot ( increment number of cards found ) then repeat ; () : card-in-hand? ( s1 s2 - 0|1 : s1 = suit, s2 = face ) hand-held 0 begin ( stack: s1 s2 hand-held loop-counter ) 1 + over over < if pop pop pop pop 0 break then dup card-value return-face ( stack: s1 s2 hand-held loop-counter face-string ) 4 pick stringcmp not if ( stack: s1 s2 hand-held loop-counter ) dup card-value return-suit ( stack: s1 s2 hand-held loop-counter suit-string ) 5 pick stringcmp not if pop pop pop pop 1 break then then repeat ; () : n-of-a-kind ( s1 i - s2 : checks for pair, three-of-a-kind or four-of-a-kind ) ( excludes face 's1' if set; returns face found 's2' ) ( skips Jokers if 's1' is set to any value ) hand-held 0 ( stack: face-exclude i number-of-cards-held loop-counter ) begin 1 + over over < if pop pop pop pop "" break then dup card-value return-face dup ( stack: face-exclude i number-of-cards-held loop-counter face-found dup ) 6 pick stringcmp not if pop continue ( skip if face is excluded ) then dup "Joker" stringcmp not if 5 pick not if face-in-hand else pop continue ( skip if any face is set to exclude ) then else 5 pick not if face-in-hand jokers @ + ( add Wild Cards to count ) else face-in-hand ( ignore Jokers if exclusion is set ) then then ( stack: face-exclude i number-of-cards-held loop-counter face-in-hand ) 4 pick < not if card-value return-face swap pop swap pop swap pop break ( if requisite number found, return the face found ) then repeat ; () : royal-check ( s - i : return 'score' of how many cards of this suit ) ( are in hand for the given suit. Counts wild cards ) 0 over "Ten" card-in-hand? if 1 + then over "Jack" card-in-hand? if 1 + then over "Queen" card-in-hand? if 1 + then over "King" card-in-hand? if 1 + then over "Ace" card-in-hand? if 1 + then jokers @ + swap pop ; () : royal-flush? ( - 0 : 10, J, Q, K, A, all of one suit ) "Clubs" royal-check 4 > if 1 exit then "Diamonds" royal-check 4 > if 1 exit then "Hearts" royal-check 4 > if 1 exit then "Spades" royal-check 4 > if 1 exit then 0 ; : next-face ( s1 - s2 : returns the next higher face value ) dup "Deuce" stringcmp not if "Three" else dup "Three" stringcmp not if "Four" else dup "Four" stringcmp not if "Five" else dup "Five" stringcmp not if "Six" else dup "Six" stringcmp not if "Seven" else dup "Seven" stringcmp not if "Eight" else dup "Eight" stringcmp not if "Nine" else dup "Nine" stringcmp not if "Ten" else dup "Ten" stringcmp not if "Jack" else dup "Jack" stringcmp not if "Queen" else dup "Queen" stringcmp not if "King" else dup "King" stringcmp not if "Ace" else "" then then then then then then then then then then then then swap pop ; () : next-card-rtn ( s1 s2 i - s1 s2 i : repeated routine for below ) swap next-face swap ( figure out next card face ) 3 pick 3 pick card-in-hand? if 1 + ( if in hand, increment score ) then ; : straight-flush-score ( s1 s2 - i : counts cards that ) ( qualify as straight flush. ) ( s1 = face to start at ) ( s2 = suit to stick to ) swap 1 ( start 'score' with first card ) ( stack: suit face score ) next-card-rtn next-card-rtn next-card-rtn next-card-rtn swap pop swap pop ( clean up stack to leave only score ) ; () : straight-score ( s - i : counts cards that ) ( would qualify as a straight. ) ( s = face to start at ) 1 ( set the 'score' -- starting with 1 card ) swap next-face dup face-in-hand if swap 1 + else swap then swap next-face dup face-in-hand if swap 1 + else swap then swap next-face dup face-in-hand if swap 1 + else swap then swap next-face dup face-in-hand if swap 1 + else swap then swap pop ; () : straight-in-hand? ( s - 0|1 : looks for 5 cards in order ) ( of suit 's', or any suit if 's' is ) ( empty ) hand-held 0 ( stack: suit cards-in-hand loop-counter ) begin 1 + over over < if pop pop pop 0 break then dup card-value dup is-joker? if ( can't count up from Jokers ) pop continue then dup return-suit ( stack: suit cards-in-hand loop-counter card-value card-suit ) 5 pick stringcmp 5 pick and if pop continue ( if suit specified, skip if not proper suit ) then return-face dup "Ace" stringcmp not if pop continue ( Ace, King, Queen, Jack too high up ) then ( to start calculating a Straight, if a ) dup "King" stringcmp not if pop continue ( Royal Flush hasn't already been found ) then dup "Queen" stringcmp not if pop continue then dup "Jack" stringcmp not if pop continue then ( stack: suit cards-in-hand loop-counter card-face ) 4 pick dup not if pop straight-score jokers @ + 4 > if pop pop pop 1 break then else straight-flush-score jokers @ + 4 > if pop pop pop 1 break then then repeat ; () : straight-flush? ( - 0|1 : five cards, same suit, in order ) "Clubs" suit-in-hand jokers @ + 4 > if 1 flush-flag ! "Clubs" straight-in-hand? if 1 exit then then "Diamonds" suit-in-hand jokers @ + 4 > if 1 flush-flag ! "Diamonds" straight-in-hand? if 1 exit then then "Hearts" suit-in-hand jokers @ + 4 > if 1 flush-flag ! "Hearts" straight-in-hand? if 1 exit then then "Spades" suit-in-hand jokers @ + 4 > if 1 flush-flag ! "Spades" straight-in-hand? if 1 exit then then 0 ; () : four-of-a-kind? ( - 0|1 : determines if a hand has four-of-a-kind ) "" 4 n-of-a-kind if 1 else 0 then ; () : full-house? ( - 0|1 : three of one kind, two of another, any suit ) hand-held 5 < if ( if less than 5 cards in hand, don't even try ) 0 exit then "x" 3 n-of-a-kind dup if dup 2 n-of-a-kind if pop 1 exit ( 3 of one, 2 of another, no wild cards ) else jokers @ 0 > if pop 1 exit ( 3 of one, and at least one wild card ) else pop 0 exit ( otherwise, no chance of still making it ) then then else pop then "x" 2 n-of-a-kind dup if dup 2 n-of-a-kind if jokers @ 0 > if pop 1 exit ( two pair and a wild card ) else pop 0 exit then else jokers @ 1 > if pop 1 exit ( one pair, two wild cards, and any card ) else pop 0 exit then then else pop 0 exit ( if not even 1 pair exists without a wild card, ) then ( no hope of getting a full house ) ; () : straight? ( - 0|1 : 5 cards, any suit, in sequence ) hand-held 5 < if 0 exit ( if there aren't even 5 cards, exit ) then "" straight-in-hand? ; () : three-of-a-kind? ( - 0|1 : determines if a hand has three-of-a-kind ) "" 3 n-of-a-kind if 1 else 0 then ; () : two-pair? ( - 0|1 : determines if two pairs exist in hand ) hand-held 4 < if ( if hand doesn't even have 4 cards, don't try ) 0 exit then "x" 2 n-of-a-kind dup if ( first find any pair, sans wild cards ) 2 n-of-a-kind if ( then check for a different pair ) 1 exit then then jokers @ 1 > if ( both wild cards will guarantee two pair ) 1 exit then jokers @ 0 > if "x" 2 n-of-a-kind if 1 exit ( otherwise, a wild card, one pair and any other card ) then ( will suffice ) then 0 ; () : jacks? ( - 0|1 : determines if a pair of Jacks or better in hand ) jokers @ 1 > "Jack" face-in-hand 1 > "Queen" face-in-hand 1 > "King" face-in-hand 1 > "Ace" face-in-hand 1 > or or or or if 1 exit ( two wild cards or a pair of Jacks or better suffice ) then jokers @ 0 > if "Jack" face-in-hand 0 > "Queen" face-in-hand 0 > "King" face-in-hand 0 > "Ace" face-in-hand 0 > or or or if ( otherwise, a wild card and any one of these cards ) 1 exit ( qualifies for 'Jacks' or better ) then then 0 ; () : pair? ( - 0|1 : determines if a hand has two-of-a-kind ) "" 2 n-of-a-kind if 1 else 0 then ; () : ace? ( - 0|1 : determines if hand has at least one Ace or Wild Card ) "Ace" face-in-hand if 1 exit then jokers @ 0 > if 1 exit then 0 ; () : best-hand ( i - : returns message to indicate best hand possible ) ( if 'i' is set to 1, displays to room ) royal-flush? if "Royal Flush" else straight-flush? if "Straight Flush" else four-of-a-kind? if "Four of a Kind" else full-house? if "Full House" else flush-flag @ if ( flag calculated earlier in ) "Flush" ( straight-flush? routine ) else straight? if "Straight" else three-of-a-kind? if "Three of a Kind" else two-pair? if "Two Pair" else jacks? if "Jacks" else pair? if "Pair" else ace? if "Ace" else "(none)" then then then then then then then then then then then "Your best hand is: " over strcat tell swap if "Best hand: " swap strcat trigger @ "D" flag? not if " " swap strcat " " strcat else "(OOC) " swap strcat then tell-exclude else pop then ; () : swap-cards (i1 i2 - : swaps values stored in the two card positions ) over over = if pop pop exit ( if positions are same, do nothing ) then over card-value ( get first value ) over card-value ( get second value ) ( stack should be: i1 i2 value1 value2 ) deck @ "_huckster#/" 6 pick intostr strcat ( stack: i1 i2 value1 value2 deck string ) rot intostr 1 addprop ( put second value in first position ) ( stack should be: i1 i2 value1 ) deck @ "_huckster#/" 4 pick intostr strcat ( stack: i1 i2 value1 deck string ) rot intostr 1 addprop ( put first value in second position ) pop pop ; () : display-cards (i1 i2 - : show list of cards from 1 to i2 ) deck @ "_huckster#" getpropstr not if pop pop shuffle-msg exit then ( set i1 to '1' for show mode - message to user only ) dup 1 < over 54 > or if "Error (display-cards): invalid value - " swap intostr strcat tell pop exit then over if "You show the following cards:" tell trigger @ "D" flag? if "(OOC) " me @ name " displays the following cards:" strcat strcat loc @ me @ notify_except else " " me @ name " displays the following cards:
" strcat strcat tell-exclude then then 0 begin 1 + over over < if pop pop break then dup card-value return-card over intostr ") [" strcat 3 pick card-value intostr strcat "] " strcat swap strcat ( stack should be: i1 i2 counter text ) dup tell 4 pick if trigger @ "D" flag? not if "
" strcat else "(OOC) " swap strcat then tell-exclude else pop then repeat "{end of listing}" tell (stack should be: i1 ) if trigger @ "D" flag? not if "" tell-exclude else "(OOC) {end of listing}" tell-exclude then then ; () : clean-props deck @ "_huckster#" remove_prop "Deck put away: properties cleared from " deck @ name strcat "." strcat tell trigger @ "D" flag? if "(OOC) " me @ name " puts away the Huckster deck." strcat strcat tell-exclude else " " me @ name " puts away the Huckster deck. " strcat strcat tell-exclude then ; () : shuffle-deck deck @ "_huckster#" "0" 1 addprop 0 begin ( set up props, valued from 1 to 54 ) 1 + dup 54 > if pop break then deck @ "_huckster#/" 3 pick intostr strcat 3 pick intostr 1 addprop repeat 0 begin ( sort through deck, randomly swapping cards ) 1 + dup 54 > if pop break then dup 54 random-num swap-cards repeat "Deck shuffled." tell trigger @ "D" flag? if "(OOC) " me @ name " shuffles the Huckster deck." strcat strcat tell-exclude else " " me @ name " shuffles the Huckster deck. " strcat strcat tell-exclude then ; () : cheat deck @ "_huckster#" getpropstr not if "You can't cheat, when the deck is put away." tell shuffle-msg exit then me @ name " cheats by peeking at the entire Huckster deck." strcat trigger @ "D" flag? not if " " swap strcat " " strcat else "(OOC) " swap strcat then tell-exclude "You cheat by peeking at the entire Huckster deck." tell 0 54 display-cards ; () : show-hand deck @ "_huckster#" getpropstr dup not if pop "You don't have a hand to show." tell shuffle-msg exit then atoi dup 1 < if "You haven't drawn any cards yet." tell exit then 1 swap display-cards ( show hand to room ) "Joker" face-in-hand jokers ! ( store number of wild cards ) 1 best-hand ( calculate best hand, ) ( show to room ) ; () : look-hand deck @ "_huckster#" getpropstr dup not if pop "You don't have any cards." tell shuffle-msg exit then atoi dup 1 < if pop "You haven't drawn any cards yet." tell exit then 0 swap display-cards 0 best-hand ; () : draw-card ( s -- : displays one or more cards drawn ) atoi dup not if pop 1 then deck @ "_huckster#" getpropstr dup not if pop pop shuffle-msg exit then atoi over over + 54 > if "There aren't that many cards left in the deck." tell exit then ( stack: i1 i2 -- i1 = num cards to draw; i2 = num cards held ) dup rot + ( determine target number of total cards drawn ) ( stack: i2 {i1+i2} ) "" swap rot ( stack should be: s {i1+i2} i2 ) begin 1 + over over < if pop pop break then deck @ "_huckster#" 3 pick intostr 1 addprop deck @ "_huckster#/" 3 pick intostr strcat getpropstr atoi return-card 4 rotate dup not if pop rot rot ( put first card name on message line ) else ( stack: i1 i2 cardname messageline ) 4 pick 4 pick = if ( if this is the last card to be drawn ) " and " strcat swap strcat rot rot else ", " strcat swap strcat rot rot then then repeat "." strcat "You draw the " over strcat tell me @ name " draws the " strcat swap strcat deck @ "D" flag? not if " " swap strcat "" strcat else "(OOC) " swap strcat then tell-exclude ; () : main 0 jokers ! ( zero 'Jokers' counter ) trigger @ exit? not if "Error: This action should be triggered only by an action." tell "Trigger name: " over name strcat "(#" strcat over intostr strcat ")" strcat tell exit then trigger @ location dup thing? if deck ! else dup room? if pop me @ deck ! else "Error: This action must be located on a room or object." tell "Currently: " over name strcat "(#" strcat over intostr strcat ")" strcat tell exit then then dup "#help" stringcmp not over "#h" stringcmp not 3 pick "help" stringcmp not 4 pick "h" stringcmp not or or or if pop help exit then () (---------- check command aliases, in case they are used ) command @ 4 strcut pop dup "shuf" stringcmp not if pop shuffle-deck exit then dup "draw" stringcmp not if pop draw-card exit then pop () (---------- check for #commands ) dup 1 strcut pop "#" stringcmp not if 1 strcut swap pop ( remove leading "#" character ) then dup not if help exit ( if no command, default to "help" ) then dup 4 strcut pop "draw" stringcmp not if ( check for "draw" first ) 4 strcut swap pop "" " " subst ( remove "draw" and spaces ) draw-card exit then "" " " subst ( remove any spaces, since none are needed ) 4 strcut pop ( take only first four characters ) dup "shuf" stringcmp not if pop shuffle-deck exit then dup "look" stringcmp not if pop look-hand exit then dup "chea" stringcmp not if pop cheat exit then dup "hand" stringcmp not if pop show-hand exit then dup "help" stringcmp not if pop help exit then dup "rule" stringcmp not if pop huckster-rules exit then dup "clea" stringcmp not if pop clean-props exit then (----------- drop to first three characters ) 3 strcut pop dup "ref" stringcmp not if pop huckster-hands exit then (----------- drop to first character ) 1 strcut pop dup "h" stringcmp not if pop help exit then pop "That command is not recognized. Type '" command @ " #help' for help." strcat strcat tell ; . compile quit