_TITLE "Eigenstate Board Game by Donald L. Foster Jr."

SCREEN _NEWIMAGE(1035, 735, 256)

_PALETTECOLOR 1, _RGB32(80, 80, 80) ' Board Border Color
_PALETTECOLOR 2, _RGB32(167, 167, 167) ' Dark Board Square
_PALETTECOLOR 3, _RGB32(225, 225, 225) ' Lioght Board Square
_PALETTECOLOR 4, _RGB32(135, 135, 135) ' Player 2 Piece
_PALETTECOLOR 5, _RGB32(200, 6, 6) ' Red Peg
_PALETTECOLOR 6, _RGB32(200, 200, 200) ' Light Peg Hole

DIM MoveRow(24), MoveCol(24)

Player = 1: Opponent = 2: Pieces(1) = 6: Pieces(2) = 6

PegColor(1) = 15: PegColor(2) = 0: EmptyHole(1) = 4: EmptyHole(2) = 6

Cursor$ = "BU53L53D106R106U106L53U1L54D108R108U108L54U1L55D110R110U110L55"

Piece1$ = "000000000000000010000000": Piece2$ = "000000010000000000000000"

FOR Z = 1 TO 6: BoardPlayer(1, Z) = 2: BoardPiece$(1, Z) = Piece1$: BoardPlayer(6, Z) = 1: BoardPiece$(6, Z) = Piece2$: NEXT

DATA -2,-2,-2,-1,-2,0,-2,1,-2,2,-1,-2,-1,-1,-1,0,-1,1,-1,2,0,-2,0,-1,0,1,0,2,1,-2,1,-1,1,0,1,1,1,2,2,-2,2,-1,2,0,2,1,2,2
FOR Z = 1 TO 24: READ MoveRow(Z), MoveCol(Z): NEXT

CLS , 15
' Draw Board
LINE (10, 10)-(725, 725), 1, BF
X = 80: PieceSize = 1
FOR Z = 1 TO 6
    V = 80
    FOR Y = 1 TO 6
        IF FIX((Z + Y) / 2) = (Z + Y) / 2 THEN W1 = 2 ELSE W1 = 3
        LINE (V - 57, X - 57)-(V + 57, X + 57), W1, BF
        Piece$ = BoardPiece$(Z, Y): BoardX(Z, Y) = V: BoardY(Z, Y) = X
        IF BoardPlayer(Z, Y) > 0 THEN X1 = V: X2 = X: X3 = BoardPlayer(Z, Y): PiecesSize = 1: GOSUB DrawPiece
        V = V + 115
    NEXT
    X = X + 115
NEXT

rootpath$ = ENVIRON$("SYSTEMROOT")
fontfile$ = rootpath$ + "\Fonts\arial.ttf"
style$ = "monospace"
f& = _LOADFONT(fontfile$, 25, style$)

_FONT f&: COLOR 0, 15: _PRINTSTRING (750, 7), "EIGENSTATE"

StartGame:
FirstPeg = 1

' Draw Player Indicator
X1 = 880: X2 = 110: X3 = Player: PieceSize = 1: Piece$ = "000000000000000000000000": GOSUB DrawPiece
stye$ = "monospace": fontfile$ = rootpath$ + "\fonts\consolab.ttf": f& = _LOADFONT(fontfile$, 17, style$)

IF Player = 1 THEN
    _FONT f&: COLOR 0, 15: _PRINTSTRING (845, 170), "Player 1"
ELSE
    _FONT f&: COLOR 0, 15: _PRINTSTRING (845, 170), "Player 2"
END IF

' Check Board if can Move
X = 0
FOR Z = 1 TO 6
    FOR Y = 1 TO 6
        IF BoardPlayer(Z, Y) = Player THEN
            Piece$ = BoardPiece$(Z, Y)
            FOR W = 1 TO 24
                IF MID$(Piece$, W, 1) = "1" THEN
                    IF Z + MoveRow(W) >= 1 AND Z + MoveRow(W) <= 6 AND Y + MoveCol(W) >= 1 AND Y + MoveCol(W) <= 8 THEN X = 1
                END IF
            NEXT
        END IF
    NEXT
NEXT

