09-09-2023, 05:14 PM
Hello all,
Niya is a 2 player abstract strategy board game.
![[Image: Niya-Screenshot.png]](https://i.ibb.co/tZFHVgr/Niya-Screenshot.png)
[attachment=2244]
Niya is a 2 player abstract strategy board game.
[attachment=2244]
Code: (Select All)
_TITLE "NIYA Board Game - Programmed by Donald L. Foster Jr. 2023"
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1317, 752, 256)
_PALETTECOLOR 1, _RGB32(200, 6, 17) ' Red
_PALETTECOLOR 2, _RGB32(6, 105, 0) ' Green
_PALETTECOLOR 3, _RGB32(245, 220, 6) ' Yellow
_PALETTECOLOR 4, _RGB32(127, 72, 127) ' Violet
_PALETTECOLOR 5, _RGB32(255, 133, 0) ' Orange
_PALETTECOLOR 6, _RGB32(0, 89, 255) ' Blue
_PALETTECOLOR 7, _RGB32(255, 83, 111) ' Pink
_PALETTECOLOR 8, _RGB32(214, 134, 66) ' Gold
_PALETTECOLOR 9, _RGB32(157) ' Light Tile Side
_PALETTECOLOR 10, _RGB32(65) ' Dark Tile Bottom
_PALETTECOLOR 11, _RGB32(210, 180, 140) ' Background
_PALETTECOLOR 12, _RGB32(139, 69, 19) ' Player 1 Dark Brown Color
_PALETTECOLOR 13, _RGB32(169, 99, 49) ' Player 1 Light Brown Color
DIM AS _UNSIGNED _BIT FirstMove, CanPlay, Playable(4, 4)
DIM AS _UNSIGNED _BYTE Player, Opponent, HoldTile, Row, Column, Shape1, Shape2, PiecesPlayed
DIM AS INTEGER X, Y, Z, Tile
DIM SHARED AS _BYTE Placed(24), BoardPlayer(4, 4), BoardTile(4, 4), TileShape(16, 2), OffSet(8), Win(4, 4)
DIM SHARED AS INTEGER BoardX(4, 4), BoardY(4, 4)
TileShape(1, 1) = 1: TileShape(1, 2) = 5: TileShape(2, 1) = 1: TileShape(2, 2) = 6: TileShape(3, 1) = 1: TileShape(3, 2) = 7: TileShape(4, 1) = 1: TileShape(4, 2) = 8
TileShape(5, 1) = 2: TileShape(5, 2) = 5: TileShape(6, 1) = 2: TileShape(6, 2) = 6: TileShape(7, 1) = 2: TileShape(7, 2) = 7: TileShape(8, 1) = 2: TileShape(8, 2) = 8
TileShape(9, 1) = 3: TileShape(9, 2) = 5: TileShape(10, 1) = 3: TileShape(10, 2) = 6: TileShape(11, 1) = 3: TileShape(11, 2) = 7: TileShape(12, 1) = 3: TileShape(12, 2) = 8
TileShape(13, 1) = 4: TileShape(13, 2) = 5: TileShape(14, 1) = 4: TileShape(14, 2) = 6: TileShape(15, 1) = 4: TileShape(15, 2) = 7: TileShape(16, 1) = 4: TileShape(16, 2) = 8
FOR Z = 1 TO 4: FOR Y = 1 TO 4: BoardPlayer(Z, Y) = 0: NEXT: NEXT
FOR Z = 1 TO 16: Placed(Z) = 0: NEXT
OffSet(1) = -36: OffSet(2) = 36
Player = 1: Opponent = 2: FirstMove = 1: PiecesPlayed = 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\Segoeuib.ttf"
CLS , 11
' Draw Board
X = 91
FOR Z = 1 TO 4
V = 91
FOR Y = 1 TO 4
GetTile: Tile = INT(RND * 16) + 1: IF Placed(Tile) GOTO GetTile ELSE Placed(Tile) = 1
DrawTile V, X, Tile: BoardTile(Z, Y) = Tile: BoardX(Z, Y) = V: BoardY(Z, Y) = X
V = V + 187
NEXT
X = X + 187
NEXT
font& = _LOADFONT(fontpath$, 70): _FONT font&
COLOR 0, 11: _PRINTSTRING (889, 10), "N I Y A"
StartGame:
' Draw Player Indicator
DrawPiece 1029, 170, Player
font& = _LOADFONT(fontpath$, 30): _FONT font&
_PRINTSTRING (970, 270), "Player: " + STR$(Player)
IF FirstMove THEN
' Set Only Boarder Tiles as Playable
FOR Z = 1 TO 4: Playable(1, Z) = 1: Playable(4, Z) = 1: Playable(Z, 1) = 1: Playable(Z, 4) = 1: NEXT:
CanPlay = 1: FirstMove = 0
ELSE
' Get Playable Moves
FOR Z = 1 TO 4
FOR Y = 1 TO 4
IF BoardPlayer(Z, Y) = 0 THEN
IF TileShape(BoardTile(Z, Y), 1) = Shape1 OR TileShape(BoardTile(Z, Y), 2) = Shape2 THEN CanPlay = 1: Playable(Z, Y) = 1
END IF
NEXT
NEXT
END IF
font& = _LOADFONT(fontpath$, 25): _FONT font&
IF CanPlay = 0 THEN
_PRINTSTRING (840, 680), " You have no Playable Moves"
_PRINTSTRING (840, 715), " Press <ENTER> to Continue "
ENTER: A$ = INKEY$: IF A$ = "" GOTO ENTER
IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
IF ASC(A$) <> 13 GOTO ENTER
DrawPiece 1029, 170, Opponent
font& = _LOADFONT(fontpath$, 30): _FONT font&
_PRINTSTRING (970, 270), "Player: " + STR$(Opponent)
font& = _LOADFONT(fontpath$, 25): _FONT font&
Winner Opponent
END IF
' Show Playable Moves
FOR Z = 1 TO 4
FOR Y = 1 TO 4
IF Playable(Z, Y) THEN DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1
NEXT
NEXT
_PRINTSTRING (840, 715), " Choose a Tile to Remove "
GetTileInput:
DO WHILE _MOUSEINPUT
FOR Z = 1 TO 4
FOR Y = 1 TO 4
IF _MOUSEX > BoardX(Z, Y) - 86 AND _MOUSEX < BoardX(Z, Y) + 86 AND _MOUSEY > BoardY(Z, Y) - 86 AND _MOUSEY < BoardY(Z, Y) + 86 THEN selected = 1 ELSE selected = 0
IF _MOUSEBUTTON(1) = -1 AND selected AND Playable(Z, Y) THEN GOSUB ReleaseButton: Row = Z: Column = Y: GOTO MoveTile
NEXT
NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetTileInput
MoveTile:
' Remove Board Cursors
FOR Z = 1 TO 4
FOR Y = 1 TO 4
IF Playable(Z, Y) THEN Playable(Z, Y) = 0: DrawCursor BoardX(Z, Y), BoardY(Z, Y), 0
NEXT
NEXT
' Update Board Positions
BoardPlayer(Row, Column) = Player: HoldTile = BoardTile(Row, Column): BoardTile(Row, Column) = 0: PiecesPlayed = PiecesPlayed + 1
' Move Tile to Side of Board and Place Player's Piece
DrawTile 1032, 500, HoldTile: DrawPiece BoardX(Row, Column), BoardY(Row, Column), Player
IF CheckWinner(Player) = Player THEN
' Place Cursor Around Winning Pieces
FOR Z = 1 TO 4
FOR Y = 1 TO 4
IF Win(Z, Y) THEN DrawCursor BoardX(Z, Y), BoardY(Z, Y), 1
NEXT
NEXT
Winner Player
END IF
' Tie Game
IF PiecesPlayed = 16 THEN LINE (945, 413)-(1119, 587), 11, BF: Winner 3
' Get Patterns of Tile on Side of the Board
Shape1 = TileShape(HoldTile, 1): Shape2 = TileShape(HoldTile, 2)
CanPlay = 0: SWAP Player, Opponent: GOTO StartGame
ReleaseButton:
DO WHILE _MOUSEINPUT
IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ReleaseButton
SUB DrawTile (X1, X2, Tile)
LINE (X1 - 80, X2 - 80)-(X1 + 80, X2 + 80), 15, BF: PSET (X1 + 81, X2 - 80), 9: DRAW "TA0ND161F6D161H6BR2P9,9BL2C10NL161F6L161H6BR5BD2P10,10"
FOR Z = 1 TO 2
SELECT CASE TileShape(Tile, Z)
CASE 1 ' Circle
CIRCLE (X1 + OffSet(Z), X2 + OffSet(Z)), 35, 0
CASE 2 ' Diamond
PSET (X1 + OffSet(Z), X2 + OffSet(Z)), 15: DRAW "C0TA0BU32BR5G39F39E39H39"
CASE 3 ' Cross
CIRCLE (X1 + OffSet(Z) - 20, X2 + OffSet(Z)), 15, 0, 1.0, 5.2: CIRCLE (X1 + OffSet(Z) + 20, X2 + OffSet(Z)), 15, 0, 4.1, 2.1
CIRCLE (X1 + OffSet(Z), X2 + OffSet(Z) - 20), 15, 0, 5.5, 3.9: CIRCLE (X1 + OffSet(Z), X2 + OffSet(Z) + 20), 15, 0, 2.4, 0.6
CASE 4 ' X
PSET (X1 + OffSet(Z), X2 + OffSet(Z)), 15: DRAW "C0TA0BR15TA65R35TA115U35TA65U35TA115L35TA65L35TA115D35TA65D35TA115R35"
CASE 5 ' Square
LINE (X1 + OffSet(Z) - 32, X2 + OffSet(Z) - 32)-(X1 + OffSet(Z) + 32, X2 + OffSet(Z) + 32), 0, B
CASE 6 ' Star
PSET (X1 + OffSet(Z), X2 + OffSet(Z)), 15: DRAW "C0TA0BU16BR4TA15U22TA165U22TA45BL12TA15L22TA165L22TA45BD12TA15D22TA165D22TA45BR12TA15R22TA165R22"
DRAW "C0TA60R22TA30L22TA0BL12TA60U22TA30D22TA0BD12TA60L22TA30R22TA0BR12TA60D22TA30U22"
CASE 7 ' Triangle
PSET (X1 + OffSet(Z), X2 + OffSet(Z)), 15: DRAW "C0TA0BD35TA0R35TA120R70TA240R70TA0R36"
CASE 8 ' Hexagon
PSET (X1 + OffSet(Z), X2 + OffSet(Z)), 15: DRAW "C0TA0BL27BU6D23TA60D35TA120D35TA0DU35TA60U35TA120U35TA0D20"
END SELECT
PAINT (X1 + OffSet(Z), X2 + OffSet(Z)), TileShape(Tile, Z), 0
NEXT
END SUB
SUB DrawPiece (X1, X2, Player)
LINE (X1 - 87, X2 - 87)-(X1 + 87, X2 + 87), 11, BF
IF Player = 1 THEN W1 = 12: W2 = 13 ELSE W1 = 0: W2 = 10
CIRCLE (X1 + 3, X2 - 10), 81, W1, 0, 3.2, -0.15: CIRCLE (X1 + 3, X2 + 18), 81, W1, 3.0, 0.2, -0.15
LINE (X1 - 78, X2 - 10)-(X1 - 78, X2 + 18), W1: LINE (X1 + 84, X2 - 10)-(X1 + 84, X2 + 18), W1
PAINT (X1, X2 + 70), W1: CIRCLE (X1 + 3, X2 - 10), 75, W2, , , -0.15: PAINT (X1, X2), W2
END SUB
SUB DrawCursor (X1, X2, Show)
IF Show = 1 THEN W = 0 ELSE W = 11
PSET (X1 - 85, X2 - 85), W: DRAW "TA0R177D177L177U177H1R179D179L179U179H1R181D181L181U181"
END SUB
FUNCTION CheckWinner (Player)
X = 0
FOR Z = 1 TO 4
' Verticle
IF BoardPlayer(1, Z) = Player AND BoardPlayer(2, Z) = Player AND BoardPlayer(3, Z) = Player AND BoardPlayer(4, Z) = Player THEN
X = 1: Win(1, Z) = 1: Win(2, Z) = 1: Win(3, Z) = 1: Win(4, Z) = 1
END IF
' Horizontal
IF BoardPlayer(Z, 1) = Player AND BoardPlayer(Z, 2) = Player AND BoardPlayer(Z, 3) = Player AND BoardPlayer(Z, 4) = Player THEN
X = 1: Win(Z, 1) = 1: Win(Z, 2) = 1: Win(Z, 3) = 1: Win(Z, 4) = 1
END IF
NEXT
' Diagnol1
IF BoardPlayer(1, 1) = Player AND BoardPlayer(2, 2) = Player AND BoardPlayer(3, 3) = Player AND BoardPlayer(4, 4) = Player THEN
X = 1: Win(1, 1) = 1: Win(2, 2) = 1: Win(3, 3) = 1: Win(4, 4) = 1
END IF
' Diagnol2
IF BoardPlayer(1, 4) = Player AND BoardPlayer(2, 3) = Player AND BoardPlayer(3, 2) = Player AND BoardPlayer(4, 1) = Player THEN
X = 1: Win(1, 4) = 1: Win(2, 3) = 1: Win(3, 2) = 1: Win(4, 1) = 1
END IF
' 2 X 2 Square
FOR Z = 1 TO 3 STEP 2
FOR y = 1 TO 3 STEP 2
IF BoardPlayer(Z, y) = Player AND BoardPlayer(Z, y + 1) = Player AND BoardPlayer(Z + 1, y) = Player AND BoardPlayer(Z + 1, y + 1) = Player THEN
X = 1: Win(Z, y) = 1: Win(Z, y + 1) = 1: Win(Z + 1, y) = 1: Win(Z + 1, y + 1) = 1
END IF
NEXT
NEXT
IF X = 1 THEN CheckWinner = Player ELSE CheckWinner = 0
END FUNCTION
SUB Winner (Player)
LINE (945, 413)-(1119, 587), 11, BF
IF Player = 3 THEN
_PRINTSTRING (840, 680), " The Game Ended in a Draw "
ELSE
_PRINTSTRING (840, 680), " Player " + STR$(Player) + " is the Winner! "
END IF
_PRINTSTRING (840, 715), " Play Another Game (Y or N) "
YorN: A$ = UCASE$(INKEY$): IF A$ = "" GOTO YorN
IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
IF A$ = "Y" THEN RUN
IF A$ = "N" THEN SYSTEM
GOTO YorN
END SUB