Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
astuce pour survivre fina...
Forum: Utilities
Last Post: coletteleger
05-14-2025, 04:47 AM
» Replies: 0
» Views: 10
|
trouver permis de conduir...
Forum: Utilities
Last Post: nicolasrene
05-05-2025, 05:24 AM
» Replies: 0
» Views: 19
|
LIGHTBAR Menu
Forum: Programs
Last Post: nicolasrene
05-05-2025, 05:08 AM
» Replies: 15
» Views: 945
|
Learning Pallet Rack Safe...
Forum: Utilities
Last Post: Sandrapew
04-03-2025, 09:36 AM
» Replies: 0
» Views: 39
|
Choosing New Versus or Pr...
Forum: Utilities
Last Post: Sandrapew
03-18-2025, 01:11 AM
» Replies: 0
» Views: 33
|
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 1,059
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 71
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 68
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 3,439
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 2,169
|
|
|
Sayu Board Game |
Posted by: Donald Foster - 06-08-2023, 08:32 PM - Forum: Programs
- Replies (18)
|
 |
Hello all,
Sayu is a 2 player abstract strategy tile placing game.
Donald
Sayu Description.pdf (Size: 41.36 KB / Downloads: 43)
Code: (Select All) _TITLE "Sayu Tile Game 2022 - Programmed by Donald L. Foster Jr. 2023"
SCREEN _NEWIMAGE(1305, 736, 256)
RANDOMIZE TIMER
_PALETTECOLOR 1, _RGB32(30, 30, 30) ' Board Space Color
_PALETTECOLOR 2, _RGB32(235, 164, 96) ' Tile Color
_PALETTECOLOR 3, _RGB32(154, 74, 6) ' Board Color
_PALETTECOLOR 4, _RGB32(225, 50, 0) ' Player 2 Red Tile
_PALETTECOLOR 5, _RGB32(109, 39, 0) ' Game Info Color
_PALETTECOLOR 6, _RGB32(150, 150, 150) ' Lt Grey Tile Color
_PALETTECOLOR 7, _RGB32(50, 50, 50) ' Dk Grey Tile Color
_PALETTECOLOR 8, _RGB32(255, 215, 0) ' Gold Tile Color
DIM AS _UNSIGNED INTEGER U, V, W, X, Y, Z, X1, X2, X3, X4, X5, X6
DIM AS _UNSIGNED _BYTE Player, Opponent, Tile, Direction, Rotation, TileColor, TilesPlaced, Winner, Converted, Til, Dir, Rot, DirectionArrow, PlayerScore(2)
DIM AS _UNSIGNED _BIT RandomTiles, Selected, Playable(7, 7), AvailablePattern(7), AvailableTile(7, 8)
DIM AS _UNSIGNED _BYTE PlayerColor(3), PlayerPieces(2), BoardPlayer(7, 7), BoardTile(7, 7), BoardDirection(7, 7), BoardRotation(7, 7), ConvertZ(8), ConvertY(8), DirectionArrow(8, 8)
DIM AS _UNSIGNED INTEGER BoardX(7, 7), BoardY(7, 7), PatternX(7), PatternY(7), TileX(8), TileY(8)
Player = 1: Opponent = 2: TilesPlaced = 1: PlayerScore(1) = 0: PlayerScore(2) = 1
PlayerColor(1) = 0: PlayerColor(2) = 4: PlayerColor(3) = 7: PlayerPieces(1) = 0: PlayerPieces(2) = 0
BoardPlayer(4, 4) = 2: BoardTile(4, 4) = 1: BoardDirection(4, 4) = 0: BoardRotation(4, 4) = 1
' Set Available Tiles to 1
FOR Z = 2 TO 7: AvailablePattern(Z) = 1: FOR Y = 1 TO 8: AvailableTile(Z, Y) = 1: NEXT: NEXT
' Setup Tile PatternX and {atternY
Tile = 2: X = 440: FOR Z = 1 TO 2: V = 899: FOR Y = 1 TO 3: PatternX(Tile) = V: PatternY(Tile) = X: Tile = Tile + 1: V = V + 122: NEXT: X = X + 123: NEXT
' Setup TileX and TileY
Direction = 1: X = 440: FOR Z = 1 TO 2: V = 840: FOR Y = 1 TO 4: TileX(Direction) = V: TileY(Direction) = X: Direction = Direction + 1: V = V + 122: NEXT: X = X + 123: NEXT
'Setup Directiona Arrows
X = 1: FOR Z = 1 TO 8: FOR Y = 1 TO 8: DirectionArrow(Z, Y) = VAL(MID$("12345678 23456781 34567812 45678123 56781234 67812345 78123456 81234567", X, 1)): X = X + 1: NEXT: X = X + 1: NEXT
Tile$ = "TA0BU51L21TA45L42TA90L42TA135L42TA180L42TA225L42TA270L42TA315L42TA360L22"
TileCenter$ = "TA0BU29L12TA45L24TA90L24TA135L24TA180L24TA225L24TA270L24TA315L24TA360L16"
DirectionArrow$ = "C15BD15BR1R2U18F6E4H13G13F4E6D18R3BU2P15,15"
Arrow$(1) = "C0BU30BR2R1U7F2E2H7G7F2E2D7BR2BU2P0,0": Arrow$(2) = "C4BU30BR2R1U7F2E2H7G7F2E2D7BR2BU2P4,4": Arrow$(3) = "C7BU30BR2R1U7F2E2H7G7F2E2D7BR2BU2P7,7"
PieceColor$(1) = "C0": PieceColor$(2) = "C4": PieceColor$(3) = "C7": PieceColor$(4) = "C15"
Direction$(1) = "TA0": Direction$(2) = "TA315": Direction$(3) = "TA270": Direction$(4) = "TA225": Direction$(5) = "TA180": Direction$(6) = "TA135": Direction$(7) = "TA90": Direction$(8) = "TA45"
Tile$(1, 1) = "00000000"
Tile$(2, 1) = "10100010": Tile$(2, 2) = "01010001": Tile$(2, 3) = "10101000": Tile$(2, 4) = "01010100": Tile$(2, 5) = "00101010": Tile$(2, 6) = "00010101": Tile$(2, 7) = "10001010": Tile$(2, 8) = "01000101"
Tile$(3, 1) = "10010100": Tile$(3, 2) = "01001010": Tile$(3, 3) = "00100101": Tile$(3, 4) = "10010010": Tile$(3, 5) = "01001001": Tile$(3, 6) = "10100100": Tile$(3, 7) = "01010010": Tile$(3, 8) = "00101001"
Tile$(4, 1) = "11000010": Tile$(4, 2) = "01100001": Tile$(4, 3) = "10110000": Tile$(4, 4) = "01011000": Tile$(4, 5) = "00101100": Tile$(4, 6) = "00010110": Tile$(4, 7) = "00001011": Tile$(4, 8) = "10000101"
Tile$(5, 1) = "11000100": Tile$(5, 2) = "01100010": Tile$(5, 3) = "00110001": Tile$(5, 4) = "10011000": Tile$(5, 5) = "01001100": Tile$(5, 6) = "00100110": Tile$(5, 7) = "00010011": Tile$(5, 8) = "10001001"
Tile$(6, 1) = "11001000": Tile$(6, 2) = "01100100": Tile$(6, 3) = "00110010": Tile$(6, 4) = "00011001": Tile$(6, 5) = "10001100": Tile$(6, 6) = "01000110": Tile$(6, 7) = "00100011": Tile$(6, 8) = "10011000"
Tile$(7, 1) = "11010000": Tile$(7, 2) = "01101000": Tile$(7, 3) = "00110100": Tile$(7, 4) = "00011010": Tile$(7, 5) = "00001101": Tile$(7, 6) = "10000110": Tile$(7, 7) = "01000011": Tile$(7, 8) = "10100001"
LINE (0, 0)-(737, 736), 3, BF: LINE (738, 0)-(1305, 736), 5, BF
' Draw Board
X = 59
FOR Z = 1 TO 7
V = 59
FOR Y = 1 TO 7
IF BoardPlayer(Z, Y) THEN X1 = V: X2 = X: X3 = 2: X4 = 0: GOSUB DrawTile
BoardX(Z, Y) = V: BoardY(Z, Y) = X
V = V + 104
NEXT
X = X + 103
NEXT
COLOR 15, 5: LOCATE 2, 108: PRINT "S A Y U B O A R D g A M E";
LOCATE 10, 115: PRINT "Choose Tiles Randomly? Y or N";
GetRandom: A$ = UCASE$(INKEY$): IF A$ = "" GOTO GetRandom
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 RandomTiles = 1 ELSE IF A$ = "N" THEN RandomTiles = 0 ELSE GOTO GetRandom
LOCATE 10, 115: PRINT " ";
StartGame:
' Show Player Indicator
X1 = 1021: X2 = 115: X3 = Player: X4 = 1: X5 = 1: X6 = 1: GOSUB DrawTile
COLOR 15, 5: LOCATE 13, 124: PRINT "Player: "; Player;
' Display Player's Tiles Count
LOCATE 41, 108: PRINT "Player 1's Tiles:"; PlayerScore(1);
LOCATE 41, 132: PRINT "Player 2's Tiles:"; PlayerScore(2);
' Set Playable Spaces to 0
FOR Z = 1 TO 7: FOR Y = 1 TO 7: Playable(Z, Y) = 0: NEXT: NEXT
' Get Playable Board Spaces
FOR Z = 1 TO 7
FOR Y = 1 TO 7
IF BoardPlayer(Z, Y) THEN
IF Z - 1 >= 1 THEN IF BoardPlayer(Z - 1, Y) = 0 THEN Playable(Z - 1, Y) = 1
IF Z + 1 <= 7 THEN IF BoardPlayer(Z + 1, Y) = 0 THEN Playable(Z + 1, Y) = 1
IF Y - 1 >= 1 THEN IF BoardPlayer(Z, Y - 1) = 0 THEN Playable(Z, Y - 1) = 1
IF Y + 1 <= 7 THEN IF BoardPlayer(Z, Y + 1) = 0 THEN Playable(Z, Y + 1) = 1
END IF
NEXT
NEXT
' Get Available Tile Patterns
FOR Z = 2 TO 7
X = 0
FOR Y = 1 TO 8
IF AvailableTile(Z, Y) THEN X = 1
NEXT
IF X THEN AvailablePattern(Z) = 1 ELSE AvailablePattern(Z) = 0
NEXT
IF RandomTiles THEN
RandomTile: Tile = INT(RND * 6) + 2: Direction = INT(RND * 8) + 1
IF AvailableTile(Tile, Direction) = 0 GOTO RandomTile
GOTO ChooseTileRotation
END IF
ShowTilePatterns:
LINE (780, 230)-(1270, 630), 5, BF
' Show Player's Available Tile Patterns
FOR Tile = 2 TO 7
IF AvailablePattern(Tile) THEN X3 = Player ELSE X3 = 3
X1 = PatternX(Tile): X2 = PatternY(Tile): X4 = Tile: X5 = 0: X6 = 1: GOSUB DrawTile
NEXT
ChooseTilePattern:
LOCATE 45, 108: PRINT " Choose an Available Tile Pattern to Play ";
GetTilePattern:
DO WHILE _MOUSEINPUT
Tile = 2
FOR Z = 1 TO 2
FOR Y = 1 TO 3
IF _MOUSEX > PatternX(Tile) - 60 AND _MOUSEX < PatternX(Tile) + 60 AND _MOUSEY > PatternY(Tile) - 60 AND _MOUSEY < PatternY(Tile) + 60 AND AvailablePattern(Tile) THEN Selected = 1 ELSE Selected = 0
IF Selected THEN
LINE (PatternX(Tile) - 60, PatternY(Tile) - 60)-(PatternX(Tile) + 60, PatternY(Tile) + 60), 15, B
ELSE
LINE (PatternX(Tile) - 60, PatternY(Tile) - 60)-(PatternX(Tile) + 60, PatternY(Tile) + 60), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected THEN GOSUB ReleaseButton: GOTO ChooseTileDirection
Tile = Tile + 1
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 GetTilePattern
ChooseTileDirection:
LINE (770, 230)-(1280, 630), 5, BF
X1 = 1021: X2 = 300: X3 = Player: X4 = Tile: X5 = 0: X6 = 1: GOSUB DrawTile
' Show Player's Available Tiles
FOR Direction = 1 TO 8
IF AvailableTile(Tile, Direction) THEN X3 = Player ELSE X3 = 3
X1 = TileX(Direction): X2 = TileY(Direction): X4 = Tile: X5 = Direction: X6 = 1: GOSUB DrawTile
NEXT
LOCATE 45, 108: PRINT "Choose an Available Tile Direction to Play";
GetTileDirection:
DO WHILE _MOUSEINPUT
' Choose a Different Tile Pattern
IF _MOUSEX > 968 AND _MOUSEX < 1074 AND _MOUSEY > 243 AND _MOUSEY < 353 THEN Selected = 1 ELSE Selected = 0
IF Selected THEN
LINE (961, 240)-(1081, 360), 15, B
ELSE
LINE (961, 240)-(1081, 360), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected THEN GOSUB ReleaseButton: GOTO ShowTilePatterns
' Choose Tile Direction
FOR Direction = 1 TO 8
IF _MOUSEX > TileX(Direction) - 60 AND _MOUSEX < TileX(Direction) + 60 AND _MOUSEY > TileY(Direction) - 60 AND _MOUSEY < TileY(Direction) + 60 AND AvailableTile(Tile, Direction) THEN Selected2 = 1 ELSE Selected2 = 0
IF Selected2 = 1 THEN
LINE (TileX(Direction) - 60, TileY(Direction) - 60)-(TileX(Direction) + 60, TileY(Direction) + 60), 15, B
ELSE
LINE (TileX(Direction) - 60, TileY(Direction) - 60)-(TileX(Direction) + 60, TileY(Direction) + 60), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected2 THEN GOSUB ReleaseButton: GOTO ChooseTileRotation
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 GetTileDirection
ChooseTileRotation:
LINE (770, 230)-(1280, 630), 5, BF
X1 = 1021: X2 = 300: X3 = Player: X4 = Tile: X5 = Direction: X6 = 1: GOSUB DrawTile
' Remove Playable Board Spaces from View
FOR Z = 1 TO 7
FOR Y = 1 TO 7
IF Playable(Z, Y) THEN PSET (BoardX(Z, Y), BoardY(Z, Y)), 3: DRAW Tile$
NEXT
NEXT
' Show Tile Rotations
FOR Rotation = 1 TO 8: X1 = TileX(Rotation): X2 = TileY(Rotation): X3 = Player: X4 = Tile: X5 = Direction: X6 = Rotation: GOSUB DrawTile: NEXT
LOCATE 45, 108: PRINT " Choose a Tile Rotationn to Play ";
GetTileRotation:
DO WHILE _MOUSEINPUT
' Choose a Different Tile Direction
IF RandomTiles = 0 THEN
IF _MOUSEX > 968 AND _MOUSEX < 1074 AND _MOUSEY > 243 AND _MOUSEY < 353 THEN Selected = 1 ELSE Selected = 0
IF Selected THEN
LINE (961, 240)-(1081, 360), 15, B
ELSE
LINE (961, 240)-(1081, 360), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected THEN GOSUB ReleaseButton: GOTO ChooseTileDirection
END IF
' Choose Tile Rotation
FOR Rotation = 1 TO 8
IF _MOUSEX > TileX(Rotation) - 60 AND _MOUSEX < TileX(Rotation) + 60 AND _MOUSEY > TileY(Rotation) - 60 AND _MOUSEY < TileY(Rotation) + 60 THEN Selected = 1 ELSE Selected = 0
IF Selected THEN
LINE (TileX(Rotation) - 60, TileY(Rotation) - 60)-(TileX(Rotation) + 60, TileY(Rotation) + 60), 15, B
ELSE
LINE (TileX(Rotation) - 60, TileY(Rotation) - 60)-(TileX(Rotation) + 60, TileY(Rotation) + 60), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected THEN GOSUB ReleaseButton: GOTO ChooseBoardSpace
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 GetTileRotation
ChooseBoardSpace:
LINE (770, 230)-(1280, 630), 5, BF
X1 = 1021: X2 = 300: X3 = Player: X4 = Tile: X5 = Direction: X6 = Rotation: GOSUB DrawTile
' Show Playable Board Spaces
FOR Z = 1 TO 7
FOR Y = 1 TO 7
IF Playable(Z, Y) THEN PSET (BoardX(Z, Y), BoardY(Z, Y)), 3: DRAW "C15" + Tile$
NEXT
NEXT
LOCATE 45, 108: PRINT " Choose a Board Space to Play Tile ";
GetBoardSpace:
DO WHILE _MOUSEINPUT
' Choose a Different Tile Rotation
IF _MOUSEX > 968 AND _MOUSEX < 1074 AND _MOUSEY > 243 AND _MOUSEY < 353 THEN Selected = 1 ELSE Selected = 0
IF Selected THEN
LINE (961, 240)-(1081, 360), 15, B
ELSE
LINE (961, 240)-(1081, 360), 5, B
END IF
IF _MOUSEBUTTON(1) AND Selected THEN GOSUB ReleaseButton: GOTO ChooseTileRotation
' Choose a Board Space
FOR Z = 1 TO 7
FOR Y = 1 TO 7
IF _MOUSEX > BoardX(Z, Y) - 55 AND _MOUSEX < BoardX(Z, Y) + 55 AND _MOUSEY > BoardY(Z, Y) - 55 AND _MOUSEY < BoardY(Z, Y) + 55 AND _MOUSEBUTTON(1) THEN GOSUB ReleaseButton: GOTO PlaceTile
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 GetBoardSpace
PlaceTile:
LINE (770, 230)-(1280, 630), 5, BF
' Nove Tile to Board Space
BoardPlayer(Z, Y) = Player: BoardTile(Z, Y) = Tile: BoardDirection(Z, Y) = Direction: BoardRotation(Z, Y) = Rotation: BoardTile$(Z, Y) = Tile$(Tile, Rotation)
AvailableTile(Tile, Direction) = 0: Playable(Z, Y) = 0: X1 = BoardX(Z, Y): X2 = BoardY(Z, Y): X3 = Player: X4 = Tile: X5 = Direction: X6 = Rotation: GOSUB DrawTile
' Remove Playaable Cursors from the Board
FOR V = 1 TO 7
FOR W = 1 TO 7
IF Playable(V, W) THEN PSET (BoardX(V, W), BoardY(V, W)), 3: DRAW "C3" + Tile$
NEXT
NEXT
CheckTilesConvert: Converted = 0: DirectionArrow = DirectionArrow(Direction, Rotation)
' Set Playables to 0
FOR V = 1 TO 7
FOR W = 1 TO 7
IF Playable(V, W) THEN Playable(V, W) = 0
NEXT
NEXT
' Check Up
IF Z - 1 >= 1 THEN
Til = BoardTile(Z - 1, Y): Dir = BoardDirection(Z - 1, Y): Rot = BoardRotation(Z - 1, Y)
IF BoardPlayer(Z - 1, Y) = Opponent AND DirectionArrow(Dir, Rot) <> DirectionArrow AND MID$(Tile$(Tile, Rotation), 1, 1) = "1" AND MID$(Tile$(BoardTile(Z - 1, Y), Rot), 5, 1) = "0" THEN
Converted = Converted + 1: Playable(Z - 1, Y) = 1
END IF
END IF
' Check Down
IF Z + 1 <= 7 THEN
Til = BoardTile(Z + 1, Y): Dir = BoardDirection(Z + 1, Y): Rot = BoardRotation(Z + 1, Y)
IF BoardPlayer(Z + 1, Y) = Opponent AND DirectionArrow(Dir, Rot) <> DirectionArrow AND MID$(Tile$(Tile, Rotation), 5, 1) = "1" AND MID$(Tile$(BoardTile(Z + 1, Y), Rot), 1, 1) = "0" THEN
Converted = Converted + 1: Playable(Z + 1, Y) = 1
END IF
END IF
' Check Left
IF Y - 1 >= 1 THEN
Til = BoardTile(Z, Y - 1): Dir = BoardDirection(Z, Y - 1): Rot = BoardRotation(Z, Y - 1)
IF BoardPlayer(Z, Y - 1) = Opponent AND DirectionArrow(Dir, Rot) <> DirectionArrow AND MID$(Tile$(Tile, Rotation), 7, 1) = "1" AND MID$(Tile$(BoardTile(Z, Y - 1), Rot), 3, 1) = "0" THEN
Converted = Converted + 1: Playable(Z, Y - 1) = 1
END IF
END IF
' Check Right
IF Y + 1 <= 7 THEN
Til = BoardTile(Z, Y + 1): Dir = BoardDirection(Z, Y + 1): Rot = BoardRotation(Z, Y + 1)
IF BoardPlayer(Z, Y + 1) = Opponent AND DirectionArrow(Dir, Rot) <> DirectionArrow AND MID$(Tile$(Tile, Rotation), 3, 1) = "1" AND MID$(Tile$(BoardTile(Z, Y + 1), Rot), 7, 1) = "0" THEN
Converted = Converted + 1: Playable(Z, Y + 1) = 1
END IF
END IF
' Check Up Left
IF Z - 1 >= 1 AND Y - 1 >= 1 THEN
IF BoardPlayer(Z - 1, Y - 1) = Opponent AND DirectionArrow(BoardDirection(Z - 1, Y - 1), BoardRotation(Z - 1, Y - 1)) <> DirectionArrow THEN
IF MID$(Tile$(Tile, Rotation), 8, 1) = "1" AND MID$(Tile$(BoardTile(Z - 1, Y - 1), BoardRotation(Z - 1, Y - 1)), 4, 1) = "0" THEN
Converted = Converted + 1: Playable(Z - 1, Y - 1) = 1
END IF
END IF
END IF
' Check Up Right
IF Z - 1 >= 1 AND Y + 1 <= 7 THEN
IF BoardPlayer(Z - 1, Y + 1) = Opponent AND DirectionArrow(BoardDirection(Z - 1, Y + 1), BoardRotation(Z - 1, Y + 1)) <> DirectionArrow THEN
IF MID$(Tile$(Tile, Rotation), 2, 1) = "1" AND MID$(Tile$(BoardTile(Z - 1, Y + 1), BoardRotation(Z - 1, Y + 1)), 6, 1) = "0" THEN
Converted = Converted + 1: Playable(Z - 1, Y + 1) = 1
END IF
END IF
END IF
' Check Down Left
IF Z + 1 <= 7 AND Y - 1 >= 1 THEN
IF BoardPlayer(Z + 1, Y - 1) = Opponent AND DirectionArrow(BoardDirection(Z + 1, Y - 1), BoardRotation(Z + 1, Y - 1)) <> DirectionArrow THEN
IF MID$(Tile$(Tile, Rotation), 6, 1) = "1" AND MID$(Tile$(BoardTile(Z + 1, Y - 1), BoardRotation(Z + 1, Y - 1)), 2, 1) = "0" THEN
Converted = Converted + 1: Playable(Z + 1, Y - 1) = 1
END IF
END IF
END IF
' Check Down Right
IF Z + 1 <= 7 AND Y + 1 <= 7 THEN
IF BoardPlayer(Z + 1, Y + 1) = Opponent AND DirectionArrow(BoardDirection(Z + 1, Y + 1), BoardRotation(Z + 1, Y + 1)) <> DirectionArrow THEN
IF MID$(Tile$(Tile, Rotation), 4, 1) = "1" AND MID$(Tile$(BoardTile(Z + 1, Y + 1), BoardRotation(Z + 1, Y + 1)), 8, 1) = "0" THEN
Converted = Converted + 1: Playable(Z + 1, Y + 1) = 1
END IF
END IF
END IF
IF Converted THEN
' Highlight Placed or Newly Convert Tile to Gold
PAINT (BoardX(Z, Y), BoardY(Z, Y) - 47), 8, PlayerColor(Player)
' Highlight Tile(s) to be Converted to White
FOR X = 1 TO 7
FOR V = 1 TO 7
IF Playable(X, V) THEN PAINT (BoardX(X, V), BoardY(X, V) - 47), 15, PlayerColor(Opponent)
NEXT
NEXT
' Check for Multiple Converable Tiles
IF Converted > 1 THEN
LOCATE 43, 113: PRINT "Multiple Tiles Can be Converted";
LOCATE 45, 108: PRINT " Choose a Tile to Convert ";
ChooseConvertedTile:
DO WHILE _MOUSEINPUT
FOR X = 1 TO 7: FOR V = 1 TO 7
IF _MOUSEX > BoardX(X, V) - 55 AND _MOUSEX < BoardX(X, V) + 55 AND _MOUSEY > BoardY(X, V) - 55 AND _MOUSEY < BoardY(X, V) + 55 AND _MOUSEBUTTON(1) AND Playable(X, V) THEN
GOSUB ReleaseButton: GOTO RestoreTiles
END IF
NEXT
NEXT
LOOP
A$ = INKEY$: IF A$ <> "" THEN IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO ChooseConvertedTile
RestoreTiles:
LOCATE 43, 113: PRINT " ";
' Set Tile Not Being Converted Back to Tile Color
Playable(X, V) = 0
FOR W = 1 TO 7
FOR U = 1 TO 7
IF Playable(W, U) = 1 THEN PAINT (BoardX(W, U), BoardY(W, U) - 47), 2, PlayerColor(Opponent)
NEXT
NEXT
GOTO ConvertTile
ELSE
' Get Tile to be Converted
FOR W = 1 TO 7
FOR U = 1 TO 7
IF Playable(W, U) THEN X = W: V = U
NEXT
NEXT
END IF
LOCATE 45, 108: PRINT " Press <ENTER> to Contvert Tile(s) ";
GetENTER1: A$ = INKEY$: IF A$ = "" GOTO GetENTER1
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 GetENTER1
' Remove Tile to be Converted from Screen
ConvertTile: PAINT (BoardX(X, V), BoardY(X, V)), 3
' Get New Rotation of Tile to be Converted
Til = BoardTile(X, V): Dir = BoardDirection(X, V): Rot = BoardRotation(X, V)
RotateTile: IF Til = 1 THEN Dir = 0: GOTO DisplayTile
IF DirectionArrow(Dir, Rot) = DirectionArrow GOTO DisplayTile
IF Rot = 8 THEN Rot = 1 ELSE Rot = Rot + 1
GOTO RotateTile
' Display the Converted Tile
DisplayTile: X1 = BoardX(X, V): X2 = BoardY(X, V): X3 = Player: X4 = Til: X5 = Dir: X6 = Rot: GOSUB DrawTile
' Update Converted Tile Board Info
BoardPlayer(X, V) = Player: BoardRotation(X, V) = Rot: BoardTile$(X, V) = Tile$(Til, Rot)
' Change Placed or Converted Tile Back to Player Color
PAINT (BoardX(Z, Y), BoardY(Z, Y) - 47), 2, PlayerColor(Player)
Z = X: Y = V: Tile = BoardTile(Z, Y): Direction = BoardDirection(Z, Y): Rotation = BoardRotation(Z, Y)
GOTO CheckTilesConvert
END IF
TilesPlaced = TilesPlaced + 1
' Calculate Player's Score
PlayerScore(1) = 0: PlayerScore(2) = 0
FOR Z = 1 TO 7
FOR Y = 1 TO 7
IF BoardPlayer(Z, Y) THEN PlayerScore(BoardPlayer(Z, Y)) = PlayerScore(BoardPlayer(Z, Y)) + 1
NEXT
NEXT
' Check for End of Game and Declare Winner
IF TilesPlaced = 49 THEN
FOR Z = 1 TO 7: FOR Y = 1 TO 7: PlayerPieces(BoardPlayer(Z, Y)) = PlayerPieces(BoardPlayer(Z, Y)) + 1: NEXT: NEXT
IF PlayerPieces(1) > PlayerPieces(2) THEN Winner = 1 ELSE Winner = 2
' Display Player's Tiles Count
LOCATE 41, 108: PRINT "Player 1's Score:"; PlayerScore(1);
LOCATE 41, 132: PRINT "Player 2's Score:"; PlayerScore(2);
X1 = 1021: X2 = 115: X3 = Winner: X4 = 1: X5 = 1: X6 = 1: GOSUB DrawTile
LOCATE 43, 118: PRINT "Player"; Winner; "is the Winner!";
LOCATE 45, 108: PRINT " Play Another Game? Y or N ";
Winner: A$ = UCASE$(INKEY$): IF A$ = "" GOTO Winner
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 ELSE IF A$ = "N" THEN SYSTEM ELSE GOTO Winner
END IF
IF convertz = 4 AND converty = 4 THEN BoardTile(4, 4) = 1: BoardDirection(4, 4) = 0: BoardRotation(4, 4) = 1
SWAP Player, Opponent: GOTO StartGame
ReleaseButton:
DO WHILE _MOUSEINPUT
IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ReleaseButton
DrawTile:
' X1 = Screen X Position
' X2 = Screen Y Position
' X3 = Player, 3 = Tile and/or Tile Pattern Not Available
' X4 = Tile
' X5 = Direction
' X6 = Rotation
IF X3 = 3 THEN TileColor = 6 ELSE TileColor = 2
PSET (X1, X2), 3: DRAW PieceColor$(X3) + Tile$: PAINT (X1, X2), TileColor, PlayerColor(X3)
PSET (X1, X2), TileColor: DRAW PieceColor$(X3) + TileCenter$: PAINT (X1, X2), PlayerColor(X3)
FOR W = 1 TO 8
U = VAL(MID$(Tile$(X4, X6), W, 1)): IF U THEN PSET (X1, X2), PlayerColor(X3): DRAW Direction$(W) + Arrow$(X3)
NEXT
IF X4 > 1 THEN DirectionArrow = DirectionArrow(X5, X6) ELSE DirectionArrow = 0
IF DirectionArrow THEN PSET (X1, X2), PlayerColor(X3): DRAW Direction$(DirectionArrow) + DirectionArrow$
RETURN
|
|
|
Comm and VCSP port twiddling controls sigs |
Posted by: doppler - 06-08-2023, 12:12 PM - Forum: Help Me!
- Replies (2)
|
 |