IF X = 0 THEN
    _PRINTSTRING (760, 667), "  No Moves are Available   "
    _PRINTSTRING (765, 707), "Press <ENTER> to Continue"
    GetENTER: A$ = UCASE$(INKEY$): IF A$ = "" GOTO GetENTER
    IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
    IF ASC(A$) <> 13 GOTO GetENTER
    _PRINTSTRING (765, 707), "                         "
    GOTO PlacePeg
END IF

ChooseAPiece:
_PRINTSTRING (760, 667), "  Choose a Piece to Move   "

PieceInput:
DO WHILE _MOUSEINPUT
    FOR Z = 1 TO 6
        FOR Y = 1 TO 6
            Playable(Z, Y) = 0
            IF BoardPlayer(Z, Y) = Player THEN
                IF _MOUSEX > BoardX(Z, Y) - 51 AND _MOUSEX < BoardX(Z, Y) + 51 AND _MOUSEY > BoardY(Z, Y) - 51 AND _MOUSEY < BoardY(Z, Y) + 51 THEN PieceInput = 1 ELSE PieceInput = 0
                IF PieceInput = 1 AND _MOUSEBUTTON(1) = -1 THEN
                    GOSUB ButtonRelease: Piece$ = BoardPiece$(Z, Y): X = 0
                    FOR V = 1 TO 24
                        IF VAL(MID$(Piece$, V, 1)) = 1 THEN
                            IF Z + MoveRow(V) >= 1 AND Z + MoveRow(V) <= 6 AND Y + MoveCol(V) >= 1 AND Y + MoveCol(V) <= 6 THEN X = 1: Playable(Z + MoveRow(V), Y + MoveCol(V)) = 1
                        END IF
                    NEXT
                    IF X = 1 THEN Row1 = Z: Column1 = Y: GOTO EndPieceInput
                END IF
            END IF
        NEXT
    NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
GOTO PieceInput

EndPieceInput:
Piece$ = BoardPiece$(Row1, Column1)

' Draw Cursor Around Piece to be Moved
PSET (BoardX(Row1, Column1), BoardY(Row1, Column1)), 5: DRAW Cursor$

FOR Z = 1 TO 6
    FOR Y = 1 TO 6
        IF Playable(Z, Y) = 1 THEN PSET (BoardX(Z, Y), BoardY(Z, Y)), 5: DRAW "C0" + Cursor$
    NEXT
NEXT

_PRINTSTRING (764, 667), "Choose Location to Move to"

LocationInput:
DO WHILE _MOUSEINPUT
    FOR Z = 1 TO 6
        FOR Y = 1 TO 6
            IF Playable(Z, Y) = 1 OR (Z = Row1 AND Y = Column1) THEN
                IF _MOUSEX > BoardX(Z, Y) - 51 AND _MOUSEX < BoardX(Z, Y) + 51 AND _MOUSEY > BoardY(Z, Y) - 51 AND _MOUSEY < BoardY(Z, Y) + 51 THEN LocationInput = 1 ELSE LocationInput = 0
                IF LocationInput = 1 AND _MOUSEBUTTON(1) = -1 THEN
                    GOSUB ButtonRelease: row2 = Z: column2 = Y
                    IF row2 = Row1 AND column2 = Column1 THEN
                        IF (Row1 + Column1) / 2 = FIX((Row1 + Column1) / 2) THEN W$ = "C2" ELSE W$ = "C3"
                        PSET (BoardX(Row1, Column1), BoardY(Row1, Column1)), 5: DRAW W$ + Cursor$
                        FOR Z1 = 1 TO 6
                            FOR Y1 = 1 TO 6
                                IF Playable(Z1, Y1) = 1 THEN
                                    Playable(Z1, Y1) = 0
                                    IF (Z1 + Y1) / 2 = FIX((Z1 + Y1) / 2) THEN W$ = "C2" ELSE W$ = "C3"
                                    PSET (BoardX(Z1, Y1), BoardY(Z1, Y1)), 5: DRAW W$ + Cursor$
                                END IF
                            NEXT
                        NEXT
                        GOTO ChooseAPiece
                    END IF
                    GOTO EndLocationInput
                END IF
            END IF
        NEXT
    NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
GOTO LocationInput

