/* deal.rex -- deals 52 cards to 4 hands
usage
rexx deal
*/
if arg(1) <> '' then
signal usagemsg
hand. = '' /* this compound variable holds dealt hands */
call dealCards
call displayUsingBridgeFormat
exit 0
/* the 'convertCard' procedure converts 10, 11, 12, 13 to Jack, Queen, King, Ace */
convertCard : procedure
return word( 'A 2 3 4 5 6 7 8 9 10 J Q K', 1 + ( arg(1) // 13 ) )
/* the 'dealCards' procedure assigns cards to hands */
dealCards : procedure expose hand.
cards = shuffleCards()
/* assign cards to hands */
do i=1 for 4
call getHand i, subword( cards, 13 * ( i - 1 ) + 1, 13 )
end
return
/* the 'displayUsingBridgeFormat' procedure shows hands in Bridge format */
displayUsingBridgeFormat : procedure expose hand.
/* format hands as normally displayed in Bridge texts */
say
say copies( ' ', 30 ) 'North'
do i=1 for 4
say copies( ' ', 30 ) hand.1.i
end
say 'West' copies( ' ', 50 ) 'East'
do i=1 for 4
say left( hand.2.i, 55 ) hand.3.i
end
say copies( ' ', 30 ) 'South'
do i=1 for 4
say copies( ' ', 30 ) hand.4.i
end
return
/* the 'getHand' procedure prepares a hand of cards */
getHand : procedure expose hand.
arg n, cards
/* sort cards in this hand from highest to lowest .. queue results */
cards = sortDescending( cards )
/* assign cards to suits */
suit. = ''
do i=1 for 13
card = word( cards, i )
whichSuit = 1 + ( ( card - 1 ) % 13 )
suit.whichSuit = suit.whichSuit convertCard( card )
end
/* a PC console window shows binary 3..6 as card suit images */
suitImage = d2c( 6 ) d2c( 3 ) d2c( 4 ) d2c( 5 ) /* spade heard diamond club */
do whichSuit=1 to 4
hand.n.whichSuit = word( suitImage, whichSuit ) suit.whichSuit
end
return
/* the 'getWords' procedure assigns words to stem WORD. */
getWords : procedure expose word.
s = arg(1)
word.0 = words( s )
do i=1 for words( s )
word.i = word( s, i )
end
return word.0
/* the 'shuffleCards' procedure deals 52 cards in a random sequence */
shuffleCards : procedure
cards = ''
do 52
do forever
newCard = random( 1, 52 )
if wordpos( newCard, cards ) = 0 then do
cards = cards newCard
leave
end
end
end
return cards
/* the 'sortDescending' procedure sorts words in descending numeric order */
sortDescending : procedure
word. = ''
call getWords arg( 1 )
/* shell sort */
do n = 1 to 3 /* 3 passes */
incr = 2**n - 1
do j = incr + 1 to word.0
i = j - incr
xchg = word.j
do while xchg > word.i & i > 0
m = i + incr
word.m = word.i
i = i - incr
end /* do while xchg ... */
m = i + incr
word.m = xchg
end j /* do j = incr ... */
end n /* do n = 1 ... */
return stringWords()
/* the 'stringWords' procedure ravels the words in WORD. */
stringWords : procedure expose word.
string = ''
do i=1 for word.0
string = string word.i
end
return strip( string, 'L' )
/* usage information */
usagemsg :
say 'No arguments are expected'
say ''
say 'Usage'
say ' rexx deal'
|
