Microsoft Small Basic Program Listing

' Full House Simulator 0.3
' Copyright (c) 2012-2014 Nonki Takahashi. All rights reserved.
'
' History :
' 0.3 2014-01-06 Rewrote to check full house probability. ()
' 0.2 2013-04-04 Modified for Challenge of the Month. (CZJ358-0)
' 0.1 2012-08-21 Created. (CZJ358)
'
GraphicsWindow.Title = "Full House Simulator 0.3"
GraphicsWindow.FontSize = 12
GraphicsWindow.BrushColor = "Black"
param = "left=80;top=10;caption=Times;cc=White;offset=60;length=4;"
Controls_AddTextBox()
tboxTry = retval
Controls.SetTextBoxText(tboxTry, 100)
GraphicsWindow.BrushColor = "White"
txtResult = Shapes.AddText("Result")
Shapes.Move(txtResult, 80, 40)
txtResult = Shapes.AddText("")
Shapes.Move(txtResult, 140, 40)
GraphicsWindow.BrushColor = "Black"
buttonTry = Controls.AddButton("Try", 220, 40)
Cards_Init()
ideck = 0
clicked = "False"
Controls.ButtonClicked = OnButtonClicked
While "True"
If clicked Then
clicked = "False"
nTry = Controls.GetTextBoxText(tboxTry)
nFullHouse = 0
For iTry = 1 To nTry
RecombineCards()
col = 1
row = 2
ShuffleCards()
DrawCards()
CheckCards()
Shapes.SetText(txtResult, nFullHouse + "/" + iTry)
If fullhouse Then
nFullHouse = nFullHouse + 1
Program.Delay(1500)
Else
Program.Delay(50)
EndIf
EndFor
EndIf
EndWhile
Sub OnButtonClicked
clicked = "True"
EndSub
Sub DrawCards
For i = 1 To 5
If ideck < nSuites * nNumbers Then
ideck = ideck + 1
index = deck[ideck]
field[i] = index
Cards_Move()
Cards_Open()
col = col + 1
If nNumbers < col Then
col = 1
row = row + 1
EndIf
EndIf
EndFor
EndSub
Sub CheckCards
fullhouse = "False"
kind = ""
For i = 1 To 5
num = Math.Remainder(field[i] - 1, 13) + 1
kind[num] = kind[num] + 1
EndFor
nKind = Array.GetItemCount(kind)
iKind = Array.GetAllIndices(kind)
If nKind = 2 And (kind[iKind[1]] = 2 Or kind[iKind[1]] = 3) Then
fullhouse = "True"
EndIf
EndSub
Sub RecombineCards
col = 1
row = 1
For index = 1 To nSuites * nNumbers
Cards_Close()
Cards_Move()
EndFor
EndSub
Sub ShuffleCards
' Shuffle cards
For i = 1 To nSuites * nNumbers / 2
i1 = Math.GetRandomNumber(nSuites * nNumbers)
i2 = Math.GetRandomNumber(nSuites * nNumbers)
Cards_Swap()
EndFor
ideck = 1
EndSub
Sub Cards_Init
' return cards - array for cards properties
' return nSuites - number of suites
' return nNumbers - number of numbers
width = 50
height = 70
cards["width"] = width
cards["height"] = height
cards["xs"] = 4 ' offset for suite in a card
cards["ys"] = 30
cards["xn"] = 4 ' offset for number in a card
cards["yn"] = 5
pattern = "color=DarkBlue;code=2591;"
suites["club"] = "color=Black;code=2663;"
suites["diamond"] = "color=#AA0000;code=2666;"
suites["heart"] = "color=#AA0000;code=2665;"
suites["spade"] = "color=Black;code=2660;"
numbers = "1=A;2=2;3=3;4=4;5=5;6=6;7=7;8=8;9=9;10=10;11=J;12=Q;13=K;"
nSuites = Array.GetItemCount(suites)
nNumbers = Array.GetItemCount(numbers)
iSuites = Array.GetAllIndices(suites)
GraphicsWindow.BackgroundColor = "#004400"
GraphicsWindow.PenWidth = 0
GraphicsWindow.FontName = "MS UI Gothic"
GraphicsWindow.Width = (width + 10) * nNumbers + 10
GraphicsWindow.Height = (height + 10) * (nSuites + 1) + 10
col = 1
row = 1
x0 = 10
y0 = 10
sHex = pattern["code"]
Math_Hex2Dec()
pChar = Text.GetCharacter(iDec)
For s = 1 To nSuites
suite = iSuites[s]
sHex = suites[suite]["code"]
Math_Hex2Dec()
sChar = Text.GetCharacter(iDec)
For n = 1 To nNumbers
index = index + 1
deck[index] = index
GraphicsWindow.BrushColor = "White"
cards[index]["oCard"] = Shapes.AddRectangle(width, height)
GraphicsWindow.BrushColor = suites[suite]["color"]
GraphicsWindow.FontSize = 28
cards[index]["oSuite"] = Shapes.AddText(sChar)
cards[index]["oNumber"] = Shapes.AddText(numbers[n])
GraphicsWindow.BrushColor = "White"
cards[index]["oCard2"] = Shapes.AddRectangle(width, height)
GraphicsWindow.BrushColor = pattern["color"]
GraphicsWindow.FontSize = 60
cards[index]["oPattern"] = Shapes.AddText(pChar)
Cards_Move()
EndFor
EndFor
EndSub
Sub Cards_Close
' param index
Shapes.ShowShape(cards[index]["oCard2"])
Shapes.ShowShape(cards[index]["oPattern"])
EndSub
Sub Cards_Open
' param index
Shapes.HideShape(cards[index]["oPattern"])
Shapes.HideShape(cards[index]["oCard2"])
EndSub
Sub Cards_Move
' param index - index of a card
' param col, row - position to move
cards[index]["col"] = col
cards[index]["row"] = row
x = x0 + (col - 1) * (width + 10)
y = y0 + (row - 1) * (height + 10)
Shapes.Move(cards[index]["oCard"], x, y)
Shapes.Move(cards[index]["oSuite"], x + cards["xs"], y + cards["ys"])
Shapes.Move(cards[index]["oNumber"], x + cards["xn"], y + cards["yn"])
Shapes.Move(cards[index]["oCard2"], x, y)
Shapes.Move(cards[index]["oPattern"], x + cards["xn"], y + cards["yn"])
EndSub
Sub Cards_Swap
' param i1, i2 - indices of two cards
index = deck[i1]
deck[i1] = deck[i2]
deck[i2] = index
EndSub
Sub Math_Hex2Dec
' Math | Convert hexadecimal to decimal
' param sHex
' return iDec
iDec = 0
iLen = Text.GetLength(sHex)
For iPtr = 1 To iLen
iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1
EndFor
EndSub
Sub Controls_AddTextBox
' Controls | Add text box with caption
' param["left"] - the x co-ordinate of the text box caption
' param["top"] - the y co-ordinate of the text box
' param["caption"] - caption of the text box
' param["offset"] - optional offset for the text box from the left
' param["length"] - optional character length for the text box
' param["cc"] - optional caption color
' return retval - the text box just added
fs = GraphicsWindow.FontSize
len = Text.GetLength(param["caption"])
If param["cc"] <> "" Then
bc = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = param["cc"]
EndIf
tboxCaption = Shapes.AddText(param["caption"])
Shapes.Move(tboxCaption, param["left"], param["top"] + fs * 0.2)
If param["cc"] <> "" Then
GraphicsWindow.BrushColor = bc
EndIf
offset = param["offset"]
If offset = "" Then
offset = len * fs * 0.9
EndIf
retval = Controls.AddTextBox(param["left"] + offset, param["top"])
tboxLen = param["length"]
If tboxLen <> "" Then
tboxWidth = (tboxLen + 1) * fs * 0.9
tboxHeight = fs * 2
Controls.SetSize(retval, tboxWidth, tboxHeight)
EndIf
EndSub