This is a Christmas gift, for all M2000 funs. Revision 4. I found an error, when a new suffle take place, indexes for Pack showing other cards, so now i don't save indexes but copies of objects OneCard.
Addition for some info about Inventories used here. An inventory is a list of keys, or keys and values. They are reference type, so if we pass them by value, only pointer copied, so is like reference (except when we change the pointer, the variable in the caller can't change, so if we pass it by reference using & then we can change the caller's variable too).
Inventories can be handled by keys or by indexes starting from 0. When we want indexes we have to indicate this using symbol !. So If you see symbol ! then you know that there an inventory handled by index.
Keys can be numbers too, but converted to string inside inventory. When we sort inventories using "number" option, then numbers inside strings compared as numbers, so alfa10 and alfa9 can be compared and alfa9<alfa10 because compare function find 9<10 as numbers. If we sort as text then "alfa9">"alfa10". Here we don't need a sort. But we need to suffle the array Pack() and at a time that we have cards in table, so we can't hold references (indexes to Pack()), but we can hold copies of group objects, which Class OneCard (as group factory) make. There is no clone specific function for groups, because groups are value types, so copy is the default behavior. We can think about groups as structures in C# with functions (here functions/modules). We can make groups to take values other than groups, and to give values other than self. Also we can make groups in groups, and one superclass for each group including inner groups. So this is like multiple inheritance, but spread each one in a group inside group, plus one for the group itself. Also here there is no need to make superclass or something extra for OneCard. We have only two variables, the suit and the Card, as indexes to Suits and Cards inventories. We use keys and values, using the indexes, on these inventories. We want to display the card as a suit and a name like ♠jack but we want to choose color for suit and for each card we need the value of it.
In inventories we can put anything except modules. Some of them maybe are reference type and some other are value type. Each item in inventory is a Variant type (a type of VB6 but used in automation with COM objects too). This type can hold many types, but in M2000 a subset used. So we can use it like a double, or like a string, or like an object.
Look PrintCard(k), it is a sub. Inside we need to get keys from the inventories using Eval$( pointer to inventory, number base zero for indexes). Because group is inside Pack() we have to "unfloat" it, which means to bind to code, because inside array (and in any M2000 container), group is closed, hidden from code, we can't get reference to it, and all members are in a personal list inside group. So when we use For object { } we get a named group, (we use This as name). When bracket closed, then object "captured" to array position.
Swapping variants in Arrays is easy, so we use Swap array items to gain speed. And these items are closed or float Groups (the object which return from a C;ass function, or using the Group command).
As you can see this is just a module, and has a number of Subs. Each sub can see module's variables, has local variables, and any local can hide module's same named variable. Local variables get out of scope when sub return (in End Sub or in Exit Sub).
I use here Key$ which wait for a keypress (is not blocking for threads or other events in M2000), and then translate it in char based of keyboard language state. We can use Keypress() to read specific key, using codes for keys, not for letters. Because keypress return immediately, we have to put it in a loop. In this example I use Key$ with like operator ~. So I have in a string and in [ ] characters, and this work like an Instr() function.
You may find a mysterious Print Over. Print command without explicit notice, prints letters/symbols with transparent background. Print Over first erase th current line, so make Print to print in a clear line. Except of that, this variant of Print make letter printing using proportional mode, and set column same as the width of console. Also we can print in a with much bigger than the width, simply using @(value as hor. position) and a comma after. to move cursor in and out of the line (but not out of the row). Clearing character line done leaving as is the bottom line. There is another variant Print Under which first draw a line (so fill the "gap" which Print Over left) and another one the Print Part, which do nothing for background. These two variations of Print (Under and Part) use the same column width as a normal print. Using @() inside print for moving cursor and $() for setting column width from position (so we can divide a text row in multi width columns). Here we just want Print Over to display a per cent indicator.
\\ Dealer get one
hidden and one open Card
\\ Player get two open cards
\\ no split or other function. We can get a new Card only if we don't busting.
\\ Standard bet 100 credits. No split in this version. And for one player only
\\ Dealer serves one open Card to player, one to him,
\\ Then a second to player and a face down for him.
Font "Arial"
\\ Player get two open cards
\\ no split or other function. We can get a new Card only if we don't busting.
\\ Standard bet 100 credits. No split in this version. And for one player only
\\ Dealer serves one open Card to player, one to him,
\\ Then a second to player and a face down for him.
Font "Arial"
Form 50,40
Form \\ cut border
Cls 7
Print $(4)
inventory Suits = "♠":=0, "♥":=4, "♦":=4, "♣":=0 'suit -> color
inventory Cards = "two":=2, "three":=3, "four":=4, "five":=5
Append Cards, "six":=6, "seven":=7, "eight":=8, "nine":=9
Append Cards, "ten":=10, "jack":=10, "queen":=10, "king":=10, "ace":=1
Class OneCard {
suit, Card
Class:
Module OneCard {
\\ ? for optional reading
read ? .suit, .card
}
}
\\ 2X52 cards
Dim Pack(Len(Cards)*Len(Suits)*2) \\ not used here =OneCard()
Pen 1
Double
Pen 14 {Report 2, "BlackJack"}
Normal
Cls, 2
k=0
\\ fill cards to Pack()
For times=2 To 1 {
N=each(Suits)
While N {
M=each(Cards)
While M {
Pack(k)=OneCard(N^, M^)
k++
}
}
}
Rem : DisplayAll() ' in order
Suffle()
Rem : DisplayAll() ' at random positions
' first cut for player
Print "Make a Cut: 0-51:";
Repeat {
N1=Random(0,51)
Try {
Input ! N1, 10
}
} Until N1>=0 and N1<=51
Print N1
\\ used to pass the Dealer's hidden Card
Hidden=OneCard(-1,-1)
DealerHidden=OneCard(-1, -1)
PlayerFaceUp2nd=OneCard(-1, -1)
Bet=100
PlayerMoney=10000
Def Val$(x)=If$(x=-1 -> "Black Jack", Str$(x,""))
Repeat {
If PlayerMoney<Bet Then Print "You run out of money...Bye Bye" :Exit
Print "Player Money:", PlayerMoney
Print "Play Game ?(Y/N)"
Clear dealervalue, playervalue
Inventory queue DealerCards, PlayerCards
If Key$ ~ "[NnΝν]" Then Exit
Print "Player Hand: 1st Card"
PlayerCard(&playervalue, PlayerCards)
Print "Dealer Hand: 1st Card"
DealerCard(&dealervalue)
Print "Player Hand: 2nd Card"
NextCard()
PlayerFaceUp2nd=Pack(N1)
PrintCard2(N1)
Print "Dealer Hand: 2nd Card"
NextCard()
Print @(10), "Face Down Card"
DealerHidden=Pack(N1)
' now if dealer face up Card is Ace or 10 or Figure can see if has a black jack
N2=Cards(Pack(N1).card!)
If N2=10 and Cards(DealerCards(0!).card!)=1 Then : DealerBlackJack():Restart
If N2=1 and Cards(DealerCards(0!).card!)=10 Then : DealerBlackJack():Restart
Print "Player Play"
Print "Player Hand:"
Hidden=PlayerFaceUp2nd : PlayerFaceUp2nd=OneCard(-1, -1)
PrintCard2(PlayerCards(0!)) ' show first Card
PlayHand(PlayerCards,&playervalue, False, False)
If playervalue<22 Then {
Print "Dealer Play"
PrintCard2(DealerCards(0!))
Hidden=DealerHidden : DealerHidden=OneCard(-1, -1)
PlayHand(DealerCards,&dealervalue, true, playervalue=-1)
If dealervalue=-1 Then {
Print "Sorry dealer win"
PlayerMoney-=Bet
} Else.If dealervalue>playervalue And dealervalue<22 And playervalue<>-1 Then {
Print "Dealer Win"
PlayerMoney-=Bet
} Else.If dealervalue>21 Or dealervalue<playervalue Or playervalue=-1 Then {
Print "Player Win", Bet-Bet/2*(playervalue=-1) : PlayerMoney+=Bet-Bet/2*(playervalue=-1)
}
Print format$("Player {0} Dealer {1}", Val$(playervalue), Val$(dealervalue)) ' Val$() is user function.
} Else Print "Dealer Win" : PlayerMoney-=Bet
} Always
End
Sub Suffle()
Local N=Len(Pack())-1, N2, i, j, total=N*4+4, cur=1
For j=1 To 4 {
For i=0 To N {
If cur Mod 4=3 Then Print Over format$("Suffle {0:0}%",cur/total*100)
N2=random(0, N)
While N2=i {N2=random(0, N)}
Swap Pack(i), Pack(N2)
cur++
}
}
End Sub
Sub DisplayAll()
For k=0 To Len(Pack())-1 {
PrintCard(k)
}
End Sub
Sub PrintCard(k)
For Pack(k) {
Pen Suits(.suit!) {
Print Eval$(Suits, .suit)+Eval$(Cards, .card),
}
}
End Sub
Sub PrintCard2(k)
For Pack(k) {
Pen Suits(.suit!) {
Print Part @(10), Eval$(Suits, .suit)+Eval$(Cards, .card)
}
}
End Sub
Sub PrintCard3(k)
For k {
Pen Suits(.suit!) {
Print Part @(10), Eval$(Suits, .suit)+Eval$(Cards, .card)
}
}
End Sub
Sub NextCard()
N1++
If N1>=Len(Pack()) Then {
Suffle()
N1=Random(0,51)
}
End Sub
Sub PlayerCard(&acc, MyCards)
Local N2
NextCard()
PrintCard2(N1)
N2=Pack(N1).card
acc+=Cards(N2!)
Append MyCards, len(MyCards):=Pack(N1)
End Sub
Sub DealerCard(&acc)
Local N2
NextCard()
N2=Pack(N1).card
Append DealerCards, len(DealerCards):=Pack(N1)
PrintCard2(N1)
acc+=Cards(N2!)
End Sub
Sub PlayHand(MyCards, &acc, nomessage, sorryblackjack)
Local N2, morevalues=0, ok
If MyCards(0!).card=12 Then morevalues=10
Repeat {
If Hidden.suit>=0 Then {
N2=Hidden.card
PrintCard3(Hidden)
Append MyCards, Len(MyCards):=Hidden
Hidden=OneCard(-1, -1)
} Else {
NextCard()
PrintCard2(N1)
N2=Pack(N1).card
Append MyCards, Len(MyCards):=Pack(N1)
}
If N2=12 Then {
If morevalues=0 Then {
morevalues=10
} Else N2=13 : morevalues=-50
}
If acc=10 And N2=12 And Len(MyCards)=2 Then acc=-1: Pen 15 {Print "BlackJack" }: Exit
If morevalues>0 And Cards(if(N2<13 -> N2, 1)!)=10 And Len(MyCards)=2 Then acc=-1: pen 15 {Print "BlackJack" } : Exit
If N2<=12 Then {
acc+=Cards(N2!)
} Else acc+=11
If sorryblackjack Then Exit
If acc>21 Then Print "Busting" : Exit
If acc=21 Then Exit
If nomessage Then {
ok=acc>16 Or (acc+morevalues<22 And acc+morevalues>16)
} Else {
Print Part "Stand or Hit ?(S/H)"
ok=Key$ ~ "[SsΣσ]"
}
} Until ok
If acc=-1 Then morevalues=0
While morevalues>0 {
If acc+morevalues<22 Then Exit
morevalues-=10
}
If morevalues<0 Then Exit Sub
acc+=morevalues
End Sub
Sub DealerBlackJack()
Pen 15 {Print "BlackJack" }
Print "Dealer Win"
PlayerMoney-=Bet
End Sub
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.