RosettaCodeData/Task/Deal-cards-for-FreeCell/FutureBasic/deal-cards-for-freecell.basic
2025-08-11 18:05:26 -07:00

143 lines
2.9 KiB
Text

//
// Dealcards for FreeCell
//
// FutureBasic 7.0.34, August 2025 R.W.
//
//------------------------------------------
dim as long seed // random seed
dim cards(52) as long // full deck of cards
CFStringRef ranks (13) = {@"ranks",@"A",@"2",@"3",@"4",@"5", ¬
@"6",@"7",@"8",@"9",@"T",@"J",@"Q",@"K"}
CFStringRef suits (5) = {@"suits",@"C",@"D",@"H",@"S"}
long UniC(5) = {0,127185,127169,127153,127137}
Boolean pUni
// Convert dec to hex unicode
local fn DecToHexUni(d as long) as CFStringRef
CFStringRef myHexUni
myHexUni = hex(d)
myHexUni = concat(@"\\U",myHexUni)
end fn = myHexUni
// display a card at the current position
// if "useUni" is true, the emoji icon is used
// else the string in variable "card" is used
local fn dispC(useUni as boolean, card as CFStringRef)
int suite
long d, baseN, baseR, rank
CFStringRef myUNIcode, disp //, card
CFStringRef srank, ssuite
srank = left(card,1) // A = 1,2 = 2 ... T = 10, 11 = Q
ssuite = right(card,1) //CDHS C=1 D=2 H=3 S=4
suite = 4
Select ssuite
case @"C"
suite = 1
case @"D"
suite = 2
case @"H"
suite = 3
end select
baseN = uniC (suite)
baseR = ucc(srank) - 48
rank = baseR
if baseR > 9
select case baseR
case 17
rank = 1
case 36
rank = 10
case 26
rank = 11
case 33
rank = 12
case 27
rank = 13
end select
else
rank = baseR
end if
if useUni //user wanted in UniCode
d = baseN + rank
d = d - 1
if (d > BaseN + 10) then d++ // skip the "C" emoji
myUNIcode = fn DecToHexUni(d)
disp = fn StringByApplyingTransform( myUNIcode, @"Any-Hex", YES )
text @"Menlo", 64 // size to your liking (hard to see if small)
print @disp;
else
text @"Menlo", 12
print @card;" ";
end if
end fn
// Get a random seed from the generator
local fn rndGen as long // RNG
seed = (seed * 214013 + 2531011) and 0x7FFFFFFF
end fn = int( seed / 65536 )
// Deal the deck. At entry gameNum = game number
local fn deal(gameNum as long)
dim as long i, j
// Build a reverse deck
seed = gameNum
for i = 0 to 51
cards(i) = 52 - i
next
// deal randomly from seed
for i = 1 to 51
dim as long r
r = fn rndGen
j = 52 - (r mod (53 - i))
Swap cards(i), cards(j)
next i // until no more
end fn
//
// Display the deck
local fn show
dim as long idx, rank, suit
CFStringRef tmp
tmp = @""
for idx = 1 to 52
rank = int(cards(idx) / 4) + 1
suit = (cards(idx) mod 4) + 1
tmp = concat(ranks(rank),suits(suit))
fn dispC(pUni, tmp)
if ((idx) mod 8) == 0 then print
next
end fn
//-------- MAIN ---------
window 1,@"Deal cards for FreeCell"
dim as long gameNum
pUni = _False // default to text
print
text @"Menlo", 12
gameNum = 1
fn deal(gameNum)
print @"Game #"; gameNum
fn show
print @
print @
text @"Menlo", 12
gameNum = 617
fn deal(gameNum)
print @"Game #"; gameNum
fn show
print @
handleEvents