EndLocationInput:
' Remove Playable Cursors
FOR Z = 1 TO 6
    FOR Y = 1 TO 6
        IF Playable(Z, Y) THEN
            Playable(Z, Y) = 0
            IF (Z + Y) / 2 = FIX((Z + Y) / 2) THEN W$ = "C2" ELSE W$ = "C3"
            PSET (BoardX(Z, Y), BoardY(Z, Y)), 5: DRAW W$ + Cursor$
        END IF
    NEXT
NEXT

' Get Board Square Color of Where Piece is Being Moved from
IF (Row1 + Column1) / 2 = FIX((Row1 + Column1) / 2) THEN W = 2 ELSE W = 3

' Remove Piece from Screen at Previous Location
LINE (BoardX(Row1, Column1) - 55, BoardY(Row1, Column1) - 55)-(BoardX(Row1, Column1) + 55, BoardY(Row1, Column1) + 55), W, BF

' Check if a Peace is already at New Location and Capture
LocationPlayer = BoardPlayer(row2, column2): IF LocationPlayer > 0 THEN Pieces(LocationPlayer) = Pieces(LocationPlayer) - 1

' Place Piece at New Location in Memory
BoardPlayer(row2, column2) = Player: BoardPiece$(row2, column2) = Piece$

' Remove Piece from Previous Location in Memory
BoardPlayer(Row1, Column1) = 0: BoardPiece$(Row1, Column1) = "000000000000000000000000"

' Draw Piece at New Board Location
X1 = BoardX(row2, column2): X2 = BoardY(row2, column2): X3 = Player: PieceSize = 1: GOSUB DrawPiece

PlacePeg:
_PRINTSTRING (764, 667), "Choose Piece to Add a Peg "

IF FirstPeg = 1 THEN
    _PRINTSTRING (796, 707), " Placing First Peg "
ELSE
    _PRINTSTRING (796, 707), "Placing Second Peg"
END IF

ChoosePiece:
DO WHILE _MOUSEINPUT
    FOR Z = 1 TO 6
        FOR Y = 1 TO 6
            IF BoardPlayer(Z, Y) = Player THEN
                IF _MOUSEX > BoardX(Z, Y) - 51 AND _MOUSEX < BoardX(Z, Y) + 51 AND _MOUSEY > BoardY(Z, Y) - 51 AND _MOUSEY < BoardY(Z, Y) + 51 THEN ChooseInput = 1 ELSE ChooseInput = 0
                IF ChooseInput = 1 AND _MOUSEBUTTON(1) = -1 THEN
                    GOSUB ButtonRelease: row = Z: column = Y: GOTO EndChoosePiece
                END IF
            END IF
        NEXT
    NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
GOTO ChoosePiece

EndChoosePiece:
Piece$ = BoardPiece$(row, column)

PSET (BoardX(row, column), BoardY(row, column)), 5: DRAW Cursor$

X1 = 880: X2 = 400: X3 = Player: PieceSize = 2: GOSUB DrawPiece

_PRINTSTRING (764, 667), " Choose an Empty Peg Hole "

PegInput:
DO WHILE _MOUSEINPUT
    X = 310: V = 790
    FOR W = 1 TO 24
        IF W = 13 THEN V = V + 45
        IF MID$(Piece$, W, 1) = "0" THEN
            IF _MOUSEX > V - 18 AND _MOUSEX < V + 18 AND _MOUSEY > X - 18 AND _MOUSEY < X + 18 THEN Selected = 1 ELSE Selected = 0
            IF Selected = 1 AND _MOUSEBUTTON(1) = -1 THEN
                GOSUB ButtonRelease: PegChoice = W: GOTO EndPegInput
            END IF
        END IF
        IF W = 5 OR W = 10 OR W = 14 OR W = 19 THEN
            V = 790: X = X + 45
        ELSE
            V = V + 45
        END IF
    NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
GOTO PegInput

EndPegInput:
' Remove Piece from Right Side of Board
LINE (735, 255)-(1000, 520), 15, BF

' Add Peg to Piece on Board in Memory
MID$(Piece$, PegChoice, 1) = "1": BoardPiece$(row, column) = Piece$

' Get Board Square Color
IF (row + column) / 2 = FIX((row + column) / 2) THEN W = 2 ELSE W = 3