I am back playing with comm ports again. Way back in the old days it was possible to talk using inp and outp to twiddle RTS n DTR. As well as read DTR n CLS. Nowadays it's not possible to get to those signals. It's all because of VCSP (virtual comm serial port). It's possible to have 255 serial ports in windows. In the original PC comm ports maxed at 4 physical ports. Now the VCSP port could be a alternative to a 8250 comm chip. Or even not a comm port but a Ethernet serial interface device.
I am trying to test the above control signals, to identify bad ports (combination of loop back and such). I need a way to set and read the control signals.
I suck at DLL interfacing with QB64. Which is where I assume be VCSP signals need to be accessed.
Any help here maybe ?
|
|
|
Problem starting BC.Exe in DOS 5.02 |
Posted by: eoredson - 06-08-2023, 04:55 AM - Forum: Help Me!
- Replies (14)
|
 |
We are trying to run certain .exe programs on a IBM 486 running DOS 5.02 to make sure they are backwards compatible. When attempting to compile an QBasic 4.5 program with BC.EXE we get the following error and would like to know how to solve it.:
Code: (Select All) runtime error R6002
- floating point not loaded
Note: This is not a Windows error and we have all the necessary drivers loaded.
|
|
|
CPU Type and Speed |
Posted by: TerryRitchie - 06-07-2023, 08:26 PM - Forum: General Discussion
- Replies (11)
|
 |
