I want to create a chart that visually demonstrates the effects of various activities on a main event. For example if the main event is Forest Fire and the activities are temperature, wind speed, precipitation and density, what kind of chart would you use to display all this information. I've been looking at bar charts, pie charts and a scatter charts but none of them appeal to me. Do you guys use charts and if so would you recommend it?
To once again take chances handing over arguments to procedures (and functions).
A "Shared" is not necessary to access the address of a variable, as "Call by reference" is the standard access for procedures and functions in QuickBasic (QB64). "Shared" is only necessary if one want to make a variable accessible throughout the entire program.
For "AlsWert einzahlung, (zinswert), jahre" (Line 31) only the interest value is passed as a value, since this value should be changed as a copy.
Code: (Select All)
'Uebung zu Call by reference/value - 27. Nov. 2023
Option _Explicit
Declare Sub AlsWert(einzahlung As Double, zinwertn As Double, jahre As Integer)
Declare Sub AlsReferenz(einzahlung As Double, zinwertn As Double, jahre As Integer)
'einzahlung = Deposit -- zinswert = Interest value
Dim As Double einzahlung, zinswert, endkapital, q
Dim As Integer jahre
Locate 2, 2
Input "Jaehrliche Einzahlung : ", einzahlung
Locate 3, 2
Input "Hoehe der Verzinsubg : ", zinswert
Locate 4, 2
Input "Einzahlungsdauer in Jahren: ", jahre
'Berechnung des Endkapitals nach X Jahren - (Final capital after X years)
endkapital = (einzahlung * q * (((q ^ jahre) - 1) / (q - 1)))
Locate 6, 2
Print Using "Das Endkapital betraegt bei ##.##% Zinsen nach ## Jahren: ##,####.##"; zinswert, jahre, endkapital
Locate 8, 2
Print "Als Wertuebergabe (Call by value)"
Locate 9, 2
AlsWert einzahlung, (zinswert), jahre
Locate 11, 2
'The interest value was not changed (copy)
Print Using "Der Zinswert wurde nicht veraendert (Kopie): ##.##%"; zinswert
Locate 13, 2
Print "Als Referenz (Call by reference)"
Locate 14, 2
AlsReferenz einzahlung, zinswert, jahre
Locate 16, 2
'The interest value was changed because the program has access to the address of the variable.
Print "Der Zinswert wurde veraendert, da das Programm "
Locate 17, 2
Print Using "Zugriff auf die Adresse hat: ##.##%"; zinswert
End 'Hauptprogramm
Sub AlsWert (einzahlung As Double, zinswert As Double, jahre As Integer)
Dim As Double endkapital, q
zinswert = 5.7
'Zinsfaktor berechnen
q = (1 + (zinswert / 100))
'Berechnung des Endkapitals nach X Jahren
endkapital = (einzahlung * q * (((q ^ jahre) - 1) / (q - 1)))
Print Using "Das Endkapital betraegt bei ##.##% Zinsen nach ## Jahren: ##,####.##"; zinswert, jahre, endkapital
End Sub
Sub AlsReferenz (einzahlung As Double, zinswert As Double, jahre As Integer)
Dim As Double endkapital, q
zinswert = 6.75
'Zinsfaktor berechnen
q = (1 + (zinswert / 100))
'Berechnung des Endkapitals nach X Jahren
endkapital = (einzahlung * q * (((q ^ jahre) - 1) / (q - 1)))
Print Using "Das Endkapital betraegt bei ##.##% Zinsen nach ## Jahren: ##,####.##"; zinswert, jahre, endkapital
End Sub
Monster spritewalk demo.
experimenting with stacked groups of art elements in the original drawing and revealing them when needed to provide animation.
Probably not the most efficient way to do this speed-wise.
There was originally meant to be an eye animation as well but the way the art program grouped the elements made that bothersome.
If you want to slap the critter into another program I'd like to see it.
Cls
_PutImage (sx, sy), simg
_Display
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
Select Case kk$
Case "W", "w"
sy = sy - 4
earstate = earstate + 1
legstate = legstate + 1
Case "A", "a"
sx = sx - 4
earstate = earstate + 1
legstate = legstate + 1
Case "D", "d"
sx = sx + 4
earstate = earstate - 1
legstate = legstate + 1
Case "S", "s": sy = sy + 4
earstate = earstate - 1
legstate = legstate + 1
End Select
armstate = armstate + 1
If armstate = 4 Then armstate = 1
antennastate = antennastate + 1
If antennastate = 4 Then antennastate = 1
er = Int(1 + Rnd * 50)
Select Case er
Case 1
earstate = earstate + 1
Case 50
earstate = earstate - 1
End Select
If earstate > 15 Then earstate = 1
If earstate < 1 Then earstate = 11
If legstate = 4 Then legstate = 1
If sx < 0 Then sx = 0
If sx >= _Width - 128 Then sx = _Width - 128
If sy < -16 Then sy = -16
If sy >= _Height - 192 Then sy = _Height - 192
Loop Until kk$ = Chr$(27)
As is, I doubt this program will ever be of use to anyone except myself, but I thought I'd share it, in case anyone else ever has a need such as this one.
What this does is solve a massive disk organizational issue for me. As you guys might know, I'm a massive digital packrat. I collect everything -- and lots of everything. (Currently around 80TB of disk storage at my house, and before another year passes, I'll probably end up adding another drive to the mix!)
One thing I've very particular about collecting is e-books. I just love them. Can't get enough of them. Even if it's a book I won't read (such as romance), if I can grab a copy of it in digital form, then I'm going to snatch it and add it to my collection. Since I'm so particular about collecting these books, I want all my books to be able to fit into a nice directory structure so I can navigate and find what I need easily and quickly.
Unfortunately, when you download torrents of books, they're often just in file lists and not in any sort of directory structure. /blah!
This little program, as short as it is, fixes that issue!
BEFORE:
AFTER:
Others may find something like this useful, so I thought I'd share it so they could refer to this if they ever need to. As it is, unless you have a drive Z: (it's my RAM Drive for quick and dirty temp stuff, such as this, so I won't mess up the originals until I know it all is working 100% right.), this isn't going to do much for you except error out.
The books here are formatted with <Author Name> - <Series> - <Book Name> <.extension>. I use this to strip down to just <Author Name>, then make a directory with that name (if it doesn't already exist), and then move the book into that directory, where they're all together and easy to find and reference in the future.
Simple, and yet *THIS* is probably the best type of example of what I could ever say programming is for. Automate a task that might take days/weeks to be done manually, and let the machine do it in moments!
This is a program to view text files using one word at a time in rapid succession. Instead of the traditional way of reading a page of text, this displays one word at a time in rapid succession. The speed is adjustable and is adaptive to the length of the word. Your place is automatically saved when you exit the application or even when you switch text files. You can change the font, the font size, and font color from the pause menu.
x=freefile
open "c:\test.bas" for input as #x
line input #x, j$
close
? j$
Good morning or good evening or even good afternoon...
The answer to my question will certainly be simple 'Cause I'm slipping away Something obvious, but at the moment I can't figure out where the error is. Sometimes I get lost in a glass of water...
How can I turn j$ - into a string such that it can give me the result of p$ ?
This is a simple game based on the Rummy card game.
It may appeal to those who just want to relax and play an uncomplicated game.
I may have gone a bit overboard with comments, which were mostly for my own benefit while writing.
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", size, "monospace"): _Font f& ' use Monospace font
lhs = (_DesktopWidth - wwidth) / 2: top = (_DesktopHeight - wheight) / 2 ' find top and left of window
_ScreenMove lhs, top ' centre the window
cpl = _Width / _PrintWidth("X") ' find characters per line (columns)
Randomize Timer
Dim tiles(101, 2), names$(4), scores(4), hands(4, 11)
PrepTiles:
For a = 0 To 11 ' first 96 tiles letter numbers are 1 to 8 for A-H (adding 64 gives 65 to 72)
For b = 1 To 8
tiles(a * 8 + b, 1) = b
Next
Next
For a = 1 To 96 ' second parameter sets colours as 1, 2 or 3 for tile groups
If a < 33 Then tiles(a, 2) = 1 ' first 32 are red
If a > 32 Then tiles(a, 2) = 2 ' next 32 are green
If a > 64 Then tiles(a, 2) = 3 ' next 32 are magenta
Next
For a = 97 To 100: tiles(a, 1) = -22: tiles(a, 2) = 4: Next
tiles(101, 1) = -19: tiles(101, 2) = 4 ' adding 64 to -19 gives 45; chr$(45) is white - sign for vacant hand-positions
Play ok$
Intro
Scoring
GetNames ' get player names and number of players, and randomize first player
Shuffle:
For a = 1 To 99 ' shuffle 100 tiles, leave 101 as is
swop = Int(Rnd * 100) + 1
Swap tiles(a, 1), tiles(swop, 1): Swap tiles(a, 2), tiles(swop, 2)
Next
AssignTiles ' deal hands and Discard, NextTile is set to next tile after Discard (i.e. 42 with 4 players)
NewGame:
Cls
centre "New Round!", 2: Sleep 1: Cls
GetPlayer:
plr = plr + 1: If plr > np Then plr = 1
yellow: Locate 3, 1: white
For a = 1 To np
Print Tab(2); names$(a); Tab(10); scores(a)
Next
ShowHand ' show current player's hand (position 11 is vacant), and Discard below
ChoosePickUp ' player can pick Discard or from Stack
LayDown ' player can lay down a set, or hold for further improvement
LayDownDone ' finished laying down a set
CalcPoints:
FindPoints
Sleep 1: WIPE "062728": GoTo GetPlayer ' next player's turn
Sub GetNames
np = 0
GetPlayerNames:
yellow
GetAName:
_KeyClear
Cls
Locate 15, 18
Print "Name of Player"; np + 1; "(or <Enter> for no more)";: Input nm$ ' nm$ is temp name for player, np is number of players"
If nm$ = "" Then GoTo FinalName ' if no name, jump to FinalName line
nm$ = UCase$(nm$) ' capitalise name
If nm$ < "A" Then WIPE "15": Play bad$: GoTo GetAName ' if invalid name, try again
np = np + 1: names$(np) = nm$
If np = 4 Then GoTo FinalName Else Play ok$: GoTo GetAName ' max of 4 players
FinalName:
Play ok$: Play ok$
If np < 2 Then
red: centre "We need 2 to 4 players", 16: yellow: Play bad$: Sleep 1: WIPE "1516": GoTo GetPlayerNames ' ensure at least 2 players
End If
plr = Int(Rnd * np) + 1 ' randomize first player
Play ok$
Cls
End Sub
Sub AssignTiles
For a = 1 To np ' deal 10 tiles to each player
For b = 1 To 10
nexttile = nexttile + 1
hands(a, b) = nexttile
Next
hands(a, 11) = 101 ' set each player's 11th tile to tile 101 (white -)
Next
nexttile = nexttile + 1
discard = nexttile ' next tile will be the Discard
nexttile = nexttile + 1 ' move NextTile on past Discard tile
End Sub
Sub ShowHand
yellow: centre msg$, 9
msg$ = names$(plr) + " playing"
centre msg$, 10
centre "Your Hand", 12
' Print: Print Tab(24);
centre "1 2 3 4 5 6 7 8 9 10 11", 14
Locate 15, 25
For a = 1 To 11
Select Case tiles(hands(plr, a), 2) ' second parameter of tiles() sets colour of the tile
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Print Chr$(tiles(hands(plr, a), 1) + 64); " ";
Next
white: PSet (310, 300): Draw "r480d70l480u70": yellow
ShowDiscard:
Locate 18, 35: Print " Discard"
discard$ = Chr$(tiles(discard, 1) + 64)
Select Case tiles(discard, 2)
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Print Tab(39); Chr$(tiles(discard, 1) + 64) ' show Discard tile in its colour
msg$ = "Remaining Stack tiles:" + Str$(101 - nexttile)
WIPE "30": yellow: centre msg$, 30
End Sub
Sub ChoosePickUp
WIPE "01"
_KeyClear
PickupChoice:
yellow: centre "Will you pick from Stack or Discard (S or D) ?", 21
WhereFrom:
pickup$ = InKey$
If pickup$ = "" Then GoTo PickupChoice
If pickup$ = Chr$(13) Then pickup$ = "D"
pickup$ = UCase$(pickup$)
If pickup$ <> "S" And pickup$ <> "D" Then Play bad$: GoTo WhereFrom
WIPE "21"
Locate 15, 55
If pickup$ = "D" Then ' if player picks Discard...
hands(plr, 11) = discard ' transfer Discard to player's 11th tile position (don't change NextTile)
Select Case tiles(hands(plr, 11), 2) ' get its colour
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Print Chr$(tiles(hands(plr, 11), 1) + 64) ' display new 11th tile
ElseIf pickup$ = "S" Then ' or if player picks from Stack...
hands(plr, 11) = nexttile: nexttile = nexttile + 1 ' transfer NextTile to player's 11th tile position, and increment NextTile
Locate 15, 55
Select Case tiles(hands(plr, 11), 2) ' get its colour
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Print Chr$(tiles(hands(plr, 11), 1) + 64) ' display new 11th tile
End If
Play ok$
WIPE "181930": yellow: Locate 30, 28: Print "Remaining Stack tiles:"; 101 - nexttile
Sleep 1
End Sub
Sub LayDown ' setpos is the position of this tile in the set
StartSet:
ReDim set(11) ' set() will hold position in player's hand of each laid-down tile
setpos = 1: _KeyClear
GetaSetTile:
yellow
num$ = "" ' this will be the position in the player's hand
WIPE "22"
Locate 20, 12
yellow: centre "Enter a tile number to lay down for a set (Enter to finish)", 20
Locate 22, 40: Input num$
If num$ = "" Then Play ok$: Exit Sub ' if player pressed Enter, they have no more to lay down
num = Val(num$)
If num < 1 Or num > 11 Then ' validate number of the tile
Play bad$: WIPE "27": red: centre "Invalid tile-number!", 27
Sleep 1: WIPE "27": yellow
GoTo GetaSetTile ' if not 1 to 11, try again
End If
CheckLayDown:
Select Case setpos
Case Is = 1 ' first pick for the set
If tiles(hands(plr, num), 1) = -22 Then
Play bad$: red: centre "First can't be Wild!", 27
Sleep 1: WIPE "27": GoTo GetaSetTile
End If
set(1) = num ' num has been validated so accept this tile as first of set
runlow = tiles(hands(plr, num), 1): runhigh = tiles(hands(plr, num), 1) ' first num is always lowest and highest of a run
GoTo LaydownAccepted ' process the accepted lay-down tile
Case Is = 2 ' second pick of set; is already validated and we have already accepted first as set(1)
If tiles(hands(plr, num), 1) = -22 Then
Play bad$: red: centre "You must have a set before adding Wilds!", 27 ' must be at least 2 selected before Wildcard
Sleep 1: WIPE "27": GoTo GetaSetTile
End If
If num = set(1) Then
Play bad$: red: centre "Tile already picked!", 27 ' if this is the same tile as the first, reject it and get another
Sleep 1: WIPE "27": GoTo GetaSetTile
End If
CheckForSetType:
If tiles(hands(plr, set(1)), 1) = tiles(hands(plr, num), 1) Then ' if the letters on set(1) and set(2) are the same, they're a Match
settype$ = "Matches"
centre "The Set Type is Matches", 18
ElseIf Abs(tiles(hands(plr, set(1)), 1) - tiles(hands(plr, num), 1)) = 1 Then
settype$ = "Run" ' if letters on set(1) and set(2) are consecutive (1 up or 1 down), they're a Run
centre "The Set Type is Run", 18
Else
Play bad$: red: centre "These two tiles can't start a Run or Matches set!", 17
Sleep 1: WIPE "17": yellow: GoTo GetaSetTile ' if not same letter as first (for a match), or one higher than highest or one lower than lowest (for a run), it can't form a set
End If
Play ok$: yellow
If runhigh < tiles(hands(plr, num), 1) Then
runhigh = tiles(hands(plr, num), 1) ' if letter on set(1)1 is lower than letter on set(2), set runhigh to this letter
Else
runlow = tiles(hands(plr, num), 1) ' if not, set runlow to this letter
End If
set(2) = num ' accept it as set(2)
GoTo LaydownAccepted
Case Is >= 3 ' for third pick and on
If tiles(hands(plr, num), 1) = -22 Then
Play ok$: Play ok$: Print Tab(15); "WILD!": Sleep 1: Locate 23, 15: Print Space$(5)
GoTo LaydownAccepted
End If
DupTileCheck:
dup = 0
For a = 1 To 11
If num = set(a) Then dup = 1 ' if the tile number is already in the set, it's a duplicated pick
Next
If dup = 1 Then
Play bad$: red: centre "Tile already picked!", 17
Sleep 1: WIPE "17": GoTo GetaSetTile
End If
If settype$ = "Matches" Then ' if a Matches set has been started...
If tiles(hands(plr, set(1)), 1) = tiles(hands(plr, num), 1) Then ' check this laydown's letter against first of set
GoTo LaydownAccepted ' if it is the same letter, accept it for the Matches set
Else
Play bad$: red: centre "This tile is not part of your set!", 17 ' otherwise, reject it for Matches and get another
Sleep 1: WIPE "17": GoTo GetaSetTile
End If
Else ' but if a Run set has started...
dup = 0
For a = 1 To setpos
If tiles(hands(plr, num), 1) = tiles(hands(plr, set(a)), 1) Then
dup = 1
End If
Next
If dup = 1 Then
Play bad$: red: centre "Letter already picked!", 17 ' if it duplicates a Run set letter, reject for Run set and get another
Sleep 1: WIPE "17": GoTo GetaSetTile
End If
If tiles(hands(plr, num), 1) - runhigh = 1 Then ' if this letter is one letter higher than the highest in the run
runhigh = tiles(hands(plr, num), 1)
GoTo LaydownAccepted ' change runhigh to this letter and accept it
ElseIf runlow - tiles(hands(plr, num), 1) = 1 Then ' if this letter is one letter lower than the lowest in the run...
runlow = tiles(hands(plr, num), 1) '
GoTo LaydownAccepted ' change runlow to this letter and accept it
Else ' but if not exactly one higher or exactly one lower
Play bad$: red: centre "This tile is not part of your Run!", 17 ' reject it and get another
Sleep 1: WIPE "17": yellow: GoTo GetaSetTile
End If
End If
End Select
LaydownAccepted:
set(setpos) = num ' accept it into the set
white: Locate 15, 22 + num * 3: Print "-" ' replace this tile in Hand with a - symbol
Locate 25, 23 + setpos * 5: Print set(setpos) ' show the laid-down tile's hand position number
Select Case tiles(hands(plr, num), 2) ' get its colour
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Locate 23, 24 + setpos * 5
Print Chr$(tiles(hands(plr, num), 1) + 64): yellow ' display the picked tile in its colour
setpos = setpos + 1
CalcPoints
GoTo GetaSetTile
End Sub
Sub CalcPoints
tempv = 0: tileval = 0
If settype$ = "Matches" Then ' calculate base score for Matches set
For a = 1 To setpos - 1
tileval = tileval + 10
tempv = tempv + tileval
Next
ElseIf settype$ = "Run" Then ' calculate base score for Run set
For a = 1 To setpos - 1
tileval = tileval + 5
tempv = tempv + tileval
Next
Else
Exit Sub
End If
CheckForSameColour:
WIPE "27"
allsame = 1
firsttnum = hands(plr, set(1))
For a = 1 To setpos - 1
If tiles(hands(plr, (set(a))), 2) <> tiles(hands(plr, (set(1))), 2) And tiles(hands(plr, (set(a))), 2) <> 4 Then
allsame = 0
End If
Next
If allsame = 1 Then ' if they are all the same colour
tempv = tempv * 2 ' double the points value
End If
WIPE "02": centre "Points:", 2: Locate 2, 44: Print tempv
End Sub
Sub LayDownDone
yellow: Locate 30, 28: Print "Remaining Stack tiles:"; 101 - nexttile
setpos = setpos - 1 ' cancel last (unused) pick
GetThrow:
yellow
WIPE "2022"
centre "Which tile will you throw back", 20
Locate 20, 57
Input throw$
throw = Val(throw$)
Locate 27, 1
If throw < 1 Or throw > 11 Then
Play bad$: red: centre "You must throw back 1 tile!", 17
Sleep 1: WIPE "17": GoTo GetThrow
End If
For a = 1 To setpos
If throw = set(a) Then
Play bad$: red: centre "You can't throw out a Laid-down tile!", 17
Sleep 1: WIPE "17": GoTo GetThrow ' can't discard part of set, so get another throw"
End If
Next
discard = hands(plr, throw)
throw = hands(plr, 11)
yellow: Locate 30, 28: Print "Remaining Stack tiles:"; 101 - nexttile
WIPE "1820"
End Sub
Sub FindPoints
points = 0: tileval = 0: Locate 31, 24
If settype$ = "Matches" Then ' calculate score for Matches set
For a = 1 To setpos
tileval = tileval + 10
points = points + tileval
Next
Else ' calculate score for Run set
For a = 1 To setpos
tileval = tileval + 5
points = points + tileval
Next
End If
CheckForSameColour:
WIPE "27"
allsame = 1
firsttnum = hands(plr, set(1))
For a = 1 To setpos
If tiles(hands(plr, (set(a))), 2) <> tiles(hands(plr, (set(1))), 2) And tiles(hands(plr, (set(a))), 2) <> 4 Then
allsame = 0
End If
Next
If allsame = 1 Then ' if they are all the same colour
points = points * 2 ' double the points value
Locate 27, 20
Print settype$; ", all the same colour -"; points; "points"
Else
Locate 27, 23
Print settype$; ", mixed colours -"; points; "points"
End If
For a = 1 To setpos ' refill all picks from stack
hands(plr, set(a)) = nexttile
nexttile = nexttile + 1
If nexttile >= 100 Then Exit For ' if last tile drawn from stack, move on to get their throwback
Next
If setpos < 3 Then
WIPE "27": points = 0:: red: centre "Minimum set size not reached - no score!", 27: yellow
End If
Sleep 1
scores(plr) = scores(plr) + points
hands(plr, 11) = 101
If nexttile > 100 Then Finish ' if last Stock tile has been used, finish
WIPE "23252729"
End Sub
Sub Finish
Play fin$
Cls
yellow: centre "Finished!", 10: Print
Locate 12, 1
For a = 1 To np
Print Tab(30); names$(a); Tab(45); scores(a)
Next
FindWinner:
winr = 1: best = scores(1) ' assume winner is player 1
For a = 2 To np
If scores(a) > best Then best = scores(a): winr = a ' if this player's score is higher, make this player the winner
Next
Locate 14, 30: Print "Congratulations, "; names$(winr)
Sleep: System
End Sub
Sub white:
Color _RGB(255, 255, 255)
End Sub
Sub red:
Color _RGB(255, 0, 0)
End Sub
Sub green
Color _RGB(0, 255, 0)
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub magenta
Color _RGB(255, 55, 255)
End Sub
Sub WIPE (ln$) ' call with string of 2-digit line numbers only eg "0122" for lines 1 and 22
For a = 1 To Len(ln$) - 1 Step 2
wl = Val(Mid$(ln$, a, 2))
Locate wl, 1: Print Space$(73)
Next
End Sub
Sub centre (txt$, linenum)
ctr = Int(cpl / 2 - Len(txt$) / 2) + 1 ' ctr is column number for start of centred text
Locate linenum, ctr
Print txt$
End Sub
Sub Intro
yellow: centre "Rummage", 2
centre " A simple strategy game based on the card game Rummy", 3
centre "for 2 to 4 players", 4
Print
Print Tab(18);
For a = 1 To 100
Select Case tiles(a, 2)
Case Is = 1
red
Case Is = 2
green
Case Is = 3
magenta
Case Is = 4
white
End Select
Print Chr$(tiles(a, 1) + 64); " ";
If a Mod 24 = 0 Then Print: Print Tab(18);
Next
white
Locate 12, 1
Print " Rummage uses 100 tiles, the first 96 of which hold a letter"
Print " from A to H, with 4 of each letter, in each of 3 colours, as"
Print " shown above. The next four are ";: yellow: Print "Wildcards";: white: Print "."
Print " All 100 are shuffled, and the players are each dealt 10 tiles."
Print " The next tile becomes the first ";: yellow: Print "Discard";: white: Print ", and the remainder"
Print " form the ";: yellow: Print "Stack";: white: Print ".": Print
Print " Players then take turns to:"
Print " 1. Pick up a tile, either the Discard";: white: Print " or from the Stack.";
Print " 2. Lay down a set and score points, if they wish"
Print " (but they may choose to wait to form a better set)."
Print " 3. Throw back one tile, which then becomes the Discard."
Print " Their hand is re-filled from the Stack and the next player plays.": Print
Print " When the last tile is taken from the Stack by a player (either by"
Print " pick-up or re-fill of their hand) the game ends. That player can"
Print " complete their turn and this is included in their final score."
yellow: centre "Press a key", 29
Sleep: Cls
End Sub
Sub Scoring
centre "Points are scored as follows:", 2: Print
Print " Matches";: white
Print " (minimum of 3 tiles with the same letter, e.g. ";
red: Print "E";: green: Print "E";: magenta: Print "E";: green: Print "E";: white: Print ") will score"
Print " 10 points for first tile, 20 for second, 30 for third etc. So this set"
Print " scores 10+20+30+40 = 100 points.": Print: yellow
Print " Runs";: white: Print " (minimum of 3 tiles with consecutive letters, e.g. ";
magenta: Print "B";: green: Print "C";: magenta: Print "D";: magenta: Print "E";: white: Print ") will score"
Print " 5 points for first tile, 10 for second, 15 for third etc. So this set"
Print " scores 5+10+15+20 = 50 points.": Print: yellow
Print " Sets with only 2 tiles";: white: Print " are accepted, but score no points.": Print: yellow
Print " Single-Colour sets";: white: Print " score double. So ";: magenta: Print "CCCC";: white: Print " scores";
Print " (10+20+30+40)*2 = 200,"
Print " and ";: magenta: Print "CDEF";: white: Print " scores (5+10+15+20)*2 = 100.": Print: yellow
Print " Wildcards";: white
Print " are displayed as a white star, and can be added to any set"
Print " before laying it down, adding one tile to the length of that set."
Print " They may only be added after 2 or more tiles have already been chosen"
Print " for the set. The type of set (Run or Matches) is not afffected, and"
Print " Wildcards take the colour of the previous tile of the set, which means"
Print " that Single-Colour sets can include Wildcards. Multiple Wildcards may"
Print " be used in a set.": Print
Print " Sets may be kept in the hand while the player builds to form a better"
Print " set, but they have no value until laid down, and once a Set has been"
Print " laid down, it can't be changed or added to.": Print
Print " The number of Stack tiles remaining is always displayed, allowing players"
Print " to lay down any sets they still hold when the game end is near."
yellow: centre "Press a key", 31
Sleep: Play ok$: Cls
End Sub
Hello Everyone,
This is my take on the 2 - 3 player Dice Poker Board Game.
Code: (Select All)
_TITLE "Dice Poker - Programmed by Donald L. Foster Jr. - 2023"
RANDOMIZE TIMER: _MOUSESHOW "LINK"
SCREEN _NEWIMAGE(1305, 739, 256)
_PALETTECOLOR 1, _RGB32(177, 83, 0) ' Background Color
_PALETTECOLOR 2, _RGB32(205, 161, 67) ' Board Color
_PALETTECOLOR 3, _RGB32(176, 82, 0) ' Word Color
_PALETTECOLOR 5, _RGB32(120, 0, 0) ' Dice Color
_PALETTECOLOR 6, _RGB32(0, 44, 127) ' Player 1 Blue Piece Outer Color
_PALETTECOLOR 7, _RGB32(0, 64, 147) ' Player 1 Blue Piece Inner Color
_PALETTECOLOR 8, _RGB32(166, 78, 0) ' Player 2 Orange Piece Outer Color
_PALETTECOLOR 9, _RGB32(249, 100, 0) ' Player 2 Orange Piece Inner Color
_PALETTECOLOR 10, _RGB32(78, 0, 83) ' Player 3 Purple Piece Outer Color
_PALETTECOLOR 11, _RGB32(161, 0, 166) ' Player 3 Purple Piece Inner Color
DIM AS _UNSIGNED INTEGER V, X, Y, Z
DIM SHARED AS _UNSIGNED _BYTE Player, Players, FiveOfKind, Straight, FullHouse, Lucky7, Lucky11, Roll, CanPlay, StraightCount, FullHouseCount, StraightBouncer, FullHouseBouncer
DIM SHARED AS _UNSIGNED _BYTE PiecesPlayed, Dice, Die(5), Dice(5), Chosen(5), BoardSpace(9, 9), BoardRotation(9, 9), BoardPlayer(9, 9), BoardRun(9, 9), Playable(9, 9)
DIM SHARED AS _UNSIGNED INTEGER BoardX(9, 9), BoardY(9, 9), DiceX(5)
Player = 1: PiecesPlayed = 0
DATA 37,1,18,1,33,1,32,1,2,1,30,1,27,1,23,1,37,2: ' Row 1 Spaces
DATA 6,1,36,2,22,1,26,1,29,1,31,1,17,1,36,2,4,1: ' Row 2 Spaces
DATA 16,1,8,1,36,2,28,1,13,1,25,1,36,2,12,1,21,1: ' Row 3 Spaces
DATA 10,1,7,1,15,1,36,2,24,1,36,2,20,1,9,1,11,1: ' Row 4 Spaces
DATA 34,1,19,1,35,1,14,1,38,1,14,1,35,2,19,1,34,2: ' Row 5 Spaces
DATA 11,2,9,2,20,2,36,1,24,2,36,1,15,1,7,2,10,2: ' Row 6 Spaces
DATA 21,2,12,2,36,1,25,2,13,1,28,2,36,1,8,2,16,1: ' Row 7 Spaces
DATA 5,1,36,1,17,1,31,2,29,2,26,2,22,2,36,1,3,1: ' Row 8 Speces
DATA 37,3,23,2,27,2,30,2,1,1,32,2,33,2,18,1,37,4: ' Row 9 Spaces
FOR Z = 1 TO 5: DiceX(Z) = 799 + X: X = X + 108: NEXT
FOR Z = 1 TO 9: FOR Y = 1 TO 9: READ BoardSpace(Z, Y), BoardRotation(Z, Y): NEXT: NEXT
' Draw Board
LINE (10, 10)-(729, 729), 0, BF
X = 53
FOR Z = 1 TO 9
V = 53
FOR Y = 1 TO 9
LINE (V - 37, X - 37)-(V + 37, X + 37), 2, BF
DrawBoardSpace V, X, BoardSpace(Z, Y), BoardRotation(Z, Y)
BoardX(Z, Y) = V: BoardY(Z, Y) = X
V = V + 79
NEXT
X = X + 79
NEXT
' Draw Game Title
COLOR 3, 1: font& = _LOADFONT(fontpath$, 60): _FONT font&: _PRINTSTRING (800, 200), "DICE POKER"
X = 0
FOR Z = 200 TO 265
V = 0
FOR Y = 800 TO 1140
IF POINT(Y, Z) = 3 THEN PSET (840 + V, 5 + X), 2
V = V + 1
NEXT
X = X + 1
NEXT
X = 0
FOR Z = 200 TO 265
V = 0
FOR Y = 800 TO 1140
IF POINT(Y, Z) = 3 THEN PSET (850 + V, 15 + X), 0
V = V + 1
NEXT
X = X + 1
NEXT
LINE (800, 200)-(1400, 288), 1, BF
' How Many Players?
COLOR 15, 1: font& = _LOADFONT(fontpath$, 30): _FONT font&: _PRINTSTRING (817, 200), " How Many Players? (2 or 3)"
Players: A$ = INKEY$: IF A$ = "" GOTO Players
IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
IF VAL(A$) < 2 OR VAL(A$) > 3 GOTO Players ELSE Players = VAL(A$)
LINE (817, 200)-(1220, 235), 1, BF
StartGame: Roll = 1: FOR Z = 1 TO 5: Die(Z) = 0: Dice(Z) = 0: Chosen(Z) = 0: NEXT
' Clear Space for Roll Button
LINE (888, 525)-(1138, 575), 1, BF
' Display Roll Dice Button
IF Roll < 3 THEN
CIRCLE (913, 550), 25, 0, 1.5, 4.75: CIRCLE (1113, 550), 25, 0, 4.7, 1.7: LINE (913, 525)-(1113, 525), 0: LINE (913, 575)-(1113, 575), 0: PAINT (913, 550), 2, 0
COLOR 0, 2: font& = _LOADFONT(fontpath$, 24): _FONT font&: _PRINTSTRING (925, 539), "R O L L D I C E"
END IF
' Roll and Display Dice
X = 0
FOR Y = 1 TO 12
FOR Z = 1 TO 5:
DrawCursor DiceX(Z), 350, 2, 1
IF Chosen(Z) = 0 THEN Dice(Z) = INT(RND * 6) + 1: DrawDice DiceX(Z), 350, 2, Dice(Z)
NEXT
_DELAY .10
NEXT
ArrangeDice: CheckDicePatterns: CountPatterns: X = 0
' Check Remove Opponent's Piece
IF BoardSpace(Z, Y) <> 38 AND ((StraightBouncer = 1 AND Straight = 1) OR (FullHouseBouncer = 1 AND FullHouse = 1)) THEN
IF BoardPlayer(Z, Y) > 0 AND BoardPlayer(Z, Y) <> Player AND BoardRun(Z, Y) = 0 THEN X = 1: Playable(Z, Y) = 2: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0
END IF
EndLoop:
NEXT
NEXT
' Standard Move
CheckBoardPatterns
' Display End Turn Button
IF Roll = 3 AND CanPlay = 0 THEN
CIRCLE (913, 550), 25, 0, 1.5, 4.75: CIRCLE (1113, 550), 25, 0, 4.7, 1.7: LINE (913, 525)-(1113, 525), 0: LINE (913, 575)-(1113, 575), 0: PAINT (913, 550), 2, 0
COLOR 0, 2: font& = _LOADFONT(fontpath$, 24): _FONT font&: _PRINTSTRING (925, 539), "E N D T U R N"
END IF
COLOR 0, 1: font& = _LOADFONT(fontpath$, 28): _FONT font&
IF (FullHouseBouncer = 1 AND FullHouse = 1) OR (StraightBouncer = 1 AND Straight = 1) THEN X = 1 ELSE X = 0
IF X = 1 AND Roll < 3 THEN _PRINTSTRING (780, 635), "Choose Dice to Keep and Roll Again "
IF CanPlay = 0 AND X = 0 AND Roll = 3 THEN _PRINTSTRING (780, 670), " There are No Playable Spaces "
IF CanPlay = 1 AND X = 0 AND Roll < 3 THEN _PRINTSTRING (780, 670), "Choose Dice to Keep and Roll Again "
IF CanPlay = 1 AND X = 1 THEN _PRINTSTRING (780, 670), "Choose Opponent's Piece to Remove "
IF CanPlay = 0 AND X = 1 THEN _PRINTSTRING (780, 705), "Choose Opponent's Piece to Remove "
IF CanPlay = 0 AND X = 0 AND Roll < 3 THEN _PRINTSTRING (780, 705), "Choose Dice to Keep and Roll Again "
IF CanPlay = 0 AND X = 0 AND Roll = 3 THEN _PRINTSTRING (780, 705), " Click END TURN to Continue "
IF CanPlay = 1 AND FiveOfKind = 0 THEN _PRINTSTRING (780, 705), " Choose a Space to Place Your Piece "
IF CanPlay = 1 AND FiveOfKind = 1 THEN _PRINTSTRING (780, 705), "Place Your Piece On Any Open Space "
GetInput:
DO WHILE _MOUSEINPUT
' Choose Dice to Keep
FOR Z = 1 TO 5
IF _MOUSEX > DiceX(Z) - 51 AND _MOUSEX < DiceX(Z) + 51 AND _MOUSEY > 309 AND _MOUSEY < 391 AND _MOUSEBUTTON(1) = -1 AND Roll < 3 THEN
GOSUB ReleaseButton: IF Chosen(Z) = 0 THEN Chosen(Z) = 1: DrawCursor DiceX(Z), 350, 2, 0 ELSE Chosen(Z) = 0: DrawCursor DiceX(Z), 350, 2, 1
END IF
NEXT
' Choose Roll Dice Button
IF _MOUSEX > 900 AND _MOUSEX < 1126 AND _MOUSEY > 525 AND _MOUSEY < 575 AND _MOUSEBUTTON(1) = -1 THEN
GOSUB ReleaseButton: IF Roll < 3 THEN Roll = Roll + 1: GOTO DisPlayDice ELSE IF Roll = 3 AND CanPlay = 0 GOTO EndTurn
END IF
' Choose Board Position
FOR Z = 1 TO 9
FOR Y = 1 TO 9
IF _MOUSEX > BoardX(Z, Y) - 51 AND _MOUSEX < BoardX(Z, Y) + 51 AND _MOUSEY > BoardY(Z, Y) - 51 AND _MOUSEY < BoardY(Z, Y) + 51 AND _MOUSEBUTTON(1) = -1 THEN
GOSUB ReleaseButton: IF Playable(Z, Y) = 1 THEN BoardPlayer(Z, Y) = Player: DrawPiece BoardX(Z, Y), BoardY(Z, Y), Player: GOTO EndTurn
IF Playable(Z, Y) = 2 THEN
BoardPlayer(Z, Y) = 0: LINE (BoardX(Z, Y) - 37, BoardY(Z, Y) - 37)-(BoardX(Z, Y) + 37, BoardY(Z, Y) + 37), 2, BF
DrawBoardSpace BoardX(Z, Y), BoardY(Z, Y), BoardSpace(Z, Y), BoardRotation(Z, Y): GOTO EndTurn
END IF
ELSE
END IF
NEXT
NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetInput
EndTurn:
' Remove All Board Cursors
FOR Z = 1 TO 9: FOR Y = 1 TO 9: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 2: NEXT: NEXT
' Check for Winner
IF CheckWinner(Player) > 0 THEN DisplayWinner Player
' Get Next Player
IF Player = Players THEN Player = 1 ELSE Player = Player + 1
GOTO StartGame
ReleaseButton:
DO WHILE _MOUSEINPUT
IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ReleaseButton
X = X1 - 30: W = X1 + 30
FOR Z = 14 TO 74
V = X2 + 30: U = X2 - 30
FOR Y = 1230 TO 1290
IF POINT(Y, Z) = 3 THEN
IF Z < 35 THEN T = 0 ELSE T = 4
IF Rotation = 1 THEN IF T = 4 THEN CIRCLE (X, V), 1, 4: PAINT (X, V), 4 ELSE PSET (X, V), T
IF Rotation = 2 THEN IF T = 4 THEN CIRCLE (W, U), 1, 4: PAINT (W, U), 4 ELSE PSET (W, U), T
END IF
V = V - 1: U = U + 1
NEXT
X = X + 1: W = W - 1
NEXT
X = X1 - 30: W = X1 + 30
FOR Z = 14 TO 74
V = X2 + 30: U = X2 - 30
FOR Y = 1230 TO 1290
IF POINT(Y, Z) = 3 THEN
IF Z < 35 THEN T = 0 ELSE T = 4
IF Rotation = 1 THEN IF T = 4 THEN CIRCLE (X, V), 1, 4: PAINT (X, V), 4 ELSE PSET (X, V), 0
IF Rotation = 2 THEN IF T = 4 THEN CIRCLE (W, U), 1, 4: PAINT (W, U), 4 ELSE PSET (W, U), 0
END IF
V = V - 1: U = U + 1
NEXT
X = X + 1: W = W - 1
NEXT
LINE (1230, 14)-(1290, 74), 1, BF
CASE 36 ' Full House
IF Rotation = 1 THEN PSET (X1, X2), 2: DRAW "C0TA0BU30TA30L32TA0R55TA150R32TA0BD5P0,0R9U5R5D10U5BL2P0,0BD46L36D8R49U8L14BD2P0,0"
IF Rotation = 2 THEN PSET (X1, X2), 2: DRAW "C0TA0BD30TA30R32TA0L55TA150L30TA0BU5P0,0L9D5L5U10D5BR2P0,0BU46R38U8L49D8R14BU2P0,0"
X = 0
FOR Z = 14 TO 74
V = 0
FOR Y = 1230 TO 1290
IF POINT(Y, Z) = 3 THEN
IF Rotation = 1 THEN PSET (X1 - 30 + V, X2 - 30 + X), 4
IF Rotation = 2 THEN PSET (X1 + 30 - V, X2 + 30 - X), 4
END IF
V = V + 1
NEXT
X = X + 1
NEXT
U = 0
FOR Z = 10 TO 30
V = 0
FOR Y = 1220 TO 1295
IF POINT(Y, Z) = 3 THEN
IF Rotation = 1 THEN CIRCLE (X1 + 21 - V + U, X2 + 30 - V - U), 1, 4: PAINT (X1 + 21 - V + U, X2 + 30 - V - U), 4
IF Rotation = 2 THEN CIRCLE (X1 + 31 - V - U, X2 - 21 + V - U), 1, 4: PAINT (X1 + 31 - V - U, X2 - 21 + V - U), 4
IF Rotation = 3 THEN CIRCLE (X1 - 31 + V + U, X2 + 21 - V + U), 1, 4: PAINT (X1 - 31 + V + U, X2 + 21 - V + U), 4
IF Rotation = 4 THEN CIRCLE (X1 - 21 + V - U, X2 - 31 + V + U), 1, 4: PAINT (X1 - 21 + V - U, X2 - 31 + V + U), 4
END IF
V = V + 1
NEXT
U = U + 1
NEXT
SUB DrawCursor (X1 AS INTEGER, X2 AS INTEGER, CursorSize AS _BYTE, CursorColor AS _BYTE)
IF CursorSize = 1 THEN PSET (X1 - 34, X2 - 34), CursorColor: DRAW "TA0R68D68L68U68H1R70D70L70U70H1R72D72L72U72H1R74D74L74U74"
IF CursorSize = 2 THEN PSET (X1 - 48, X2 - 48), CursorColor: DRAW "TA0R97D97L97U97H1R99D99L99U99H1R101D101L101U101"
END SUB
SUB DrawPiece (X1, X2, Player)
IF Player = 1 THEN CIRCLE (X1, X2), 32, 6: PAINT (X1, X2), 7, 6
IF Player = 2 THEN CIRCLE (X1, X2), 32, 8: PAINT (X1, X2), 9, 8
IF Player = 3 THEN CIRCLE (X1, X2), 32, 10: PAINT (X1, X2), 11, 10
END SUB
SUB DrawDice (X1, X2, DiceSize, Die)
IF DiceSize = 1 THEN
LINE (X1 - 14, X2 - 10)-(X1 - 14, X2 + 10), 0: LINE (X1 + 14, X2 - 10)-(X1 + 14, X2 + 10), 0
LINE (X1 - 10, X2 - 14)-(X1 + 10, X2 - 14), 0: LINE (X1 - 10, X2 + 14)-(X1 + 10, X2 + 14), 0
CIRCLE (X1 - 10, X2 - 10), 4, 0, 1.5, 3.0: CIRCLE (X1 + 10, X2 - 10), 4, 0, 0, 1.7: CIRCLE (X1 - 10, X2 + 10), 4, 0, 3.0, 4.9: CIRCLE (X1 + 10, X2 + 10), 4, 0, 4.5, 0
PAINT (X1, X2), 15, 0
IF Die = 1 OR Die = 3 OR Die = 5 THEN CIRCLE (X1, X2), 2, 0: PAINT (X1, X2), 0
IF Die > 1 THEN CIRCLE (X1 + 7, X2 - 7), 2, 0: PAINT (X1 + 7, X2 - 7), 0: CIRCLE (X1 - 7, X2 + 7), 2, 0: PAINT (X1 - 7, X2 + 7), 0
IF Die > 3 THEN CIRCLE (X1 - 7, X2 - 7), 2, 0: PAINT (X1 - 7, X2 - 7), 0: CIRCLE (X1 + 7, X2 + 7), 2, 0: PAINT (X1 + 7, X2 + 7), 0
IF Die = 6 THEN CIRCLE (X1 - 7, X2), 2, 0: PAINT (X1 - 7, X2), 0: CIRCLE (X1 + 7, X2), 2, 0: PAINT (X1 + 7, X2), 0
ELSE
LINE (X1 - 40, X2 - 40)-(X1 + 40, X2 + 40), 1, BF
LINE (X1 - 28, X2 - 40)-(X1 + 28, X2 - 40), 0: LINE (X1 - 28, X2 + 40)-(X1 + 28, X2 + 40), 0
LINE (X1 - 40, X2 - 28)-(X1 - 40, X2 + 28), 0: LINE (X1 + 40, X2 - 28)-(X1 + 40, X2 + 28), 0
CIRCLE (X1 - 28, X2 - 28), 12, 0, 1.5, 3.0: CIRCLE (X1 + 28, X2 - 28), 12, 0, 0, 1.7: CIRCLE (X1 - 28, X2 + 28), 12, 0, 3.2, 4.9: CIRCLE (X1 + 28, X2 + 28), 12, 0, 4.5, 0
PAINT (X1, X2), 15, 0: 'CIRCLE (X1, X2), 36, 4: PAINT (X1, X2), 4
IF Die = 1 OR Die = 3 OR Die = 5 THEN CIRCLE (X1, X2), 6, 0: PAINT (X1, X2), 0
IF Die > 1 THEN CIRCLE (X1 + 21, X2 - 21), 6, 0: PAINT (X1 + 21, X2 - 21), 0: CIRCLE (X1 - 21, X2 + 21), 6, 0: PAINT (X1 - 21, X2 + 21), 0
IF Die > 3 THEN CIRCLE (X1 - 21, X2 - 21), 6, 0: PAINT (X1 - 21, X2 - 21), 0: CIRCLE (X1 + 21, X2 + 21), 6, 0: PAINT (X1 + 21, X2 + 21), 0
IF Die = 6 THEN CIRCLE (X1 - 21, X2), 6, 0: PAINT (X1 - 21, X2), 0: CIRCLE (X1 + 21, X2), 6, 0: PAINT (X1 + 21, X2), 0
END IF
' Five of a Kind
IF Die(1) = Die(2) AND Die(2) = Die(3) AND Die(3) = Die(4) AND Die(4) = Die(5) THEN FiveOfKind = 1
' Straight
IF Die(1) = 1 AND Die(2) = 2 AND Die(3) = 3 AND Die(4) = 4 AND Die(5) = 5 THEN Straight = 1
IF Die(1) = 2 AND Die(2) = 3 AND Die(3) = 4 AND Die(4) = 5 AND Die(5) = 6 THEN Straight = 1
' Full House
IF Die(1) = Die(2) AND Die(2) <> Die(3) AND Die(3) = Die(4) AND Die(4) = Die(5) THEN FullHouse = 1
IF Die(1) = Die(2) AND Die(2) = Die(3) AND Die(3) <> Die(4) AND Die(4) = Die(5) THEN FullHouse = 1
' Lucky 11
IF Die(1) + Die(2) + Die(3) + Die(4) + Die(5) = 11 THEN Lucky11 = 1
' Lucky 7
IF Die(1) + Die(2) + Die(3) + Die(4) + Die(5) = 7 THEN Lucky7 = 1
' Count Hom Many Ones, Twos, Threes, Fours, Fives and Sixes
FOR Z = 1 TO 5
IF Die(Z) = 1 THEN Ones = Ones + 1
IF Die(Z) = 2 THEN Twos = Twos + 1
IF Die(Z) = 3 THEN Threes = Threes + 1
IF Die(Z) = 4 THEN Fours = Fours + 1
IF Die(Z) = 5 THEN Fives = Fives + 1
IF Die(Z) = 6 THEN Sixes = Sixes + 1
NEXT
FOR Z = 1 TO 9
FOR Y = 1 TO 9
IF BoardPlayer(Z, Y) = 0 AND BoardSpace(Z, Y) <> 38 AND FiveOfKind = 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
IF BoardPlayer(Z, Y) = 0 THEN
SELECT CASE BoardSpace(Z, Y)
CASE 1 ' 1 Pair 1's
IF Ones > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 2 ' 1 Pair 2's
IF Twos > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 3 ' 1 Pair 3's
IF Threes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 4 ' 1 Pair 4's
IF Fours > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 5 ' 1 Pair 5's
IF Fives > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 6 ' 1 Pair 6's
IF Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 7 ' Three of a Kind 1's
IF Ones > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 8 ' Three of a Kind 2's
IF Twos > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 9 ' Three of a Kind 3's
IF Threes > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 10 ' Three of a Kind 4's
IF Fours > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 11 ' Three of a Kind 5's
IF Fives > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 12 ' Three of a Kind 6's
IF Sixes > 2 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 13 ' Four of a Kind 1's
IF Ones > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 14 ' Four of a Kind 2's
IF Twos > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 15 ' Four of a Kind 3's
IF Threes > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 16 ' Four of a Kind 4's
IF Fours > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 17 ' Four of a Kind 5's
IF Fives > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 18 ' Four of a Kind 6's
IF Sixes > 3 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 19 ' 1 Pair 1's - 1 Pair 2's
IF Ones > 1 AND Twos > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 20 ' 1 Pair 1's - 1 Pair 3's
IF Ones > 1 AND Threes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 21 ' 1 Pair 1's - 1 Pair 4's
IF Ones > 1 AND Fours > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 22 ' 1 Pair 1's - 1 Pair 5's
IF Ones > 1 AND Fives > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 23 ' 1 Pair 1's - 1 Pair 6's
IF Ones > 1 AND Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 24 ' 1 Pair 2's - 1 Pair 3's
IF Twos > 1 AND Threes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 25 ' 1 Pair 2's - 1 Pair 4's
IF Twos > 1 AND Fours > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 26 ' 1 Pair 2's - 1 Pair 5's
IF Twos > 1 AND Fives > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 27 ' 1 Pair 2's - 1 Pair 6's
IF Twos > 1 AND Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 28 ' 1 Pair 3's - 1 Pair 4's
IF Threes > 1 AND Fours > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 29 ' 1 Pair 3's - 1 Pair 5's
IF Threes > 1 AND Fives > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 30 ' 1 Pair 3's - 1 Pair 6's
IF Threes > 1 AND Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 31 ' 1 Pair 4's - 1 Pair 5's
IF Fours > 1 AND Fives > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 32 ' 1 Pair 4's - 1 Pair 6's
IF Fours > 1 AND Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 33 ' 1 Pair 5's - 1 Pair 6's
IF Fives > 1 AND Sixes > 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 34 ' Lucky 7
IF Lucky7 = 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 35 ' Lucky 11
IF Lucky11 = 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 36 ' Full House
IF FullHouse = 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
CASE 37 ' Straight
IF Straight = 1 THEN Playable(Z, Y) = 1: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1, 0: CanPlay = 1
' Check for Duel Horizontal Patterns
FOR Z = 1 TO 9
IF BoardPlayer(Z, 1) = Player AND BoardPlayer(Z, 2) = Player AND BoardPlayer(Z, 3) = Player AND BoardPlayer(Z, 4) = Player AND (BoardPlayer(Z, 5) = Player OR BoardSpace(Z, 5) = 38) AND BoardPlayer(Z, 6) = Player AND BoardPlayer(Z, 7) = Player AND BoardPlayer(Z, 8) = Player AND BoardPlayer(Z, 9) = Player THEN
X2 = 2
BoardRun(Z, 1) = 1: CIRCLE (BoardX(Z, 1), BoardY(Z, 1)), 10, 15: PAINT (BoardX(Z, 1), BoardY(Z, 1)), 15
BoardRun(Z, 2) = 1: CIRCLE (BoardX(Z, 2), BoardY(Z, 2)), 10, 15: PAINT (BoardX(Z, 2), BoardY(Z, 2)), 15
BoardRun(Z, 3) = 1: CIRCLE (BoardX(Z, 3), BoardY(Z, 3)), 10, 15: PAINT (BoardX(Z, 3), BoardY(Z, 3)), 15
BoardRun(Z, 4) = 1: CIRCLE (BoardX(Z, 4), BoardY(Z, 4)), 10, 15: PAINT (BoardX(Z, 4), BoardY(Z, 4)), 15
IF Z <> 5 THEN BoardRun(Z, 5) = 1: CIRCLE (BoardX(Z, 5), BoardY(Z, 5)), 10, 15: PAINT (BoardX(Z, 5), BoardY(Z, 5)), 15
BoardRun(Z, 6) = 1: CIRCLE (BoardX(Z, 6), BoardY(Z, 6)), 10, 15: PAINT (BoardX(Z, 6), BoardY(Z, 6)), 15
BoardRun(Z, 7) = 1: CIRCLE (BoardX(Z, 7), BoardY(Z, 7)), 10, 15: PAINT (BoardX(Z, 7), BoardY(Z, 7)), 15
BoardRun(Z, 8) = 1: CIRCLE (BoardX(Z, 8), BoardY(Z, 8)), 10, 15: PAINT (BoardX(Z, 8), BoardY(Z, 8)), 15
BoardRun(Z, 9) = 1: CIRCLE (BoardX(Z, 9), BoardY(Z, 9)), 10, 15: PAINT (BoardX(Z, 9), BoardY(Z, 9)), 15
END IF
NEXT
' Check for Single Horizontal Patterns
IF X2 = 0 THEN
FOR Z = 1 TO 9
FOR Y = 1 TO 5
IF (BoardPlayer(Z, Y) = Player OR BoardSpace(Z, Y) = 38) AND (BoardPlayer(Z, Y + 1) = Player OR BoardSpace(Z, Y + 1) = 38) AND (BoardPlayer(Z, Y + 2) = Player OR BoardSpace(Z, Y + 2) = 38) AND (BoardPlayer(Z, Y + 3) = Player OR BoardSpace(Z, Y + 3) = 38) AND (BoardPlayer(Z, Y + 4) = Player OR BoardSpace(Z, Y + 4) = 38) THEN
X(Z) = 1
IF Z = 5 AND Y = 5 GOTO EndLoop21 ELSE BoardRun(Z, Y) = 1: CIRCLE (BoardX(Z, Y), BoardY(Z, Y)), 10, 15: PAINT (BoardX(Z, Y), BoardY(Z, Y)), 15
EndLoop21: IF Z = 5 AND Y + 1 = 5 GOTO EndLoop22 ELSE BoardRun(Z, Y + 1) = 1: CIRCLE (BoardX(Z, Y + 1), BoardY(Z, Y + 1)), 10, 15: PAINT (BoardX(Z, Y + 1), BoardY(Z, Y + 1)), 15
EndLoop22: IF Z = 5 AND Y + 2 = 5 GOTO EndLoop23 ELSE BoardRun(Z, Y + 2) = 1: CIRCLE (BoardX(Z, Y + 2), BoardY(Z, Y + 2)), 10, 15: PAINT (BoardX(Z, Y + 2), BoardY(Z, Y + 2)), 15
EndLoop23: IF Z = 5 AND Y + 3 = 5 GOTO EndLoop24 ELSE BoardRun(Z, Y + 3) = 1: CIRCLE (BoardX(Z, Y + 3), BoardY(Z, Y + 3)), 10, 15: PAINT (BoardX(Z, Y + 3), BoardY(Z, Y + 3)), 15
EndLoop24: IF Z = 5 AND Y + 4 = 5 GOTO EndLoop25 ELSE BoardRun(Z, Y + 4) = 1: CIRCLE (BoardX(Z, Y + 4), BoardY(Z, Y + 4)), 10, 15: PAINT (BoardX(Z, Y + 4), BoardY(Z, Y + 4)), 15
EndLoop25:
END IF
NEXT
NEXT
X2 = X(1) + X(2) + X(3) + X(4) + X(5) + X(6) + X(7) + X(8) + X(9)
END IF
' Check for Duel Diagonal 1 Pattern
IF BoardPlayer(1, 1) = Player AND BoardPlayer(2, 2) = Player AND BoardPlayer(3, 3) = Player AND BoardPlayer(4, 4) = Player AND BoardPlayer(6, 6) = Player AND BoardPlayer(7, 7) = Player AND BoardPlayer(8, 8) = Player AND BoardPlayer(9, 9) = Player THEN
X3 = 2
BoardRun(1, 1) = 1: CIRCLE (BoardX(1, 1), BoardY(1, 1)), 10, 15: PAINT (BoardX(1, 1), BoardY(1, 1)), 15
BoardRun(2, 2) = 1: CIRCLE (BoardX(2, 2), BoardY(2, 2)), 10, 15: PAINT (BoardX(2, 2), BoardY(2, 2)), 15
BoardRun(3, 3) = 1: CIRCLE (BoardX(3, 3), BoardY(3, 3)), 10, 15: PAINT (BoardX(3, 3), BoardY(3, 3)), 15
BoardRun(4, 4) = 1: CIRCLE (BoardX(4, 4), BoardY(4, 4)), 10, 15: PAINT (BoardX(4, 4), BoardY(4, 4)), 15
BoardRun(6, 6) = 1: CIRCLE (BoardX(6, 6), BoardY(6, 6)), 10, 15: PAINT (BoardX(6, 6), BoardY(6, 6)), 15
BoardRun(7, 7) = 1: CIRCLE (BoardX(7, 7), BoardY(7, 7)), 10, 15: PAINT (BoardX(7, 7), BoardY(7, 7)), 15
BoardRun(8, 8) = 1: CIRCLE (BoardX(8, 8), BoardY(8, 8)), 10, 15: PAINT (BoardX(8, 8), BoardY(8, 8)), 15
BoardRun(9, 9) = 1: CIRCLE (BoardX(9, 9), BoardY(9, 9)), 10, 15: PAINT (BoardX(9, 9), BoardY(9, 9)), 15
END IF
' Check for Single Diagonal 1 Patterns
IF X3 = 0 THEN
IF BoardPlayer(1, 5) = Player AND BoardPlayer(2, 6) = Player AND BoardPlayer(3, 7) = Player AND BoardPlayer(4, 8) = Player AND BoardPlayer(5, 9) = Player THEN
X(1) = 1
BoardRun(1, 5) = 1: CIRCLE (BoardX(1, 5), BoardY(1, 5)), 10, 15: PAINT (BoardX(1, 5), BoardY(1, 5)), 15
BoardRun(2, 6) = 1: CIRCLE (BoardX(2, 6), BoardY(2, 6)), 10, 15: PAINT (BoardX(2, 6), BoardY(2, 6)), 15
BoardRun(3, 7) = 1: CIRCLE (BoardX(3, 7), BoardY(3, 7)), 10, 15: PAINT (BoardX(3, 7), BoardY(3, 7)), 15
BoardRun(4, 8) = 1: CIRCLE (BoardX(4, 8), BoardY(4, 8)), 10, 15: PAINT (BoardX(4, 8), BoardY(4, 8)), 15
BoardRun(5, 9) = 1: CIRCLE (BoardX(5, 9), BoardY(5, 9)), 10, 15: PAINT (BoardX(5, 9), BoardY(5, 9)), 15
END IF
FOR Z = 0 TO 1
IF BoardPlayer(1 + Z, 4 + Z) = Player AND BoardPlayer(2 + Z, 5 + Z) = Player AND BoardPlayer(3 + Z, 6 + Z) = Player AND BoardPlayer(4 + Z, 7 + Z) = Player AND BoardPlayer(5 + Z, 8 + Z) = Player THEN
X(2) = 1
BoardRun(Z + 1, Z + 4) = 1: CIRCLE (BoardX(Z + 1, Z + 4), BoardY(Z + 1, Z + 4)), 10, 15: PAINT (BoardX(Z + 1, Z + 4), BoardY(Z + 1, Z + 4)), 15
BoardRun(Z + 2, Z + 5) = 1: CIRCLE (BoardX(Z + 2, Z + 5), BoardY(Z + 2, Z + 5)), 10, 15: PAINT (BoardX(Z + 2, Z + 5), BoardY(Z + 2, Z + 5)), 15
BoardRun(Z + 3, Z + 6) = 1: CIRCLE (BoardX(Z + 3, Z + 6), BoardY(Z + 3, Z + 6)), 10, 15: PAINT (BoardX(Z + 3, Z + 6), BoardY(Z + 3, Z + 6)), 15
BoardRun(Z + 4, Z + 7) = 1: CIRCLE (BoardX(Z + 4, Z + 7), BoardY(Z + 4, Z + 7)), 10, 15: PAINT (BoardX(Z + 4, Z + 7), BoardY(Z + 4, Z + 7)), 15
BoardRun(Z + 5, Z + 8) = 1: CIRCLE (BoardX(Z + 5, Z + 8), BoardY(Z + 5, Z + 8)), 10, 15: PAINT (BoardX(Z + 5, Z + 8), BoardY(Z + 5, Z + 8)), 15
END IF
NEXT
FOR Z = 0 TO 2
IF BoardPlayer(1 + Z, 3 + Z) = Player AND BoardPlayer(2 + Z, 4 + Z) = Player AND BoardPlayer(3 + Z, 5 + Z) = Player AND BoardPlayer(4 + Z, 6 + Z) = Player AND BoardPlayer(5 + Z, 7 + Z) = Player THEN
X(3) = 1
BoardRun(Z + 1, Z + 3) = 1: CIRCLE (BoardX(Z + 1, Z + 3), BoardY(Z + 1, Z + 3)), 10, 15: PAINT (BoardX(Z + 1, Z + 3), BoardY(Z + 1, Z + 3)), 15
BoardRun(Z + 2, Z + 4) = 1: CIRCLE (BoardX(Z + 2, Z + 4), BoardY(Z + 2, Z + 4)), 10, 15: PAINT (BoardX(Z + 2, Z + 4), BoardY(Z + 2, Z + 4)), 15
BoardRun(Z + 3, Z + 5) = 1: CIRCLE (BoardX(Z + 3, Z + 5), BoardY(Z + 3, Z + 5)), 10, 15: PAINT (BoardX(Z + 3, Z + 5), BoardY(Z + 3, Z + 5)), 15
BoardRun(Z + 4, Z + 6) = 1: CIRCLE (BoardX(Z + 4, Z + 6), BoardY(Z + 4, Z + 6)), 10, 15: PAINT (BoardX(Z + 4, Z + 6), BoardY(Z + 4, Z + 6)), 15
BoardRun(Z + 5, Z + 7) = 1: CIRCLE (BoardX(Z + 5, Z + 7), BoardY(Z + 5, Z + 7)), 10, 15: PAINT (BoardX(Z + 5, Z + 7), BoardY(Z + 5, Z + 7)), 15
END IF
NEXT
FOR Z = 0 TO 3
IF BoardPlayer(1 + Z, 2 + Z) = Player AND BoardPlayer(2 + Z, 3 + Z) = Player AND BoardPlayer(3 + Z, 4 + Z) = Player AND BoardPlayer(4 + Z, 5 + Z) = Player AND BoardPlayer(5 + Z, 6 + Z) = Player THEN
X(4) = 1
BoardRun(Z + 1, Z + 2) = 1: CIRCLE (BoardX(Z + 1, Z + 2), BoardY(Z + 1, Z + 2)), 10, 15: PAINT (BoardX(Z + 1, Z + 2), BoardY(Z + 1, Z + 2)), 15
BoardRun(Z + 2, Z + 3) = 1: CIRCLE (BoardX(Z + 2, Z + 3), BoardY(Z + 2, Z + 3)), 10, 15: PAINT (BoardX(Z + 2, Z + 3), BoardY(Z + 2, Z + 3)), 15
BoardRun(Z + 3, Z + 4) = 1: CIRCLE (BoardX(Z + 3, Z + 4), BoardY(Z + 3, Z + 4)), 10, 15: PAINT (BoardX(Z + 3, Z + 4), BoardY(Z + 3, Z + 4)), 15
BoardRun(Z + 4, Z + 5) = 1: CIRCLE (BoardX(Z + 4, Z + 5), BoardY(Z + 4, Z + 5)), 10, 15: PAINT (BoardX(Z + 4, Z + 5), BoardY(Z + 4, Z + 5)), 15
BoardRun(Z + 5, Z + 6) = 1: CIRCLE (BoardX(Z + 5, Z + 6), BoardY(Z + 5, Z + 6)), 10, 15: PAINT (BoardX(Z + 5, Z + 6), BoardY(Z + 5, Z + 6)), 15
END IF
NEXT
FOR Z = 1 TO 5
IF (BoardPlayer(Z, Z) = Player OR BoardSpace(Z, Z) = 38) AND (BoardPlayer(Z + 1, Z + 1) = Player OR BoardSpace(Z + 1, Z + 1) = 38) AND (BoardPlayer(Z + 2, Z + 2) = Player OR BoardSpace(Z + 2, Z + 2) = 38) AND (BoardPlayer(Z + 3, Z + 3) = Player OR BoardSpace(Z + 3, Z + 3) = 38) AND (BoardPlayer(Z + 4, Z + 4) = Player OR BoardSpace(Z + 4, Z + 4) = 38) THEN
X(5) = 1
IF BoardSpace(Z, Z) <> 38 THEN BoardRun(Z, Z) = 1: CIRCLE (BoardX(Z, Z), BoardY(Z, Z)), 10, 15: PAINT (BoardX(Z, Z), BoardY(Z, Z)), 15
IF BoardSpace(Z + 1, Z + 1) <> 38 THEN BoardRun(Z + 1, Z + 1) = 1: CIRCLE (BoardX(Z + 1, Z + 1), BoardY(Z + 1, Z + 1)), 10, 15: PAINT (BoardX(Z + 1, Z + 1), BoardY(Z + 1, Z + 1)), 15
IF BoardSpace(Z + 2, Z + 2) <> 38 THEN BoardRun(Z + 2, Z + 2) = 1: CIRCLE (BoardX(Z + 2, Z + 2), BoardY(Z + 2, Z + 2)), 10, 15: PAINT (BoardX(Z + 2, Z + 2), BoardY(Z + 2, Z + 2)), 15
IF BoardSpace(Z + 3, Z + 3) <> 38 THEN BoardRun(Z + 3, Z + 3) = 1: CIRCLE (BoardX(Z + 3, Z + 3), BoardY(Z + 3, Z + 3)), 10, 15: PAINT (BoardX(Z + 3, Z + 3), BoardY(Z + 3, Z + 3)), 15
IF BoardSpace(Z + 4, Z + 4) <> 38 THEN BoardRun(Z + 4, Z + 4) = 1: CIRCLE (BoardX(Z + 4, Z + 4), BoardY(Z + 4, Z + 4)), 10, 15: PAINT (BoardX(Z + 4, Z + 4), BoardY(Z + 4, Z + 4)), 15
END IF
NEXT
FOR Z = 0 TO 3
IF BoardPlayer(2 + Z, 1 + Z) = Player AND BoardPlayer(3 + Z, 2 + Z) = Player AND BoardPlayer(4 + Z, 3 + Z) = Player AND BoardPlayer(5 + Z, 4 + Z) = Player AND BoardPlayer(6 + Z, 5 + Z) = Player THEN
X(6) = 1
BoardRun(Z + 2, Z + 1) = 1: CIRCLE (BoardX(Z + 2, Z + 1), BoardY(Z + 2, Z + 1)), 10, 15: PAINT (BoardX(Z + 2, Z + 1), BoardY(Z + 2, Z + 1)), 15
BoardRun(Z + 3, Z + 2) = 1: CIRCLE (BoardX(Z + 3, Z + 2), BoardY(Z + 3, Z + 2)), 10, 15: PAINT (BoardX(Z + 3, Z + 2), BoardY(Z + 3, Z + 2)), 15
BoardRun(Z + 4, Z + 3) = 1: CIRCLE (BoardX(Z + 4, Z + 3), BoardY(Z + 4, Z + 3)), 10, 15: PAINT (BoardX(Z + 4, Z + 3), BoardY(Z + 4, Z + 3)), 15
BoardRun(Z + 5, Z + 4) = 1: CIRCLE (BoardX(Z + 5, Z + 4), BoardY(Z + 5, Z + 4)), 10, 15: PAINT (BoardX(Z + 5, Z + 4), BoardY(Z + 5, Z + 4)), 15
BoardRun(Z + 6, Z + 5) = 1: CIRCLE (BoardX(Z + 6, Z + 5), BoardY(Z + 6, Z + 5)), 10, 15: PAINT (BoardX(Z + 6, Z + 5), BoardY(Z + 6, Z + 5)), 15
END IF
NEXT
FOR Z = 0 TO 2
IF BoardPlayer(3 + Z, 1 + Z) = Player AND BoardPlayer(4 + Z, 2 + Z) = Player AND BoardPlayer(5 + Z, 3 + Z) = Player AND BoardPlayer(6 + Z, 4 + Z) = Player AND BoardPlayer(7 + Z, 5 + Z) = Player THEN
X(7) = 1
BoardRun(Z + 3, Z + 1) = 1: CIRCLE (BoardX(Z + 3, Z + 1), BoardY(Z + 3, Z + 1)), 10, 15: PAINT (BoardX(Z + 3, Z + 1), BoardY(Z + 3, Z + 1)), 15
BoardRun(Z + 4, Z + 2) = 1: CIRCLE (BoardX(Z + 4, Z + 2), BoardY(Z + 4, Z + 2)), 10, 15: PAINT (BoardX(Z + 4, Z + 2), BoardY(Z + 4, Z + 2)), 15
BoardRun(Z + 5, Z + 3) = 1: CIRCLE (BoardX(Z + 5, Z + 3), BoardY(Z + 5, Z + 3)), 10, 15: PAINT (BoardX(Z + 5, Z + 3), BoardY(Z + 5, Z + 3)), 15
BoardRun(Z + 6, Z + 4) = 1: CIRCLE (BoardX(Z + 6, Z + 4), BoardY(Z + 6, Z + 4)), 10, 15: PAINT (BoardX(Z + 6, Z + 4), BoardY(Z + 6, Z + 4)), 15
BoardRun(Z + 7, Z + 5) = 1: CIRCLE (BoardX(Z + 7, Z + 5), BoardY(Z + 7, Z + 5)), 10, 15: PAINT (BoardX(Z + 7, Z + 5), BoardY(Z + 7, Z + 5)), 15
END IF
NEXT
FOR Z = 0 TO 1
IF BoardPlayer(4 + Z, 1 + Z) = Player AND BoardPlayer(5 + Z, 2 + Z) = Player AND BoardPlayer(6 + Z, 3 + Z) = Player AND BoardPlayer(7 + Z, 4 + Z) = Player AND BoardPlayer(8 + Z, 5 + Z) = Player THEN
X(8) = 1
BoardRun(Z + 4, Z + 1) = 1: CIRCLE (BoardX(Z + 4, Z + 1), BoardY(Z + 4, Z + 1)), 10, 15: PAINT (BoardX(Z + 4, Z + 1), BoardY(Z + 4, Z + 1)), 15
BoardRun(Z + 5, Z + 2) = 1: CIRCLE (BoardX(Z + 5, Z + 2), BoardY(Z + 5, Z + 2)), 10, 15: PAINT (BoardX(Z + 5, Z + 2), BoardY(Z + 5, Z + 2)), 15
BoardRun(Z + 6, Z + 3) = 1: CIRCLE (BoardX(Z + 6, Z + 3), BoardY(Z + 6, Z + 3)), 10, 15: PAINT (BoardX(Z + 6, Z + 3), BoardY(Z + 6, Z + 3)), 15
BoardRun(Z + 7, Z + 4) = 1: CIRCLE (BoardX(Z + 7, Z + 4), BoardY(Z + 7, Z + 4)), 10, 15: PAINT (BoardX(Z + 7, Z + 4), BoardY(Z + 7, Z + 4)), 15
BoardRun(Z + 8, Z + 5) = 1: CIRCLE (BoardX(Z + 8, Z + 5), BoardY(Z + 8, Z + 5)), 10, 15: PAINT (BoardX(Z + 8, Z + 5), BoardY(Z + 8, Z + 5)), 15
END IF
NEXT
IF BoardPlayer(5, 1) = Player AND BoardPlayer(6, 2) = Player AND BoardPlayer(7, 3) = Player AND BoardPlayer(8, 4) = Player AND BoardPlayer(9, 5) = Player THEN
X(9) = 1
BoardRun(5, 1) = 1: CIRCLE (BoardX(5, 1), BoardY(5, 1)), 10, 15: PAINT (BoardX(5, 1), BoardY(5, 1)), 15
BoardRun(6, 2) = 1: CIRCLE (BoardX(6, 2), BoardY(6, 2)), 10, 15: PAINT (BoardX(6, 2), BoardY(6, 2)), 15
BoardRun(7, 3) = 1: CIRCLE (BoardX(7, 3), BoardY(7, 3)), 10, 15: PAINT (BoardX(7, 3), BoardY(7, 3)), 15
BoardRun(8, 4) = 1: CIRCLE (BoardX(8, 4), BoardY(8, 4)), 10, 15: PAINT (BoardX(8, 4), BoardY(8, 4)), 15
BoardRun(9, 5) = 1: CIRCLE (BoardX(9, 5), BoardY(9, 5)), 10, 15: PAINT (BoardX(9, 5), BoardY(9, 5)), 15
END IF
_PRINTSTRING (780, 670), " Player " + STR$(Player) + " is the Winner! "
_PRINTSTRING (780, 705), " Play Another Game? (Y or N) "
YorN: A$ = UCASE$(INKEY$): IF A$ = "" GOTO YorN
IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
IF A$ = "Y" THEN RUN
IF A$ = "N" THEN SYSTEM
GOTO YorN
![[Image: Call-by-reference-Anzeige2023-11-27.jpg]](https://i.ibb.co/YXNmXWK/Call-by-reference-Anzeige2023-11-27.jpg)
![[Image: screenshot1.png]](https://i.ibb.co/FhSqHwF/screenshot1.png)
![[Image: screenshot2.png]](https://i.ibb.co/dG5g53C/screenshot2.png)
![[Image: Dice-Poker-Screenshot.png]](https://i.ibb.co/DDTyFLJ/Dice-Poker-Screenshot.png)
