RosettaCodeData/Task/Poker-hand-analyser/FutureBasic/poker-hand-analyser.basic
2025-02-27 18:35:13 -05:00

349 lines
8.9 KiB
Text

include "Tlbx GameplayKit.incl"
_window = 1
_Deal = 100
_Four = 101
_Full = 102
_flush = 103
_straight = 104
_SFlush = 105
_NewDeck = 106
begin globals
int gOmit(52)
int gCount = 1
int gDeck(4,13)
CFStringRef gSpecial(5)
bool gInsert = NO
bool gNewDeck = NO
end globals
local fn Set
for int x = 1 to 52):gOmit(x) = x:next
end fn
//Ken's code
local fn MyImageDrawingHandler( r as CGRect, userData as ptr )
AttributedStringDrawAtPoint( userData, fn CGPointMake(0,0) )
end fn = YES
local fn StringToImage( string as CFStringRef, font as FontRef, color as ColorRef ) as ImageRef
CFDictionaryRef attributes = @{NSFontAttributeName:font,NSForegroundColorAttributeName:color}
CFMutableAttributedStringRef aString = fn MutableAttributedStringWithAttributes( string, attributes )
end fn = fn ImageWithDrawingHandler( fn AttributedStringSize( aString ), NO, @fn MyImageDrawingHandler, aString )
local fn ConvertValueToEmoji( value as long ) as CFStringRef
UInt32 unicodeInt
ScannerRef scanner = fn ScannerWithString( fn StringWithFormat( @"0x%X", value ) )
fn ScannerScanHexInt( scanner, @unicodeInt )
end fn = fn StringWithBytes( @unicodeInt, 4, NSUTF32LittleEndianStringEncoding )
void local fn BuildWnd
int height = 800
CGrect rr = fn CGRectMake( 0,0,500,height)
window _window, @"Assess Poker Hands" , rr
rr = fn CGRectMake( 10, 60, 90, 26 )
button _Four,,,@"4 of kind", rr
rr = fn CGRectOffset( rr, 90, 0 )
button _Full,,,@"Full House", rr
rr = fn CGRectOffset( rr, 90, 0 )
button _Flush,,,@"Flush", rr
rr = fn CGRectOffset( rr, 90, 0 )
button _straight,,,@"Straight", rr
rr = fn CGRectOffset( rr, 90, 0 )
button _sFlush,,,@"S Flush", rr
rr = fn CGRectMake( 120, 20, 100, 26)
button _Deal,,,@"Deal Hand", rr
rr = fn CGRectMake( 240, 20, 200, 26)
checkbox _NewDeck,,,@"New deck each time", rr
textlabel 2,@"Row of buttons to prove the rare hands assess correctly", ( 40, 90, 380, 26 )
end fn
void local fn SetDeck
int x,y
for x = 1 to 13
for y = 0 to 3
gDeck(y,x) = (y*13 + 1) + x - 1
next
next
end fn
local fn SetCards
NSUInteger i, index, c, j = 1
CFMutableArrayRef NumbArr = fn MutableArrayNew
index = 0 : c = 0
for i = 127137 to 127199
if ( c == 11 )
c++
else
MutableArrayInsertObjectAtIndex( NumbArr, fn StringWithFormat(@"%ld;%d", i, j), index )
index++
c++
j++
end if
if c mod 14 == 0 && i != 127198 then c = 0 : i += 2
next
AppSetProperty( @"Numbers",fn ArrayWithArray( NumbArr ) )
CFArrayRef Numbers = fn AppProperty( @"Numbers" )
AppSetProperty( @"NoShuffled",fn ArrayShuffledArray( Numbers ))
end fn
local fn GetRandomNo as int
int j,item
Bool check = NO
do
j = rnd( 52 )
if gOmit(j) > -1
item = j
gOmit(j) = -gOmit(j)
check = YES
end if
until check == YES
end fn = item
clear local fn AssessHand( cNo(5) as int) as CFStringRef
CFStringRef answer = @"High Card"
int x,y,check
int w,b,col,row,ans(5)
bool checked
//Sort cards lowest to highest
for x = 1 to 5
for y = x+1 to 5
if cNo(y) < cNo(x) then Swap cNo(x), cNo(y)
next
next
b = 20
for w = 1 to 5
for x = 5 to 1 step -1
for col = 13 to 1 step -1
for row = 3 to 0 step -1
if cNo(x) == gDeck(row,col)
if col < b
ans(x) = col
b = 20
else
end if
end if
next
next
next
next
for x = 1 to 5
for y = x+1 to 5
if ans(y) < ans(x) then Swap ans(x), ans(y)
next
next
//Check for pair, two pair, three of a kind, Four of a kind
if ans(1) == ans(2) && ans(2) == ans(3) && ans(3) == ans(4) then answer = @"Four of a Kind":Exit fn = answer
if ans(2) == ans(3) && ans(3) == ans(4) && ans(4) == ans(5) then answer = @"Four of a Kind":Exit fn = answer
if ans(1) == ans(2) && ans(2) == ans(3) && ans(4) == ans(5) then answer = @"Full House":Exit fn = answer
if ans(1) == ans(2) && ans(3) == ans(4) && ans(4) == ans(5) then answer = @"Full House":Exit fn = answer
if ans(1) == ans(2) && ans(2) == ans(3) then answer = @"three of a kind":Exit fn = answer
if ans(2) == ans(3) && ans(3) == ans(4) then answer = @"three of a kind":Exit fn = answer
if ans(3) == ans(4) && ans(4) == ans(5) then answer = @"three of a kind":Exit fn = answer
if ans(1) == ans(2) && ans(3) == ans(4) then answer = @"two pair":Exit fn = answer
if ans(1) == ans(2) && ans(4) == ans(5) then answer = @"two pair":Exit fn = answer
if ans(1) == ans(2)|| ans(3) == ans(2)|| ans(3) == ans(4) || ans(4) == ans(5) then answer = @"Pair":Exit fn = answer
//Check for Straight Flush
if (cNo(1) < 10 && cNo(1) > 0 ) || (cNo(1) < 23 && cNo(1) > 13) || (cNo(1) < 36 && cNo(1) > 26)|| (cNo(1) < 49 && cNo(1) > 39)
if cNo(2) != cNo(1) + 1
else
if cNo(3) != cNo(2) + 1
else
if cNo(4) != cNo(3) + 1
else
if cNo(5) != cNo(4) + 1
else
answer = @"Straight Flush"
exit fn = answer
end if
end if
end if
end if
end if
//Check for flush
if (cNo(1) < 10 && cNo(1) > 0 ) || (cNo(1) < 23 && cNo(1) > 13) || (cNo(1) < 36 && cNo(1) > 26)|| (cNo(1) < 49 && cNo(1) > 39)
check = 1
if (cNo(1) < 10 && cNo(1) > 0 )//Spades
for x = 2 to 5
if cNo(x) < 13 && cNo(x) > 0
check++
end if
next
if check == 5 then answer = @"Flush of Spades" : Exit fn = answer
end if
if (cNo(1) < 23 && cNo(1) > 13 )//Hearts
for x = 2 to 5
if cNo(x) < 27 && cNo(x) > 13
check++
end if
next
if check == 5 then answer = @"Flush of Hearts" : Exit fn = answer
end if
if (cNo(1) < 36 && cNo(1) > 26)//Diamonds
for x = 2 to 5
if cNo(x) < 40 && cNo(x) > 26
check++
end if
next
if check == 5 then answer = @"Flush of Diamonds" : Exit fn = answer
end if
if (cNo(1) < 49 && cNo(1) > 39)//Clubs
for x = 2 to 5
if cNo(x) < 53 && cNo(x) > 39
check++
end if
next
if check == 5 then answer = @"Flush of Clubs" : Exit fn = answer
end if
end if
//Check for Straight
//Find lowest card ignoring suit
for x = 5 to 2 step -1
if (ans(x) - ans(x-1)) == 1
checked = YES
else
checked = NO
exit next
end if
next
if checked == YES
answer = @"straight"
end if
end fn = answer
clear local fn DealHand
CFArrayRef Numb = fn AppProperty( @"NoShuffled" )
CFStringRef Ans,card,Number
int x, item, CardNo(5), y
CFRange range
text @"Menlo", 72, fn ColorText
for x = 1 to 5
do
if gInsert = YES
ans = gSpecial(x)
else
item = fn GetRandomNo
Ans = Numb[ item]
end if
range = fn StringRangeOfString( Ans, @";" )
card = fn StringSubstringToIndex( Ans, range.location )
Number = fn StringSubStringFromIndex( Ans, range.location + 1)
cardNo(x) = fn StringIntValue( Number )
y = fn StringIntValue( card)
until y != 127199
if y > 127152 && y < 127185 then text,, fn ColorRed else text,,fn ColorBlack
printf @"%@\b", fn ConvertValueToEmoji( y )
next
if gNewDeck == YES then fn Set
text @"Times",24, fn ColorMagenta
printf fn AssessHand( cardNo(0))
printf @""
text @"Menlo", 72, fn ColorText
gInsert = NO
end fn
local fn Flush
gSpecial(1) = @"127155;16"
gSpecial(2) = @"127160;21"
gSpecial(3) = @"127153;14"
gSpecial(4) = @"127158;19"
gSpecial(5) = @"127163;24"
end fn
local fn Four
gSpecial(1) = @"127137;1"
gSpecial(2) = @"127169;27"
gSpecial(3) = @"127153;14"
gSpecial(4) = @"127158;19"
gSpecial(5) = @"127185;40"
end fn
local fn Full
gSpecial(1) = @"127140;4"
gSpecial(2) = @"127159;20"
gSpecial(3) = @"127175;33"
gSpecial(4) = @"127156;17"
gSpecial(5) = @"127188;43"
end fn
local fn Straight
gSpecial(1) = @"127158;19"
gSpecial(2) = @"127145;9"
gSpecial(3) = @"127191;46"
gSpecial(4) = @"127178;36"
gSpecial(5) = @"127176;34"
end fn
local fn SFlush
gSpecial(1) = @"127156;17"
gSpecial(2) = @"127158;19"
gSpecial(3) = @"127160;21"
gSpecial(4) = @"127157;18"
gSpecial(5) = @"127159;20"
end fn
void local fn doDialog(act as long, ref as long, wnd as long )
select act
case _btnClick
select ref
case _Newdeck
if fn ButtonState( _NewDeck ) == NSControlStateValueOn then gNewDeck = YES else gNewDeck = NO
case _Deal
if gCount < 11
fn DealHand
gCount++
else
cls
fn Set
fn SetDeck
fn SetCards
gCount = 1
end if
case _Flush
gInsert = YES
fn Flush
case _Four
gInsert = YES
fn Four
case _Full
gInsert = YES
fn Full
case _Straight
gInsert = YES
fn Straight
case _SFlush
gInsert = YES
fn SFlush
end select
end select
end fn
fn SetDeck
fn SetCards
fn BuildWnd
on dialog fn doDialog
HandleEvents