A while back I could have sworn I saw someone post code that identified the CPU and speed using a Declare Library but I can't find it. Furthermore, I would have saved something like that in my box of goodies but I can't find that either?? Is my age finally messing with my brain or did I in fact see this code recently?
|
|
|
Testing QBJS tags |
Posted by: bplus - 06-05-2023, 06:21 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (10)
|
 |
[qbjs]'Option _Explicit
'_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example
' https(colon)//staging.qb64phoenix.com/showthread.php?tid=1646&pid=15772#pid15772
' b+ 2023-05-09 - Tiling with a pattern
' Tessellation 2 will try color filled with more background black.
' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,
' lets try mirroring both x and y axis.
'
' Tessellation 4
' Use b key to toggle between
' 1. 3 color tessellation
' 2. 4 color tessellation
' and use c key to toggle between
' 1. a random set of colors
' 2. contrast (a red, a green, a blue and 4th is white)
'
'DefLng A-Z
Randomize Timer
Screen _NewImage(800, 600, 32) ' full rgb range here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Toggle color mode from 3 to 4 and back
Dim Shared C ' Toggle Contrast set and Random set of colors
ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors
Dim K$, t$
Do
K$ = InKey$
If K$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
If K$ = "c" Then C = 1 - C ' toggle coloring mode on a b keypress
' update the title according current b and c toggles
If B Then t$ = "4" Else t$ = "3"
If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"
_Title t$ + ">>> use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"
MakePalette ' 3 or 4 random colors according to b
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakePalette
Dim As Long n, i
If B Then n = 4 Else n = 3
ReDim Pal(1 To n) As _Unsigned Long
For i = 1 To n
If C Then
If B Then
If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
Else
Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
End If
Else
Pal(i) = C3~&(Int(Rnd * 1000))
End If
Next
End Sub
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
Dim As Long y, x, q
For y = 0 To Scale * Pix Step Scale
For x = 0 To Scale * Pix Step Scale
If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
Dim As Long y, x
For y = 0 To _Height Step 2 * Scale * Pix
For x = 0 To _Width Step 2 * Scale * Pix
_PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0
Next
Next
End Sub
Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
Dim s3$, r As Long, g As Long, b As Long
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1))
If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1))
If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1))
If b Then b = 28 * b + 3
C3~& = _RGB32(r, g, b)
End Function[/qbjs]
So what am I doing wrong?
|
|
|
Developing the next generation |
Posted by: NasaCow - 06-05-2023, 11:33 AM - Forum: General Discussion
- Replies (7)
|
 |
So, I have a nearly 7 year old daughter and she seems interested in daddy pounding on the keyboard when I am programming. I know scratch is a language for kids as well. Anyone have experince of it and can point me in a direction to have enough resources to teach it? Or should I just download it and it is all in the langauge already? Thanks!
|
|
|
|