Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 318
» Latest member: coletteleger
» Forum threads: 1,745
» Forum posts: 17,906

Full Statistics

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

 
  Summer Banner? YES! (Submit entries until the 20th!)
Posted by: RhoSigma - 06-09-2023, 09:28 PM - Forum: General Discussion - Replies (109)

Any Summer Banner contest on the run already? Only 2 weeks left.   (YES!   Yes there is!  See my post below by The Amazing Steve(tm)!!)

Would like to see Ocean, Beaches, Palm trees and lots of cool Drinks and Girls wearing skimpy Bikinies Big Grin

So all QB64 artists, ready - set - go.

Print this item

Heart qb=export bbcode now available!
Posted by: grymmjack - 06-09-2023, 01:33 AM - Forum: Announcements - Replies (5)

You can now use [ q b = e x p o r t ] {pasted export from QB64 IDE} [ / q b ] to embed QB64 exported source code.

This method of sharing includes hyperlinks to the wiki for keywords, etc.

I could not get the line numbers to be added at this time. I have successfully added them, but I cannot get them to not be selected with the code in the Code (select all) function above the embed.

Better than nothing for now.

@RhoSigma made this feature in QB64 and it's awesome!

To be clear, let's review how we can embed QB64 code in this forum:

  1. Using [ q b ] - This will take any QB64 source and share it with highlighting and line numbers.
  2. Using [ q b = e x p o r t ] - This explicitly takes QB64 source that is Exported to embed bbcode in the code itself and the keywords are linked to the wiki!
  3. Using [ q b j s ] - This allows you to share QB64 source and immediately edit it and run it in an in-thread QBJS IDE embed.

So! No excuses. Pick your method and start sharing!

Print this item

  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

   




.pdf   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

Print this item

  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 ?

Print this item

  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.

Print this item

  BAM program: Triangle Math Studying
Posted by: CharlieJV - 06-08-2023, 02:29 AM - Forum: QBJS, BAM, and Other BASICs - No Replies

(source code below the running program)

* Triangle Math 1

Print this item

  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?

Print this item

  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?

Print this item

  Free Basic 1.10
Posted by: bigriverguy - 06-05-2023, 02:18 PM - Forum: QBJS, BAM, and Other BASICs - Replies (8)

The Free Basic project has just released version 1.10 of their compiler.  To check it out you can download the latest release along with Paul Squires' integrated environment (win64) here: 

https://github.com/PaulSquires/WinFBE/re..._Suite.zip

The project page is here:

https://github.com/PaulSquires/WinFBE/releases

The Free Basic website is at:

https://www.freebasic.net

Print this item

  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!

Print this item