' Remove Piece and Cursor from Board to be Redrawn
LINE (BoardX(row, column) - 55, BoardY(row, column) - 55)-(BoardX(row, column) + 55, BoardY(row, column) + 55), W, BF

' Redraw Piece with New Peg Placed
X1 = BoardX(row, column): X2 = BoardY(row, column): X3 = Player: PieceSize = 1: GOSUB DrawPiece

IF FirstPeg = 1 THEN FirstPeg = 0: GOTO PlacePeg

_PRINTSTRING (796, 707), "                  "

' Check for Winner
Winner = 0
IF Pieces(1) = 1 THEN Winner = 2
IF Pieces(2) = 1 THEN Winner = 1

IF Pieces(1) = 2 AND Pieces(2) = 2 THEN
    FOR Z = 1 TO 6
        FOR Y = 1 TO 6
            IF BoardPlayer(Z, Y) = 1 THEN IF BoardPiece$(Z, Y) = "111111111111111111111111" THEN Winner = 1
            IF BoardPlayer(Z, Y) = 2 THEN IF BoardPiece$(Z, Y) = "111111111111111111111111" THEN Winner = 2
        NEXT
    NEXT
END IF

IF Winner > 0 GOTO Winner

SWAP Player, Opponent
GOTO StartGame


SLEEP

DrawPiece:
IF X3 = 1 THEN W2 = 0: ELSE W2 = 4:
IF PieceSize = 1 THEN U1 = 40: U2 = 10: U3 = 36: U4 = 18: U5 = 6 ELSE U1 = 100: U2 = 20: U3 = 90: U4 = 45: U5 = 16

LINE (X1 - U1, X2 - U1 - U2)-(X1 + U1, X2 - U1 - U2), W2
LINE (X1 - U1, X2 + U1 + U2)-(X1 + U1, X2 + U1 + U2), W2
LINE (X1 - U1 - U2, X2 - U1)-(X1 - U1 - U2, X2 + U1), W2
LINE (X1 + U1 + U2, X2 - U1)-(X1 + U1 + U2, X2 + U1), W2
CIRCLE (X1 - U1, X2 - U1), U2, W2, 1.5, 3.2
CIRCLE (X1 + U1, X2 - U1), U2, W2, 0, 1.7
CIRCLE (X1 - U1, X2 + U1), U2, W2, 3.0, 4.8
CIRCLE (X1 + U1, X2 + U1), U2, W2, 4.5, 0
PAINT (X1, X2), W2

PosX = X1 - U3: PosY = X2 - U3

FOR Z1 = 1 TO 24

    T = VAL(MID$(Piece$, Z1, 1)): IF T = 1 THEN Peg = PegColor(X3) ELSE Peg = EmptyHole(X3)

    IF Z1 = 13 THEN CIRCLE (PosX, PosY), U5, 5: PAINT (PosX, PosY), 5: PosX = PosX + U4

    CIRCLE (PosX, PosY), U5, Peg: PAINT (PosX, PosY), Peg

    IF Z1 = 5 OR Z1 = 10 OR Z1 = 14 OR Z1 = 19 THEN PosX = X1 - U3: PosY = PosY + U4 ELSE PosX = PosX + U4

NEXT

RETURN

ButtonRelease:
DO WHILE _MOUSEINPUT
    IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ButtonRelease

Winner:
X1 = 880: X2 = 110: X3 = Winner: PieceSize = 1: Piece$ = "000000000000000000000000": GOSUB DrawPiece

IF Winner = 1 THEN
    _PRINTSTRING (845, 170), "Player 1"
ELSE
    _PRINTSTRING (845, 170), "Player 2"
END IF

IF Winner = 1 THEN
    _PRINTSTRING (767, 667), " Player 1 is the Winner!  "
ELSE
    _PRINTSTRING (767, 667), " Player 2 is the Winner!  "
END IF

_PRINTSTRING (763, 707), "Play Another Game?  Y or N"

GetYorN:
A$ = UCASE$(INKEY$): IF A$ = "" GOTO GetYorN
IF ASC(A$) = 27 AND Full = 0 THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH: Full = 1 ELSE IF ASC(A$) = 27 THEN _FULLSCREEN _OFF: Full = 0
IF A$ = "Y" THEN RUN
IF A$ = "N" THEN SYSTEM
GOTO GetYorN

