Author Topic: One Key Connect 4 (8x8) Halloween Style (Read 9702 times)

bplus · « **on:** October 19, 2021, 08:09:18 pm »

I was curious how long this would take to convert and modify:

Code: QB64: [Select]

Option _Explicit ' One Key Connect 4 (8x8) Halloween Style - bplus 2021-10-19
Const SQ = 60 '       square or grid cell
Const NumCols = 8 '   number of columns
Const NumRows = 8 '   you guessed it
Const NCM1 = NumCols - 1 ' NumCols minus 1
Const NRM1 = NumRows - 1 ' you can guess surely
Const SW = SQ * (NumCols + 2) '  screen width
Const SH = SQ * (NumRows + 3) '  screen height
Const P = 1 '       Player is 1 on grid
Const AI = -1 '     AI is -1 on grid
Const XO = SQ '     x offset for grid
Const YO = 2 * SQ ' y offset for grid
 
ReDim Shared Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
ReDim Shared DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
ReDim Shared AIX, AIY ' last move of AI for highlighting in display
ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
ReDim Shared Record$(NCM1, NRM1)
Dim Shared sx ' for pumpkin recursion shifty eyes
Dim place, k$, t, r, s$, pr, d
 
Screen _NewImage(SW, SH, 32)
_ScreenMove 360, 60
 
_Title "One Key Connect 4 (8x8) Halloween Style"
d = 1
While _KeyDown(32) = 0
    Cls
    pumpkin 0, _Width / 2, _Height / 2, _Height / 2.3, 3
    sx = sx + d
    If sx > 10 Then d = -d: sx = 10
    If sx < -10 Then d = -d: sx = -10
    Color &HFFFFFFFF, &HFF000000:
    Locate 40, 33: Print "Spacebar Only"
    _Display
    _Limit 20
Wend
_KeyClear
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
place = -1
t = Timer
pr = (SQ - 6) / 2
While GameOn
    Cls
    If Turn = P Then
        k$ = InKey$
        If k$ = Chr$(27) Then System ' emergency exit
 
        If k$ = " " Then
            t = Timer: place = place + 1
            If place >= NumCols Then place = -1
        Else ' watch out for midnight!
            If Timer - t > 4 And place <> -1 Then ' col selected
                r = GetOpenRow(place)
                If r <> NumRows Then
                    Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
                    place = -1 ' reset back to hold area
                End If
            End If
        End If
    Else
        AIMove
        Turn = P: MoveNum = MoveNum + 1: t = Timer
    End If
    ShowGrid
    If Turn = P Then
        If place = -1 Then
            s$ = "Holding area, press spacebar until over column to play."
        Else
            s$ = "Press Spacebar, if don't want to play" + Str$(place) + " column."
        End If
        Color &HFFFFFFFF, 0
        _PrintString (XO, YO - SQ - 16), s$
    End If
    pumpkin 0, place * SQ + XO + SQ / 2, SQ + SQ / 2, pr, 2
    sx = Rnd * 6 - 3
    _Display
    _Limit 15
Wend
 
Sub AIMove
    ' What this sub does in English:
    ' This sub assigns the value to playing each column, then plays the best value with following caveats:
    ' + If it finds a winning move, it will play that immediately.
    ' + If it finds a spoiler move, it will play that if no winning move was found.
    ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
    '   but it might be the only legal move left.  We will have to play it if no better score was found.
 
    Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
    Dim openRow(NCM1) ' find open rows once
    ReDim Scores(NCM1) ' evaluate each column's potential
    AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
    For c = 0 To NCM1
        openRow(c) = GetOpenRow(c)
        r = openRow(c)
        If r <> NumRows Then
            For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
                startC = c + -3 * DX(d): startR = r + -3 * DY(d)
                For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
                    cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
                    'from this start position run 4 steps forward to count all connects involving cell c, r
                    For iStep = 0 To 3 ' process a potential connect 4
                        test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
                        If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
                        If test = AI Then cntA = cntA + 1
                        If test = P Then cntP = cntP + 1
                    Next iStep
                    If goodF Then 'evaluate the Legal Connect4 we could build with c, r
                        If cntA = 3 Then ' we are done!  winner!
                            AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
                            Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
                            Scores(c) = 1000
                            Exit Sub
                        ElseIf cntP = 3 Then 'next best move spoiler!
                            AIX = c: AIY = r 'set the move but don't exit there might be a winner
                            Scores(c) = 900
                        ElseIf cntA = 0 And cntP = 2 Then
                            Scores(c) = Scores(c) + 8
                        ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
                            Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
                        ElseIf cntA = 0 And cntP = 1 Then
                            Scores(c) = Scores(c) + 4
                        ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
                            Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
                        ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
                            Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
                        End If
                    End If ' in the board
                Next i
            Next d
            If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
        End If
    Next
    If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
        Grid(AIX, AIY) = AI ' make move on grid and done!
        Exit Sub
    Else
        If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
            bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
        Else
            bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
        End If
        For c = 0 To NCM1
            r = openRow(c)
            If r <> NumRows Then
                If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
            End If
        Next
        If AIX <> -1 Then
            Grid(AIX, AIY) = AI ' make first best score move we found
        Else 'We have trouble!  Oh but it could be there are no moves!!!
            ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
            ' Just in case it didn't here is an error stop!
            Beep: Locate 4, 2: Print "AI has failed to find a proper move, press any to end..."
            Sleep ' <<< pause until user presses a key
            End
        End If
    End If
End Sub
 
Function GetOpenRow (forCol)
    Dim i
    GetOpenRow = NumRows 'assume none open
    If forCol < 0 Or forCol > NCM1 Then Exit Function
    For i = NRM1 To 0 Step -1
        If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
    Next
End Function
 
Function Stupid (c, r)
    Dim pr
    Grid(c, r) = AI
    pr = GetOpenRow(c)
    If pr <> NumRows Then
        Grid(c, pr) = P
        If CheckWin = 4 Then Stupid = -1
        Grid(c, pr) = 0
    End If
    Grid(c, r) = 0
End Function
 
Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
    ' need to check the grid(c, r) but only if c, r is on the board
    If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
End Function
 
Sub ShowGrid
    Static lastMoveNum
    Dim i, r, c, check, s$, k$
    If MoveNum <> lastMoveNum Then ' file newest move
        If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
        If Turn = -1 Then
            Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
        Else
            Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
        End If
        lastMoveNum = MoveNum
    End If
    'cls
    Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
    For i = 0 To NumCols 'grid
        Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
    Next
    For i = 0 To NumRows
        Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
    Next
    For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
        For c = 0 To NCM1
            If Grid(c, r) = P Then
                Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF000000, BF
                pumpkin 0, c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, (SQ - 6) / 2, 2
 
            ElseIf Grid(c, r) = AI Then
                If c = AIX And r = AIY Then 'highlite last AI move
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF8888FF, BF
                Else
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF4444FF, BF
                End If
                drawSpinner c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, .5, _Pi(-c / 8), _RGB32(Rnd * 30 + 40, Rnd * 15 + 20, Rnd * 6 + 10)
            End If
            s$ = _Trim$(Str$(Scores(c)))
            _PrintString (XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
        Next
    Next
    '_Display
    check = CheckWin
    If check Then 'report end of round ad see if want to play again
        If check = 4 Or check = -4 Then
            For i = 0 To 3
                Line ((WinX + i * DX(WinD)) * SQ + XO + 5, (WinY + i * DY(WinD)) * SQ + YO + 5)-Step(SQ - 10, SQ - 10), &HFFFFFF00, B
            Next
        End If
        For r = 0 To NRM1
            For c = 0 To NCM1
                If Record$(c, r) <> "" Then
                    s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
                    If Right$(Record$(c, r), 1) = "A" Then Color &HFFFFFFFF, &HFF000000 Else Color &HFFFFFFFF, &HFF000000
                    _PrintString (SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22), s$
                End If
            Next
            Color , &HFF000000
        Next
        If check = -4 Then
            s$ = " AI is Winner!"
        ElseIf check = 4 Then
            s$ = " Human is Winner!"
        ElseIf check = NumRows Then
            s$ = " Board is full, no winner." ' keep Turn the same
        End If
        Locate 2, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        s$ = " Play again? press spacebar, escape to quit... "
        Locate 4, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        _Display
        keywait:
        While Len(k$) = 0
            k$ = InKey$
            _Limit 200
        Wend
        If k$ = " " Then
            ReDim Grid(NCM1, NRM1), Scores(NCM1)
            If GoFirst = P Then GoFirst = AI Else GoFirst = P
            Turn = GoFirst: MoveNum = 0
        ElseIf Asc(k$) = 27 Then
            System
        Else
            k$ = "": GoTo keywait:
        End If
    End If
End Sub
 
Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
    Dim gridFull, r, c, s, i
    gridFull = NumRows
    For r = NRM1 To 0 Step -1 'bottom to top
        For c = 0 To NCM1
            If Grid(c, r) Then ' check if c starts a row
                If c < NCM1 - 2 Then
                    s = 0
                    For i = 0 To 3 ' east
                        s = s + Grid(c + i, r)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
                End If
                If r > 2 Then ' check if c starts a col
                    s = 0
                    For i = 0 To 3 ' north
                        s = s + Grid(c, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
                End If
                If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
                    s = 0
                    For i = 0 To 3 ' north  east
                        s = s + Grid(c + i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
                End If
                If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
                    s = 0
                    For i = 0 To 3 ' north west
                        s = s + Grid(c - i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
                End If
            Else
                gridFull = 0 ' at least one enpty cell left
            End If 'grid is something
        Next
    Next
    CheckWin = gridFull
End Function
 
 
Sub pumpkin (dh&, cx, cy, pr, limit)
    Dim lastr, u, dx, i, tx1, tx2, tx3, ty1, ty2, ty3, ty22, sxs
    'carve this!
    Color &HFFFF0000
    fEllipse cx, cy, pr, 29 / 35 * pr
    Color &HFF000000
    lastr = 2 / 7 * pr
    Do
        ellipse cx, cy, lastr, 29 / 35 * pr
        lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
        If pr - lastr < 1 / 80 * pr Then Exit Do
    Loop
 
    ' 'flickering candle light
    'Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' eye sockets
    ftri2 dh&, cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' nose
    ftri2 dh&, cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' evil grin
    ftri2 dh&, cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' moving teeth/talk/grrrr..
    u = rand%(4, 8)
    dx = pr / u
    For i = 1 To u
        tx1 = cx - 6 * pr / 12 + (i - 1) * dx
        tx2 = tx1 + .5 * dx
        tx3 = tx1 + dx
        ty1 = cy + 5 * pr / 12
        ty3 = cy + 5 * pr / 12
        ty2 = cy + (4 - Rnd) * pr / 12
        ty22 = cy + (6 + Rnd) * pr / 12
        ftri2 dh&, tx1, ty1, tx2, ty2, tx3, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
        ftri2 dh&, tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    Next
    If limit Then
        'shifty eyes
        If limit = 3 Then sxs = sx Else sxs = .1 * limit * sx
        pumpkin dh&, sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
        pumpkin dh&, sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    End If
End Sub
 
Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, x As Long, y As Long
    scale = yRadius / xRadius
    Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
        Line (CX + x, CY - y)-(CX + x, CY + y), , BF
        Line (CX - x, CY - y)-(CX - x, CY + y), , BF
    Next
End Sub
 
Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, xs As Long, x As Long, y As Long
    Dim lastx As Long, lasty As Long
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
        lastx = x: lasty = y
    Next
End Sub
 
Sub ftri2 (returnDest&, x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest returnDest&
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
 
 
 
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
    Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _Atan2(y2 - y1, x2 - x1)
    a1 = a + _Pi(1 / 2)
    a2 = a - _Pi(1 / 2)
    x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
    x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
    x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
    x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
    fquad x3, y3, x4, y4, x5, y5, x6, y6, c
    Fcirc x1, y1, r1, c
    Fcirc x2, y2, r2, c
End Sub
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
    ftri x1, y1, x2, y2, x4, y4, c
    ftri x3, y3, x4, y4, x1, y1, c
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest 0
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
    Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
    Dim prc As _Unsigned Long, tef As Long
    prc = _RGB32(255, 255, 255, 255)
    If a > b Then max = a + 1 Else max = b + 1
    mx2 = max + max
    tef = _NewImage(mx2, mx2)
    _Dest tef
    _Source tef 'point wont read without this!
    For k = 0 To 6.2832 + .05 Step .1
        i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
        j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
        If k <> 0 Then
            Line (lasti, lastj)-(i, j), prc
        Else
            PSet (i, j), prc
        End If
        lasti = i: lastj = j
    Next
    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
    For y = 0 To mx2
        x = 0
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc And x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
    Next
    _Dest destHandle&
    For y = 0 To mx2
        If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
    Next
    _FreeImage tef
End Sub
 
Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub
 
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
    Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
    Dim rred, bblue, ggreen
    Static switch As Integer
    switch = switch + 2
    switch = switch Mod 16 + 1
    rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
    r = 10 * scale
    x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
    r = 2 * r 'lg lengths
    For lg = 1 To 8
        If lg < 5 Then
            a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
        Else
            a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
        End If
        x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
        drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
        If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
        a1 = a + d * _Pi(1 / 12)
        x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
        drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
        rd = Int(Rnd * 8) + 1
        a2 = a1 + d * _Pi(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
        drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
    Next
    r = r * .5
    Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
    x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
    TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
End Sub
 
 

Attached is Source and .exe for Windows (no assets program)

One Key Connect 4 (8x8) Halloween Style.PNG

Cobalt · « **Reply #1 on:** October 19, 2021, 08:18:38 pm »

Not bad. The drop delay was a bit slow for my taste though.
Would have been a neat addition to have the pieces drop down the board rather than just pop in place, and using an overlay you could even "simulate" round pieces!

and Yes I LOST! nearly had the whole board filled though.

jack · « **Reply #2 on:** October 19, 2021, 08:19:04 pm »

hi bplus
the game play would be better if you could also select the row

bplus · « **Reply #3 on:** October 19, 2021, 08:29:47 pm »

@Cobalt nice suggestions thanks!

@jack what? AI pieces have to be in next available slot in column just like yours, maybe AI makes it's move too fast? It's last move is the lighter blue square. It goes first in first game but you go first in next, it alternates.

The human player (you) must keep pressing spacebar until the pumpkin piece is over the column you want then just wait or wait in holding area or spacebar back to holding area until you are sure of your column.

bplus · « **Reply #4 on:** October 19, 2021, 08:33:47 pm »

Quote from: jack on October 19, 2021, 08:19:04 pm

hi bplus
the game play would be better if you could also select the row

Ah! you haven't played Connect 4 before. OK

Pete · « **Reply #5 on:** October 19, 2021, 09:05:10 pm »

The game would be better if you could blow stuff up. I played 4 times. I lost 4 times. I had to go in the backyard and blow up the barbecue. Oh well, it's the neighbors. Sorry Cobalt, it was getting rusty, anyway.

Pete

5 of 5: 🎃🎃🎃🎃🎃

bplus · « **Reply #6 on:** October 19, 2021, 09:25:27 pm »

Here is Cobalt's suggestion about dropping the pumpkin piece down as you would see it on a real game board:
Luv it!

Code: QB64: [Select]

Option _Explicit ' One Key Connect 4 (8x8) Halloween Style - bplus 2021-10-19
Const SQ = 60 '       square or grid cell
Const NumCols = 8 '   number of columns
Const NumRows = 8 '   you guessed it
Const NCM1 = NumCols - 1 ' NumCols minus 1
Const NRM1 = NumRows - 1 ' you can guess surely
Const SW = SQ * (NumCols + 2) '  screen width
Const SH = SQ * (NumRows + 3) '  screen height
Const P = 1 '       Player is 1 on grid
Const AI = -1 '     AI is -1 on grid
Const XO = SQ '     x offset for grid
Const YO = 2 * SQ ' y offset for grid
 
ReDim Shared Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
ReDim Shared DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
ReDim Shared AIX, AIY ' last move of AI for highlighting in display
ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
ReDim Shared Record$(NCM1, NRM1)
Dim Shared sx ' for pumpkin recursion shifty eyes
Dim place, k$, t, r, s$, pr, d, temp&, target, y, delaid
 
Screen _NewImage(SW, SH, 32)
_ScreenMove 360, 60
 
_Title "One Key Connect 4 (8x8) Halloween Style"
d = 1
While _KeyDown(32) = 0
    Cls
    pumpkin 0, _Width / 2, _Height / 2, _Height / 2.3, 3
    sx = sx + d
    If sx > 10 Then d = -d: sx = 10
    If sx < -10 Then d = -d: sx = -10
    Color &HFFFFFFFF, &HFF000000:
    Locate 40, 33: Print "Spacebar Only"
    _Display
    _Limit 20
Wend
_KeyClear
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
place = -1
t = Timer
pr = (SQ - 6) / 2
While GameOn
    Cls
    If Turn = P Then
        k$ = InKey$
        If k$ = Chr$(27) Then System ' emergency exit
 
        If k$ = " " Then
            t = Timer: place = place + 1
            If place >= NumCols Then place = -1
        Else ' watch out for midnight!
            If Timer - t < 0 Then 'midnight problem
                t = Timer ' wait a little longer
            Else
                If Timer - t > 3 And place <> -1 Then ' col selected
                    r = GetOpenRow(place)
                    If r <> NumRows Then
                        Cls
                        ShowGrid
                        _Display
                        temp& = _NewImage(_Width, _Height, 32)
                        _PutImage , 0, temp& 'snapshot
                        y = SQ + SQ / 2
                        target = r * SQ + YO + SQ / 2
                        delaid = 6
                        While y < target
                            y = y + 1
                            Cls
                            _PutImage , temp&, 0
                            pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 3
                            sx = Rnd * 6 - 3
                            _Display
                            _Limit delaid
                            delaid = delaid + 2
                        Wend
                        _FreeImage temp&
                        Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
                        place = -1 ' reset back to hold area
                    Else
                        Beep
                    End If
                End If
            End If
        End If
    Else
        AIMove
        Turn = P: MoveNum = MoveNum + 1: t = Timer
    End If
    ShowGrid
    If Turn = P Then
        If place = -1 Then
            s$ = "Holding area, press spacebar until over column to play."
        Else
            s$ = "Press Spacebar, if don't want to play" + Str$(place) + " column."
        End If
        Color &HFFFFFFFF, 0
        _PrintString (XO, YO - SQ - 16), s$
    End If
    pumpkin 0, place * SQ + XO + SQ / 2, SQ + SQ / 2, pr, 3
    sx = Rnd * 6 - 3
    _Display
    _Limit 15
Wend
 
Sub AIMove
    ' What this sub does in English:
    ' This sub assigns the value to playing each column, then plays the best value with following caveats:
    ' + If it finds a winning move, it will play that immediately.
    ' + If it finds a spoiler move, it will play that if no winning move was found.
    ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
    '   but it might be the only legal move left.  We will have to play it if no better score was found.
 
    Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
    Dim openRow(NCM1) ' find open rows once
    ReDim Scores(NCM1) ' evaluate each column's potential
    AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
    For c = 0 To NCM1
        openRow(c) = GetOpenRow(c)
        r = openRow(c)
        If r <> NumRows Then
            For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
                startC = c + -3 * DX(d): startR = r + -3 * DY(d)
                For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
                    cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
                    'from this start position run 4 steps forward to count all connects involving cell c, r
                    For iStep = 0 To 3 ' process a potential connect 4
                        test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
                        If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
                        If test = AI Then cntA = cntA + 1
                        If test = P Then cntP = cntP + 1
                    Next iStep
                    If goodF Then 'evaluate the Legal Connect4 we could build with c, r
                        If cntA = 3 Then ' we are done!  winner!
                            AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
                            Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
                            Scores(c) = 1000
                            Exit Sub
                        ElseIf cntP = 3 Then 'next best move spoiler!
                            AIX = c: AIY = r 'set the move but don't exit there might be a winner
                            Scores(c) = 900
                        ElseIf cntA = 0 And cntP = 2 Then
                            Scores(c) = Scores(c) + 8
                        ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
                            Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
                        ElseIf cntA = 0 And cntP = 1 Then
                            Scores(c) = Scores(c) + 4
                        ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
                            Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
                        ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
                            Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
                        End If
                    End If ' in the board
                Next i
            Next d
            If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
        End If
    Next
    If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
        Grid(AIX, AIY) = AI ' make move on grid and done!
        Exit Sub
    Else
        If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
            bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
        Else
            bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
        End If
        For c = 0 To NCM1
            r = openRow(c)
            If r <> NumRows Then
                If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
            End If
        Next
        If AIX <> -1 Then
            Grid(AIX, AIY) = AI ' make first best score move we found
        Else 'We have trouble!  Oh but it could be there are no moves!!!
            ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
            ' Just in case it didn't here is an error stop!
            Beep: Locate 4, 2: Print "AI has failed to find a proper move, press any to end..."
            Sleep ' <<< pause until user presses a key
            End
        End If
    End If
End Sub
 
Function GetOpenRow (forCol)
    Dim i
    GetOpenRow = NumRows 'assume none open
    If forCol < 0 Or forCol > NCM1 Then Exit Function
    For i = NRM1 To 0 Step -1
        If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
    Next
End Function
 
Function Stupid (c, r)
    Dim pr
    Grid(c, r) = AI
    pr = GetOpenRow(c)
    If pr <> NumRows Then
        Grid(c, pr) = P
        If CheckWin = 4 Then Stupid = -1
        Grid(c, pr) = 0
    End If
    Grid(c, r) = 0
End Function
 
Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
    ' need to check the grid(c, r) but only if c, r is on the board
    If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
End Function
 
Sub ShowGrid
    Static lastMoveNum
    Dim i, r, c, check, s$, k$
    If MoveNum <> lastMoveNum Then ' file newest move
        If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
        If Turn = -1 Then
            Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
        Else
            Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
        End If
        lastMoveNum = MoveNum
    End If
    'cls
    Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
    For i = 0 To NumCols 'grid
        Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
    Next
    For i = 0 To NumRows
        Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
    Next
    For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
        For c = 0 To NCM1
            If Grid(c, r) = P Then
                Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF000000, BF
                pumpkin 0, c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, (SQ - 6) / 2, 2
 
            ElseIf Grid(c, r) = AI Then
                If c = AIX And r = AIY Then 'highlite last AI move
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF8888FF, BF
                Else
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF4444FF, BF
                End If
                drawSpinner c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, .5, _Pi(-c / 8), _RGB32(Rnd * 30 + 40, Rnd * 15 + 20, Rnd * 6 + 10)
            End If
            s$ = _Trim$(Str$(Scores(c)))
            _PrintString (XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
        Next
    Next
    '_Display
    check = CheckWin
    If check Then 'report end of round ad see if want to play again
        If check = 4 Or check = -4 Then
            For i = 0 To 3
                Line ((WinX + i * DX(WinD)) * SQ + XO + 5, (WinY + i * DY(WinD)) * SQ + YO + 5)-Step(SQ - 10, SQ - 10), &HFFFFFF00, B
            Next
        End If
        For r = 0 To NRM1
            For c = 0 To NCM1
                If Record$(c, r) <> "" Then
                    s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
                    If Right$(Record$(c, r), 1) = "A" Then Color &HFFFFFFFF, &HFF000000 Else Color &HFFFFFFFF, &HFF000000
                    _PrintString (SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22), s$
                End If
            Next
            Color , &HFF000000
        Next
        If check = -4 Then
            s$ = " AI is Winner!"
        ElseIf check = 4 Then
            s$ = " Human is Winner!"
        ElseIf check = NumRows Then
            s$ = " Board is full, no winner." ' keep Turn the same
        End If
        Locate 2, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        s$ = " Play again? press spacebar, escape to quit... "
        Locate 4, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        _Display
        keywait:
        While Len(k$) = 0
            k$ = InKey$
            _Limit 200
        Wend
        If k$ = " " Then
            ReDim Grid(NCM1, NRM1), Scores(NCM1)
            If GoFirst = P Then GoFirst = AI Else GoFirst = P
            Turn = GoFirst: MoveNum = 0
        ElseIf Asc(k$) = 27 Then
            System
        Else
            k$ = "": GoTo keywait:
        End If
    End If
End Sub
 
Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
    Dim gridFull, r, c, s, i
    gridFull = NumRows
    For r = NRM1 To 0 Step -1 'bottom to top
        For c = 0 To NCM1
            If Grid(c, r) Then ' check if c starts a row
                If c < NCM1 - 2 Then
                    s = 0
                    For i = 0 To 3 ' east
                        s = s + Grid(c + i, r)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
                End If
                If r > 2 Then ' check if c starts a col
                    s = 0
                    For i = 0 To 3 ' north
                        s = s + Grid(c, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
                End If
                If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
                    s = 0
                    For i = 0 To 3 ' north  east
                        s = s + Grid(c + i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
                End If
                If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
                    s = 0
                    For i = 0 To 3 ' north west
                        s = s + Grid(c - i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
                End If
            Else
                gridFull = 0 ' at least one enpty cell left
            End If 'grid is something
        Next
    Next
    CheckWin = gridFull
End Function
 
 
Sub pumpkin (dh&, cx, cy, pr, limit)
    Dim lastr, u, dx, i, tx1, tx2, tx3, ty1, ty2, ty3, ty22, sxs
    'carve this!
    Color &HFFFF0000
    fEllipse cx, cy, pr, 29 / 35 * pr
    Color &HFF000000
    lastr = 2 / 7 * pr
    Do
        ellipse cx, cy, lastr, 29 / 35 * pr
        lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
        If pr - lastr < 1 / 80 * pr Then Exit Do
    Loop
 
    ' 'flickering candle light
    'Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' eye sockets
    ftri2 dh&, cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' nose
    ftri2 dh&, cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' evil grin
    ftri2 dh&, cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' moving teeth/talk/grrrr..
    u = rand%(4, 8)
    dx = pr / u
    For i = 1 To u
        tx1 = cx - 6 * pr / 12 + (i - 1) * dx
        tx2 = tx1 + .5 * dx
        tx3 = tx1 + dx
        ty1 = cy + 5 * pr / 12
        ty3 = cy + 5 * pr / 12
        ty2 = cy + (4 - Rnd) * pr / 12
        ty22 = cy + (6 + Rnd) * pr / 12
        ftri2 dh&, tx1, ty1, tx2, ty2, tx3, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
        ftri2 dh&, tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    Next
    If limit Then
        'shifty eyes
        If limit = 3 Then sxs = sx Else sxs = .1 * limit * sx
        pumpkin dh&, sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
        pumpkin dh&, sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    End If
End Sub
 
Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, x As Long, y As Long
    scale = yRadius / xRadius
    Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
        Line (CX + x, CY - y)-(CX + x, CY + y), , BF
        Line (CX - x, CY - y)-(CX - x, CY + y), , BF
    Next
End Sub
 
Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, xs As Long, x As Long, y As Long
    Dim lastx As Long, lasty As Long
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
        lastx = x: lasty = y
    Next
End Sub
 
Sub ftri2 (returnDest&, x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest returnDest&
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
 
 
 
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
    Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _Atan2(y2 - y1, x2 - x1)
    a1 = a + _Pi(1 / 2)
    a2 = a - _Pi(1 / 2)
    x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
    x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
    x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
    x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
    fquad x3, y3, x4, y4, x5, y5, x6, y6, c
    Fcirc x1, y1, r1, c
    Fcirc x2, y2, r2, c
End Sub
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
    ftri x1, y1, x2, y2, x4, y4, c
    ftri x3, y3, x4, y4, x1, y1, c
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest 0
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
    Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
    Dim prc As _Unsigned Long, tef As Long
    prc = _RGB32(255, 255, 255, 255)
    If a > b Then max = a + 1 Else max = b + 1
    mx2 = max + max
    tef = _NewImage(mx2, mx2)
    _Dest tef
    _Source tef 'point wont read without this!
    For k = 0 To 6.2832 + .05 Step .1
        i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
        j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
        If k <> 0 Then
            Line (lasti, lastj)-(i, j), prc
        Else
            PSet (i, j), prc
        End If
        lasti = i: lastj = j
    Next
    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
    For y = 0 To mx2
        x = 0
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc And x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
    Next
    _Dest destHandle&
    For y = 0 To mx2
        If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
    Next
    _FreeImage tef
End Sub
 
Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub
 
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
    Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
    Dim rred, bblue, ggreen
    Static switch As Integer
    switch = switch + 2
    switch = switch Mod 16 + 1
    rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
    r = 10 * scale
    x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
    r = 2 * r 'lg lengths
    For lg = 1 To 8
        If lg < 5 Then
            a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
        Else
            a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
        End If
        x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
        drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
        If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
        a1 = a + d * _Pi(1 / 12)
        x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
        drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
        rd = Int(Rnd * 8) + 1
        a2 = a1 + d * _Pi(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
        drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
    Next
    r = r * .5
    Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
    x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
    TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
End Sub
 
 

For Pete:

For friends at Syntax Bomb the Windows compiled version and source:
(Updated just before midnight, only one download before update)

Pete · « **Reply #7 on:** October 19, 2021, 10:01:23 pm »

I like the original version better, but then I'm impatient. I see my avatar stomping that pumpkin into place with his tiny Western boots.

If I had one suggestion to make this version better, it would be to add a gravity factor, so the pumpkin picks up speed as it falls.

I thought you might make it shake a bit as it falls, although the last time I played this game, I was 8.

Pete

bplus · « **Reply #8 on:** October 19, 2021, 11:15:17 pm »

delaid variable in _Limit increases allowing more loop updates per second.
Not just gravity, frictional force works against complete freefall of piece. I thought it noticeable specially at the beginning.

Code: QB64: [Select]

                        While y < target
                            y = y + 1
                            Cls
                            _PutImage , temp&, 0
                            pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 3
                            sx = Rnd * 6 - 3
                            _Display
                            _Limit delaid
                            delaid = delaid + 2
                        Wend
 

bplus · « **Reply #9 on:** October 19, 2021, 11:57:17 pm »

OK I sped up the drop, decreased the Timer difference from 4 to 2 secs and it turns out the screen update sub ShowGrid is fast enough that I don't have to take a screen snapshot so the pumpkins and spiders remain quite active as the pumpkin piece drops down the column.

Modified to this section in code:

Code: QB64: [Select]

                If Timer - t > 2 And place <> -1 Then ' col selected
                    r = GetOpenRow(place)
                    If r <> NumRows Then
                        y = SQ + SQ / 2
                        target = r * SQ + YO + SQ / 2
                        delaid = 6
                        While y < target
                            y = y + 1
                            Cls
                            ShowGrid
                            pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 3
                            sx = Rnd * 6 - 3
                            _Display
                            _Limit delaid
                            delaid = delaid * 2
                        Wend
                        Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
                        place = -1 ' reset back to hold area
                    Else
                        Beep
                    End If
                End If
 

I have changed out the old zip file in Best Answer with the new code source and Windows compiled .exe, so it is still Best Answer and spiders and pumpkins all move while piece falls into place.

Pete · « **Reply #10 on:** October 20, 2021, 12:36:54 am »

Better. Either that, or I'm just in a better mood because after 7 games, I finally beat the A.I.

Pete 👠 Woooohoooo!

Cobalt · « **Reply #11 on:** October 22, 2021, 11:14:26 am »

I added that board overlay I was talking about.

Code: QB64: [Select]

'OPTION _EXPLICIT ' One Key Connect 4 (8x8) Halloween Style - bplus 2021-10-19
CONST SQ = 60 '       square or grid cell
CONST NumCols = 8 '   number of columns
CONST NumRows = 8 '   you guessed it
CONST NCM1 = NumCols - 1 ' NumCols minus 1
CONST NRM1 = NumRows - 1 ' you can guess surely
CONST SW = SQ * (NumCols + 2) '  screen width
CONST SH = SQ * (NumRows + 3) '  screen height
CONST P = 1 '       Player is 1 on grid
CONST AI = -1 '     AI is -1 on grid
CONST XO = SQ '     x offset for grid
CONST YO = 2 * SQ ' y offset for grid
 
REDIM SHARED Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
REDIM SHARED DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
REDIM SHARED Scores(NCM1) ' rating column for AI and displaying them
REDIM SHARED AIX, AIY ' last move of AI for highlighting in display
REDIM SHARED WinX, WinY, WinD ' display Winning Connect 4
REDIM SHARED GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
REDIM SHARED Record$(NCM1, NRM1)
DIM SHARED sx ' for pumpkin recursion shifty eyes
DIM place, k$, t, r, s$, pr, d, temp&, target, y, delaid
DIM SHARED Overlay& 'the board overlay
 
SCREEN _NEWIMAGE(SW, SH, 32)
_SCREENMOVE 360, 60
Overlay& = _NEWIMAGE(SW, SH, 32)
Create_Board
 
_TITLE "One Key Connect 4 (8x8) Halloween Style"
d = 1
WHILE _KEYDOWN(32) = 0
 CLS
 pumpkin 0, _WIDTH / 2, _HEIGHT / 2, _HEIGHT / 2.3, 3
 sx = sx + d
 IF sx > 10 THEN d = -d: sx = 10
 IF sx < -10 THEN d = -d: sx = -10
 COLOR &HFFFFFFFF, &HFF000000:
 LOCATE 40, 33: PRINT "Spacebar Only"
 _DISPLAY
 _LIMIT 20
WEND
_KEYCLEAR
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
place = -1
t = TIMER
pr = (SQ - 6) / 2
WHILE GameOn
 CLS
 IF Turn = P THEN
  k$ = INKEY$
  IF k$ = CHR$(27) THEN SYSTEM ' emergency exit
  IF k$ = " " THEN
   t = TIMER: place = place + 1
   IF place >= NumCols THEN place = -1
  ELSE ' watch out for midnight!
   IF TIMER - t < 0 THEN 'midnight problem
    t = TIMER ' wait a little longer
   ELSE
    IF TIMER - t > 2 AND place <> -1 THEN ' col selected
     r = GetOpenRow(place)
     IF r <> NumRows THEN
      y = SQ + SQ / 2
      target = r * SQ + YO + SQ / 2
      delaid = 6
      WHILE y < target
       y = y + 1
       CLS
       ShowGrid
       pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 3
       sx = RND * 6 - 3
       _PUTIMAGE , Overlay&, _DISPLAY
       _DISPLAY
       _LIMIT delaid
       delaid = delaid * 2
      WEND
      Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
      place = -1 ' reset back to hold area
     ELSE
      BEEP
     END IF
    END IF
   END IF
  END IF
 ELSE
  AIMove
  Turn = P: MoveNum = MoveNum + 1: t = TIMER
 END IF
 ShowGrid
 IF Turn = P THEN
  IF place = -1 THEN
   s$ = "Holding area, press spacebar until over column to play."
  ELSE
   s$ = "Press Spacebar, if don't want to play" + STR$(place) + " column."
  END IF
  COLOR &HFFFFFFFF, 0
  _PRINTSTRING (XO, YO - SQ - 16), s$
 END IF
 pumpkin 0, place * SQ + XO + SQ / 2, SQ + SQ / 2, pr, 3
 sx = RND * 6 - 3
 _PUTIMAGE , Overlay&, _DISPLAY
 _DISPLAY
 _LIMIT 15
WEND
 
SUB AIMove
 ' What this sub does in English:
 ' This sub assigns the value to playing each column, then plays the best value with following caveats:
 ' + If it finds a winning move, it will play that immediately.
 ' + If it finds a spoiler move, it will play that if no winning move was found.
 ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
 '   but it might be the only legal move left.  We will have to play it if no better score was found.
 
 DIM c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
 DIM openRow(NCM1) ' find open rows once
 REDIM Scores(NCM1) ' evaluate each column's potential
 AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
 FOR c = 0 TO NCM1
  openRow(c) = GetOpenRow(c)
  r = openRow(c)
  IF r <> NumRows THEN
   FOR d = 0 TO 3 ' 4 directions to build connect 4's that use cell c, r
    startC = c + -3 * DX(d): startR = r + -3 * DY(d)
    FOR i = 0 TO 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
     cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
     'from this start position run 4 steps forward to count all connects involving cell c, r
     FOR iStep = 0 TO 3 ' process a potential connect 4
      test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
      IF test = NumRows THEN goodF = 0: EXIT FOR 'cant get connect4 from here
      IF test = AI THEN cntA = cntA + 1
      IF test = P THEN cntP = cntP + 1
     NEXT iStep
     IF goodF THEN 'evaluate the Legal Connect4 we could build with c, r
      IF cntA = 3 THEN ' we are done!  winner!
       AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
       Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
       Scores(c) = 1000
       EXIT SUB
      ELSEIF cntP = 3 THEN 'next best move spoiler!
       AIX = c: AIY = r 'set the move but don't exit there might be a winner
       Scores(c) = 900
      ELSEIF cntA = 0 AND cntP = 2 THEN
       Scores(c) = Scores(c) + 8
      ELSEIF cntA = 2 AND cntP = 0 THEN ' very good offense or defense
       Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
      ELSEIF cntA = 0 AND cntP = 1 THEN
       Scores(c) = Scores(c) + 4
      ELSEIF (cntA = 1 AND cntP = 0) THEN 'good offense or defense
       Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
      ELSEIF (cntA = 0 AND cntP = 0) THEN ' OK it's not a wasted move as it has potential for connect4
       Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
      END IF
     END IF ' in the board
    NEXT i
   NEXT d
   IF Stupid(c, r) THEN Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
  END IF
 NEXT
 IF AIX <> -1 THEN ' we found a spoiler so move there since we haven't found a winner
  Grid(AIX, AIY) = AI ' make move on grid and done!
  EXIT SUB
 ELSE
  IF GetOpenRow(PlayerLastMoveCol) < NumRows THEN 'all things being equal play on top of player's last move
   bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
  ELSE
   bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
  END IF
  FOR c = 0 TO NCM1
   r = openRow(c)
   IF r <> NumRows THEN
    IF Scores(c) > bestScore THEN bestScore = Scores(c): AIY = r: AIX = c
   END IF
  NEXT
  IF AIX <> -1 THEN
   Grid(AIX, AIY) = AI ' make first best score move we found
  ELSE 'We have trouble!  Oh but it could be there are no moves!!!
   ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
   ' Just in case it didn't here is an error stop!
   BEEP: LOCATE 4, 2: PRINT "AI has failed to find a proper move, press any to end..."
   SLEEP ' <<< pause until user presses a key
   END
  END IF
 END IF
END SUB
 
FUNCTION GetOpenRow (forCol)
 DIM i
 GetOpenRow = NumRows 'assume none open
 IF forCol < 0 OR forCol > NCM1 THEN EXIT FUNCTION
 FOR i = NRM1 TO 0 STEP -1
  IF Grid(forCol, i) = 0 THEN GetOpenRow = i: EXIT FUNCTION
 NEXT
END FUNCTION
 
FUNCTION Stupid (c, r)
 DIM pr
 Grid(c, r) = AI
 pr = GetOpenRow(c)
 IF pr <> NumRows THEN
  Grid(c, pr) = P
  IF CheckWin = 4 THEN Stupid = -1
  Grid(c, pr) = 0
 END IF
 Grid(c, r) = 0
END FUNCTION
 
FUNCTION GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
 ' need to check the grid(c, r) but only if c, r is on the board
 IF c < 0 OR c > NCM1 OR r < 0 OR r > NRM1 THEN GR = NumRows ELSE GR = Grid(c, r)
END FUNCTION
 
SUB ShowGrid
 STATIC lastMoveNum
 DIM i, r, c, check, s$, k$
 IF MoveNum <> lastMoveNum THEN ' file newest move
  IF MoveNum = 1 THEN REDIM Record$(NCM1, NRM1)
  IF Turn = -1 THEN
   Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _TRIM$(STR$(MoveNum)) + " " + "P"
  ELSE
   Record$(AIX, AIY) = _TRIM$(STR$(MoveNum)) + " " + "A"
  END IF
  lastMoveNum = MoveNum
 END IF
 'cls
 LINE (XO, YO)-STEP(NumCols * SQ, NumRows * SQ), &HFF004400, BF
 FOR i = 0 TO NumCols 'grid
  LINE (SQ * i + XO, YO)-STEP(0, NumRows * SQ), &HFFFFFFFF
 NEXT
 FOR i = 0 TO NumRows
  LINE (XO, SQ * i + YO)-STEP(NumCols * SQ, 0), &HFFFFFFFF
 NEXT
 FOR r = NRM1 TO 0 STEP -1 ''in grid rows are reversed 0 is top row
  FOR c = 0 TO NCM1
   IF Grid(c, r) = P THEN
    LINE (c * SQ + XO + 3, r * SQ + YO + 3)-STEP(SQ - 6, SQ - 6), &HFF000000, BF
    pumpkin 0, c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, (SQ - 6) / 2, 2
 
   ELSEIF Grid(c, r) = AI THEN
    IF c = AIX AND r = AIY THEN 'highlite last AI move
     LINE (c * SQ + XO + 3, r * SQ + YO + 3)-STEP(SQ - 6, SQ - 6), &HFF8888FF, BF
    ELSE
     LINE (c * SQ + XO + 3, r * SQ + YO + 3)-STEP(SQ - 6, SQ - 6), &HFF4444FF, BF
    END IF
    drawSpinner c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, .5, _PI(-c / 8), _RGB32(RND * 30 + 40, RND * 15 + 20, RND * 6 + 10)
   END IF
   s$ = _TRIM$(STR$(Scores(c)))
   _PRINTSTRING (XO + c * SQ + (60 - LEN(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
  NEXT
 NEXT
 '_Display
 check = CheckWin
 IF check THEN 'report end of round ad see if want to play again
  IF check = 4 OR check = -4 THEN
   FOR i = 0 TO 3
    LINE ((WinX + i * DX(WinD)) * SQ + XO + 5, (WinY + i * DY(WinD)) * SQ + YO + 5)-STEP(SQ - 10, SQ - 10), &HFFFFFF00, B
   NEXT
  END IF
  FOR r = 0 TO NRM1
   FOR c = 0 TO NCM1
    IF Record$(c, r) <> "" THEN
     s$ = MID$(Record$(c, r), 1, INSTR(Record$(c, r), " ") - 1)
     IF RIGHT$(Record$(c, r), 1) = "A" THEN COLOR &HFFFFFFFF, &HFF000000 ELSE COLOR &HFFFFFFFF, &HFF000000
     _PRINTSTRING (SQ * c + XO + (SQ - LEN(s$) * 8) / 2, SQ * r + YO + 22), s$
    END IF
   NEXT
   COLOR , &HFF000000
  NEXT
  IF check = -4 THEN
   s$ = " AI is Winner!"
  ELSEIF check = 4 THEN
   s$ = " Human is Winner!"
  ELSEIF check = NumRows THEN
   s$ = " Board is full, no winner." ' keep Turn the same
  END IF
  LOCATE 2, ((SW - LEN(s$) * 8) / 2) / 8: PRINT s$
  s$ = " Play again? press spacebar, escape to quit... "
  LOCATE 4, ((SW - LEN(s$) * 8) / 2) / 8: PRINT s$
  _PUTIMAGE , Overlay&, _DISPLAY
  _DISPLAY
  keywait:
  WHILE LEN(k$) = 0
   k$ = INKEY$
   _LIMIT 200
  WEND
  IF k$ = " " THEN
   REDIM Grid(NCM1, NRM1), Scores(NCM1)
   IF GoFirst = P THEN GoFirst = AI ELSE GoFirst = P
   Turn = GoFirst: MoveNum = 0
  ELSEIF ASC(k$) = 27 THEN
   SYSTEM
  ELSE
   k$ = "": GOTO keywait:
  END IF
 END IF
END SUB
 
FUNCTION CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
 DIM gridFull, r, c, s, i
 gridFull = NumRows
 FOR r = NRM1 TO 0 STEP -1 'bottom to top
  FOR c = 0 TO NCM1
   IF Grid(c, r) THEN ' check if c starts a row
    IF c < NCM1 - 2 THEN
     s = 0
     FOR i = 0 TO 3 ' east
      s = s + Grid(c + i, r)
     NEXT
     IF s = 4 OR s = -4 THEN WinX = c: WinY = r: WinD = 0: CheckWin = s: EXIT FUNCTION
    END IF
    IF r > 2 THEN ' check if c starts a col
     s = 0
     FOR i = 0 TO 3 ' north
      s = s + Grid(c, r - i)
     NEXT
     IF s = 4 OR s = -4 THEN WinX = c: WinY = r: WinD = 6: CheckWin = s: EXIT FUNCTION
    END IF
    IF r > 2 AND c < NCM1 - 2 THEN 'check if c starts diagonal up to right
     s = 0
     FOR i = 0 TO 3 ' north  east
      s = s + Grid(c + i, r - i)
     NEXT
     IF s = 4 OR s = -4 THEN WinX = c: WinY = r: WinD = 7: CheckWin = s: EXIT FUNCTION
    END IF
    IF r > 2 AND c > 2 THEN 'check if c starts a diagonal up to left
     s = 0
     FOR i = 0 TO 3 ' north west
      s = s + Grid(c - i, r - i)
     NEXT
     IF s = 4 OR s = -4 THEN WinX = c: WinY = r: WinD = 5: CheckWin = s: EXIT FUNCTION
    END IF
   ELSE
    gridFull = 0 ' at least one enpty cell left
   END IF 'grid is something
  NEXT
 NEXT
 CheckWin = gridFull
END FUNCTION
 
 
SUB pumpkin (dh&, cx, cy, pr, limit)
 DIM lastr, u, dx, i, tx1, tx2, tx3, ty1, ty2, ty3, ty22, sxs
 'carve this!
 COLOR &HFFFF0000
 fEllipse cx, cy, pr, 29 / 35 * pr
 COLOR &HFF000000
 lastr = 2 / 7 * pr
 DO
  ellipse cx, cy, lastr, 29 / 35 * pr
  lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
  IF pr - lastr < 1 / 80 * pr THEN EXIT DO
 LOOP
 
 ' 'flickering candle light
 'Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
 ' eye sockets
 ftri2 dh&, cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 ftri2 dh&, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 ftri2 dh&, cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 ftri2 dh&, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 
 ' nose
 ftri2 dh&, cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 
 ' evil grin
 ftri2 dh&, cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 ftri2 dh&, cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 
 ' moving teeth/talk/grrrr..
 u = rand%(4, 8)
 dx = pr / u
 FOR i = 1 TO u
  tx1 = cx - 6 * pr / 12 + (i - 1) * dx
  tx2 = tx1 + .5 * dx
  tx3 = tx1 + dx
  ty1 = cy + 5 * pr / 12
  ty3 = cy + 5 * pr / 12
  ty2 = cy + (4 - RND) * pr / 12
  ty22 = cy + (6 + RND) * pr / 12
  ftri2 dh&, tx1, ty1, tx2, ty2, tx3, ty3, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
  ftri2 dh&, tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, _RGB(RND * 55 + 200, RND * 55 + 200, 120)
 NEXT
 IF limit THEN
  'shifty eyes
  IF limit = 3 THEN sxs = sx ELSE sxs = .1 * limit * sx
  pumpkin dh&, sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)
  pumpkin dh&, sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)
 END IF
END SUB
 
SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
 DIM scale AS SINGLE, x AS LONG, y AS LONG
 scale = yRadius / xRadius
 LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
 FOR x = 1 TO xRadius
  y = scale * SQR(xRadius * xRadius - x * x)
  LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
  LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
 NEXT
END SUB
 
SUB ellipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
 DIM scale AS SINGLE, xs AS LONG, x AS LONG, y AS LONG
 DIM lastx AS LONG, lasty AS LONG
 scale = yRadius / xRadius: xs = xRadius * xRadius
 PSET (CX, CY - yRadius): PSET (CX, CY + yRadius)
 lastx = 0: lasty = yRadius
 FOR x = 1 TO xRadius
  y = scale * SQR(xs - x * x)
  LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
  LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
  LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
  LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
  lastx = x: lasty = y
 NEXT
END SUB
 
SUB ftri2 (returnDest&, x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
 DIM a&
 a& = _NEWIMAGE(1, 1, 32)
 _DEST a&
 PSET (0, 0), K
 _DEST returnDest&
 _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
 _FREEIMAGE a& '<<< this is important!
END SUB
 
FUNCTION rand% (lo%, hi%)
 rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
 
 
 
SUB drawLink (x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
 DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
 a = _ATAN2(y2 - y1, x2 - x1)
 a1 = a + _PI(1 / 2)
 a2 = a - _PI(1 / 2)
 x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
 x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
 x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
 x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
 fquad x3, y3, x4, y4, x5, y5, x6, y6, c
 Fcirc x1, y1, r1, c
 Fcirc x2, y2, r2, c
END SUB
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
SUB fquad (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)
 ftri x1, y1, x2, y2, x4, y4, c
 ftri x3, y3, x4, y4, x1, y1, c
END SUB
 
SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
 DIM a&
 a& = _NEWIMAGE(1, 1, 32)
 _DEST a&
 PSET (0, 0), K
 _DEST 0
 _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
 _FREEIMAGE a& '<<< this is important!
END SUB
 
SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
 DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
 DIM prc AS _UNSIGNED LONG, tef AS LONG
 prc = _RGB32(255, 255, 255, 255)
 IF a > b THEN max = a + 1 ELSE max = b + 1
 mx2 = max + max
 tef = _NEWIMAGE(mx2, mx2)
 _DEST tef
 _SOURCE tef 'point wont read without this!
 FOR k = 0 TO 6.2832 + .05 STEP .1
  i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
  j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
  IF k <> 0 THEN
   LINE (lasti, lastj)-(i, j), prc
  ELSE
   PSET (i, j), prc
  END IF
  lasti = i: lastj = j
 NEXT
 DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
 FOR y = 0 TO mx2
  x = 0
  WHILE POINT(x, y) <> prc AND x < mx2
   x = x + 1
  WEND
  xleft(y) = x
  WHILE POINT(x, y) = prc AND x < mx2
   x = x + 1
  WEND
  WHILE POINT(x, y) <> prc AND x < mx2
   x = x + 1
  WEND
  IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
 NEXT
 _DEST destHandle&
 FOR y = 0 TO mx2
  IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
 NEXT
 _FREEIMAGE tef
END SUB
 
SUB Fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
 DIM Radius AS LONG, RadiusError AS LONG
 DIM X AS LONG, Y AS LONG
 Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
 IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
 LINE (CX - X, CY)-(CX + X, CY), C, BF
 WHILE X > Y
  RadiusError = RadiusError + Y * 2 + 1
  IF RadiusError >= 0 THEN
   IF X <> Y + 1 THEN
    LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
    LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
   END IF
   X = X - 1
   RadiusError = RadiusError - X * 2
  END IF
  Y = Y + 1
  LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
 WEND
END SUB
 
SUB drawSpinner (x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
 DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
 DIM rred, bblue, ggreen
 STATIC switch AS INTEGER
 switch = switch + 2
 switch = switch MOD 16 + 1
 rred = _RED32(c): ggreen = _GREEN32(c): bblue = _BLUE32(c)
 r = 10 * scale
 x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
 r = 2 * r 'lg lengths
 FOR lg = 1 TO 8
  IF lg < 5 THEN
   a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
  ELSE
   a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
  END IF
  x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
  drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
  IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
  a1 = a + d * _PI(1 / 12)
  x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
  drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
  rd = INT(RND * 8) + 1
  a2 = a1 + d * _PI(1 / 8) * rd / 8
  x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
  drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
 NEXT
 r = r * .5
 Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
 x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
 Fcirc x2, y2, r * .2, &HFF000000
 x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
 Fcirc x2, y2, r * .2, &HFF000000
 r = r * 2
 x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
 TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _PI, _RGB32(rred, ggreen, bblue)
END SUB
 
SUB Create_Board
 _DEST Overlay&
 LINE (60, 120)-STEP(480, 480), _RGB32(180, 180, 16), BF
 FOR y% = 0 TO 7
  FOR x% = 0 TO 7
   Fcirc 90 + 60 * x%, 150 + 60 * y%, 25, _RGB32(0)
 NEXT x%, y%
 _CLEARCOLOR _RGB32(0), Overlay&
 _DEST _DISPLAY
END SUB
 

Pete · « **Reply #12 on:** October 22, 2021, 11:41:26 am »

@Cobalt Big fan of overlays! Color scheme of yellow on green? Um, not a big fan. Version also needs the pumpkin fall acceleration. It definitely reminded me of the old game apparatus, which was indeed, yellow. Overall, a really nice addition with the Connect 4 board look.

@bplus You might want to consider a space bar toggle for AI or two-player version. Wow, I was just thinking that it's been 20 years since I did networking routines for home networks. I mean it certainly could be used by two people on one computer, but over home network would be cool.

Pete

bplus · « **Reply #13 on:** October 22, 2021, 12:59:07 pm »

OK with overlay, but I changed color scheme so that background shows through empty holes, tiny adjustments in sizes of things and colors so the winning 4 is displayed.

Code: QB64: [Select]

Option _Explicit ' One Key Connect 4 (8x8) Halloween Style - bplus 2021-10-19
Const SQ = 60 '       square or grid cell
Const NumCols = 8 '   number of columns
Const NumRows = 8 '   you guessed it
Const NCM1 = NumCols - 1 ' NumCols minus 1
Const NRM1 = NumRows - 1 ' you can guess surely
Const SW = SQ * (NumCols + 2) '  screen width
Const SH = SQ * (NumRows + 3) '  screen height
Const P = 1 '       Player is 1 on grid
Const AI = -1 '     AI is -1 on grid
Const XO = SQ '     x offset for grid
Const YO = 2 * SQ ' y offset for grid
 
ReDim Shared Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
ReDim Shared DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
ReDim Shared AIX, AIY ' last move of AI for highlighting in display
ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
ReDim Shared Record$(NCM1, NRM1)
Dim Shared sx, pr ' for pumpkin recursion shifty eyes and pumkin radius
Dim place, k$, t, r, s$, d, temp&, target, y, delaid
Dim Shared Overlay& 'the board overlay
 
Screen _NewImage(SW, SH, 32)
_ScreenMove 360, 60
Overlay& = _NewImage(SW, SH, 32)
Create_Board
 
_Title "One Key Connect 4 (8x8) Halloween Style"
d = 1
While _KeyDown(32) = 0
    Cls
    pumpkin 0, _Width / 2, _Height / 2, _Height / 2.3, 3
    sx = sx + d
    If sx > 10 Then d = -d: sx = 10
    If sx < -10 Then d = -d: sx = -10
    Color &HFFFFFFFF
    Locate 40, 33: Print "Spacebar Only"
    _Display
    _Limit 20
Wend
_KeyClear
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
place = -1
t = Timer
pr = (SQ - 2) / 2
While GameOn
    Cls
    If Turn = P Then
        k$ = InKey$
        If k$ = Chr$(27) Then System ' emergency exit
        If k$ = " " Then
            t = Timer: place = place + 1
            If place >= NumCols Then place = -1
        Else ' watch out for midnight!
            If Timer - t < 0 Then 'midnight problem
                t = Timer ' wait a little longer
            Else
                If Timer - t > 2 And place <> -1 Then ' col selected
                    r = GetOpenRow(place)
                    If r <> NumRows Then
                        y = SQ + SQ / 2
                        target = r * SQ + YO + SQ / 2
                        delaid = 6
                        While y < target
                            y = y + 1
                            Cls
                            ShowGrid
                            pumpkin 0, place * SQ + XO + SQ / 2, y, pr, 2
                            sx = Rnd * 6 - 3
                            _PutImage , Overlay&, _Display
                            _Display
                            _Limit delaid
                            delaid = delaid * 2
                        Wend
                        Grid(place, r) = P: Turn = AI: PlayerLastMoveCol = place: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
                        place = -1 ' reset back to hold area
                    Else
                        Beep
                    End If
                End If
            End If
        End If
    Else
        AIMove
        Turn = P: MoveNum = MoveNum + 1: t = Timer
    End If
    ShowGrid
    If Turn = P Then
        If place = -1 Then
            s$ = "Holding area, press spacebar until over column to play."
        Else
            s$ = "Press Spacebar, if don't want to play" + Str$(place) + " column."
        End If
        Color &HFFFFFFFF
        _PrintString (XO, YO - SQ - 16), s$
    End If
    pumpkin 0, place * SQ + XO + SQ / 2, SQ + SQ / 2, pr, 2
    sx = Rnd * 6 - 3
    _PutImage , Overlay&, _Display
    _Display
    _Limit 15
Wend
 
Sub AIMove
    ' What this sub does in English:
    ' This sub assigns the value to playing each column, then plays the best value with following caveats:
    ' + If it finds a winning move, it will play that immediately.
    ' + If it finds a spoiler move, it will play that if no winning move was found.
    ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
    '   but it might be the only legal move left.  We will have to play it if no better score was found.
 
    Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
    Dim openRow(NCM1) ' find open rows once
    ReDim Scores(NCM1) ' evaluate each column's potential
    AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
    For c = 0 To NCM1
        openRow(c) = GetOpenRow(c)
        r = openRow(c)
        If r <> NumRows Then
            For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
                startC = c + -3 * DX(d): startR = r + -3 * DY(d)
                For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
                    cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
                    'from this start position run 4 steps forward to count all connects involving cell c, r
                    For iStep = 0 To 3 ' process a potential connect 4
                        test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
                        If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
                        If test = AI Then cntA = cntA + 1
                        If test = P Then cntP = cntP + 1
                    Next iStep
                    If goodF Then 'evaluate the Legal Connect4 we could build with c, r
                        If cntA = 3 Then ' we are done!  winner!
                            AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
                            Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
                            Scores(c) = 1000
                            Exit Sub
                        ElseIf cntP = 3 Then 'next best move spoiler!
                            AIX = c: AIY = r 'set the move but don't exit there might be a winner
                            Scores(c) = 900
                        ElseIf cntA = 0 And cntP = 2 Then
                            Scores(c) = Scores(c) + 8
                        ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
                            Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
                        ElseIf cntA = 0 And cntP = 1 Then
                            Scores(c) = Scores(c) + 4
                        ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
                            Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
                        ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
                            Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
                        End If
                    End If ' in the board
                Next i
            Next d
            If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
        End If
    Next
    If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
        Grid(AIX, AIY) = AI ' make move on grid and done!
        Exit Sub
    Else
        If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
            bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
        Else
            bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
        End If
        For c = 0 To NCM1
            r = openRow(c)
            If r <> NumRows Then
                If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
            End If
        Next
        If AIX <> -1 Then
            Grid(AIX, AIY) = AI ' make first best score move we found
        Else 'We have trouble!  Oh but it could be there are no moves!!!
            ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
            ' Just in case it didn't here is an error stop!
            Color &HFFFFFFFF
            Beep: Locate 4, 2: Print "AI has failed to find a proper move, press any to end..."
            Sleep ' <<< pause until user presses a key
            End
        End If
    End If
End Sub
 
Function GetOpenRow (forCol)
    Dim i
    GetOpenRow = NumRows 'assume none open
    If forCol < 0 Or forCol > NCM1 Then Exit Function
    For i = NRM1 To 0 Step -1
        If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
    Next
End Function
 
Function Stupid (c, r)
    Dim ppr
    Grid(c, r) = AI
    ppr = GetOpenRow(c)
    If ppr <> NumRows Then
        Grid(c, ppr) = P
        If CheckWin = 4 Then Stupid = -1
        Grid(c, ppr) = 0
    End If
    Grid(c, r) = 0
End Function
 
Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
    ' need to check the grid(c, r) but only if c, r is on the board
    If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
End Function
 
Sub ShowGrid
    Static lastMoveNum
    Dim i, r, c, check, s$, k$
    If MoveNum <> lastMoveNum Then ' file newest move
        If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
        If Turn = -1 Then
            Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
        Else
            Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
        End If
        lastMoveNum = MoveNum
    End If
    Color _RGB32(255, 255, 255), _RGB32(64, 64, 255): Cls
    'Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
    For i = 0 To NumCols 'grid
        Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
    Next
    For i = 0 To NumRows
        Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
    Next
    Color
    For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
        For c = 0 To NCM1
            If Grid(c, r) = P Then
                'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF000000, BF
                pumpkin 0, c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, pr, 2
 
            ElseIf Grid(c, r) = AI Then
                If c = AIX And r = AIY Then 'highlite last AI move
                    'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF8888FF, BF  ' no overlay
                    Line (c * SQ + XO, r * SQ + YO)-Step(SQ, SQ), &HFF8888FF, BF
                    'Else
                    'Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF4444FF, BF  ' no overlay
                    'Line (c * SQ + XO, r * SQ + YO)-Step(SQ, SQ), &HFF4444FF, BF
                End If
                drawSpinner c * SQ + XO + SQ / 2, r * SQ + YO + SQ / 2, .4, _Pi(-c / 8), _RGB32(Rnd * 30 + 40, Rnd * 15 + 20, Rnd * 6 + 10)
            End If
            s$ = _Trim$(Str$(Scores(c)))
            Color &HFFFFFFFF
            _PrintString (XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
        Next
    Next
    '_Display
    check = CheckWin
    If check Then 'report end of round ad see if want to play again
        If check = 4 Or check = -4 Then
            For i = 0 To 3
                Line ((WinX + i * DX(WinD)) * SQ + XO + 10, (WinY + i * DY(WinD)) * SQ + YO + 10)-Step(SQ - 20, SQ - 20), &HFFFFFF00, B
            Next
        End If
        Color &HFFFFFFFF
        For r = 0 To NRM1
            For c = 0 To NCM1
                If Record$(c, r) <> "" Then
                    s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
                    _PrintString (SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22), s$
                End If
            Next
        Next
        If check = -4 Then
            s$ = " AI is Winner!"
        ElseIf check = 4 Then
            s$ = " Human is Winner!"
        ElseIf check = NumRows Then
            s$ = " Board is full, no winner." ' keep Turn the same
        End If
        Locate 2, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        s$ = " Play again? press spacebar, escape to quit... "
        Locate 4, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        _PutImage , Overlay&, _Display
        _Display
        keywait:
        While Len(k$) = 0
            k$ = InKey$
            _Limit 200
        Wend
        If k$ = " " Then
            ReDim Grid(NCM1, NRM1), Scores(NCM1)
            If GoFirst = P Then GoFirst = AI Else GoFirst = P
            Turn = GoFirst: MoveNum = 0
        ElseIf Asc(k$) = 27 Then
            System
        Else
            k$ = "": GoTo keywait:
        End If
    End If
End Sub
 
Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
    Dim gridFull, r, c, s, i
    gridFull = NumRows
    For r = NRM1 To 0 Step -1 'bottom to top
        For c = 0 To NCM1
            If Grid(c, r) Then ' check if c starts a row
                If c < NCM1 - 2 Then
                    s = 0
                    For i = 0 To 3 ' east
                        s = s + Grid(c + i, r)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
                End If
                If r > 2 Then ' check if c starts a col
                    s = 0
                    For i = 0 To 3 ' north
                        s = s + Grid(c, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
                End If
                If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
                    s = 0
                    For i = 0 To 3 ' north  east
                        s = s + Grid(c + i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
                End If
                If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
                    s = 0
                    For i = 0 To 3 ' north west
                        s = s + Grid(c - i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
                End If
            Else
                gridFull = 0 ' at least one enpty cell left
            End If 'grid is something
        Next
    Next
    CheckWin = gridFull
End Function
 
 
Sub pumpkin (dh&, cx, cy, pr, limit)
    Dim lastr, u, dx, i, tx1, tx2, tx3, ty1, ty2, ty3, ty22, sxs
    'carve this!
    Color &HFFFF0000
    fEllipse cx, cy, pr, 29 / 35 * pr
    Color &HFF000000
    lastr = 2 / 7 * pr
    Do
        ellipse cx, cy, lastr, 29 / 35 * pr
        lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
        If pr - lastr < 1 / 80 * pr Then Exit Do
    Loop
 
    ' 'flickering candle light
    'Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' eye sockets
    ftri2 dh&, cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' nose
    ftri2 dh&, cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' evil grin
    ftri2 dh&, cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    ftri2 dh&, cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
 
    ' moving teeth/talk/grrrr..
    u = rand%(4, 8)
    dx = pr / u
    For i = 1 To u
        tx1 = cx - 6 * pr / 12 + (i - 1) * dx
        tx2 = tx1 + .5 * dx
        tx3 = tx1 + dx
        ty1 = cy + 5 * pr / 12
        ty3 = cy + 5 * pr / 12
        ty2 = cy + (4 - Rnd) * pr / 12
        ty22 = cy + (6 + Rnd) * pr / 12
        ftri2 dh&, tx1, ty1, tx2, ty2, tx3, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
        ftri2 dh&, tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
    Next
    If limit Then
        'shifty eyes
        If limit = 3 Then sxs = sx Else sxs = .1 * limit * sx
        pumpkin dh&, sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
        pumpkin dh&, sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    End If
End Sub
 
Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, x As Long, y As Long
    scale = yRadius / xRadius
    Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
        Line (CX + x, CY - y)-(CX + x, CY + y), , BF
        Line (CX - x, CY - y)-(CX - x, CY + y), , BF
    Next
End Sub
 
Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
    Dim scale As Single, xs As Long, x As Long, y As Long
    Dim lastx As Long, lasty As Long
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
    lastx = 0: lasty = yRadius
    For x = 1 To xRadius
        y = scale * Sqr(xs - x * x)
        Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
        lastx = x: lasty = y
    Next
End Sub
 
Sub ftri2 (returnDest&, x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest returnDest&
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
 
 
 
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
    Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _Atan2(y2 - y1, x2 - x1)
    a1 = a + _Pi(1 / 2)
    a2 = a - _Pi(1 / 2)
    x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
    x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
    x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
    x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
    fquad x3, y3, x4, y4, x5, y5, x6, y6, c
    Fcirc x1, y1, r1, c
    Fcirc x2, y2, r2, c
End Sub
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
    ftri x1, y1, x2, y2, x4, y4, c
    ftri x3, y3, x4, y4, x1, y1, c
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest 0
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
    Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
    Dim prc As _Unsigned Long, tef As Long
    prc = _RGB32(255, 255, 255, 255)
    If a > b Then max = a + 1 Else max = b + 1
    mx2 = max + max
    tef = _NewImage(mx2, mx2)
    _Dest tef
    _Source tef 'point wont read without this!
    For k = 0 To 6.2832 + .05 Step .1
        i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
        j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
        If k <> 0 Then
            Line (lasti, lastj)-(i, j), prc
        Else
            PSet (i, j), prc
        End If
        lasti = i: lastj = j
    Next
    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
    For y = 0 To mx2
        x = 0
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc And x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
    Next
    _Dest destHandle&
    For y = 0 To mx2
        If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
    Next
    _FreeImage tef
End Sub
 
Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub
 
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
    Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
    Dim rred, bblue, ggreen
    Static switch As Integer
    switch = switch + 2
    switch = switch Mod 16 + 1
    rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
    r = 10 * scale
    x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
    r = 2 * r 'lg lengths
    For lg = 1 To 8
        If lg < 5 Then
            a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
        Else
            a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
        End If
        x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
        drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
        If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
        a1 = a + d * _Pi(1 / 12)
        x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
        drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
        rd = Int(Rnd * 8) + 1
        a2 = a1 + d * _Pi(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
        drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
    Next
    r = r * .5
    Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
    x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
    TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
End Sub
 
Sub Create_Board
    Dim As Integer x, y
    _Dest Overlay&
    Line (60, 120)-Step(480, 480), _RGB32(80, 40, 20), BF
    For y = 0 To 7
        For x = 0 To 7
            Fcirc 90 + 60 * x, 150 + 60 * y, 28, _RGB32(0)
    Next x, y
    _ClearColor _RGB32(0), Overlay&
    _Dest _Display
End Sub
 
 
 

Zip contains Windows exe for Syntax Bomb friends and Source code for compiling in other OS.
Making this #2 for Overlay mod, thanks!

bplus · « **Reply #14 on:** October 22, 2021, 01:11:00 pm »

Quote

@bplus You might want to consider a space bar toggle for AI or two-player version. Wow, I was just thinking that it's been 20 years since I did networking routines for home networks. I mean it certainly could be used by two people on one computer, but over home network would be cool.

Over Internet might be cool, at home, I just have AI to play.

PS I have real Wheel of Fortune Game I made last year but did not work too well with family members, no AI for that one!

News:

Author Topic: One Key Connect 4 (8x8) Halloween Style (Read 9702 times)

bplus

One Key Connect 4 (8x8) Halloween Style

Cobalt

Re: One Key Connect 4 (8x8) Halloween Style

jack

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

Pete

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

Pete

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

Pete

Re: One Key Connect 4 (8x8) Halloween Style

Cobalt

Re: One Key Connect 4 (8x8) Halloween Style

Pete

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style

bplus

Re: One Key Connect 4 (8x8) Halloween Style