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

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 493
» Latest member: peadenaw@gmail.com
» Forum threads: 2,837
» Forum posts: 26,581

Full Statistics

Latest Threads
another variation of "10 ...
Forum: Programs
Last Post: JRace
33 minutes ago
» Replies: 18
» Views: 200
Box_Bash game
Forum: Works in Progress
Last Post: bplus
3 hours ago
» Replies: 1
» Views: 24
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: a740g
6 hours ago
» Replies: 5
» Views: 157
Sound Effects Generator (...
Forum: Petr
Last Post: a740g
7 hours ago
» Replies: 1
» Views: 40
_SndRaw and _MemFree
Forum: General Discussion
Last Post: a740g
7 hours ago
» Replies: 1
» Views: 41
Problems with QBJS
Forum: Help Me!
Last Post: bplus
9 hours ago
» Replies: 4
» Views: 91
which day of the week
Forum: Programs
Last Post: bplus
10 hours ago
» Replies: 31
» Views: 689
sleep command in compiler...
Forum: General Discussion
Last Post: SMcNeill
Yesterday, 02:57 PM
» Replies: 3
» Views: 84
Another Dir/File compare ...
Forum: Utilities
Last Post: eoredson
Yesterday, 03:48 AM
» Replies: 0
» Views: 44
Aloha from Maui guys.
Forum: General Discussion
Last Post: madscijr
01-10-2025, 04:33 PM
» Replies: 8
» Views: 155

 
  Octogo Board Game
Posted by: Donald Foster - 05-02-2023, 05:45 PM - Forum: Donald Foster - Replies (6)



Hello All,
Here is my take on the abstract strategy board game 'Octogo'. 
Hope you enjoy playing.

Donald

Code: (Select All)
_TITLE "Octogo Board Game 1986 - Programmed by Donald L. Foster Jr. 2023"

SCREEN _NEWIMAGE(1305, 735, 256)

_PALETTECOLOR 1, _RGB32(40, 40, 40) '  Board Color
_PALETTECOLOR 2, _RGB32(60, 60, 60) '  Board Space Color
_PALETTECOLOR 3, _RGB32(240, 140, 0) ' Player 1 Piece Orange Base Color
_PALETTECOLOR 6, _RGB32(170, 70, 0) '  Player 1 Piece Orange Arrow Color
_PALETTECOLOR 7, _RGB32(0, 90, 210) '  Player 2 Piece Blue Base Color
_PALETTECOLOR 9, _RGB32(0, 30, 150) '  Player 2 Piece Med Blue Color
_PALETTECOLOR 4, _RGB32(210, 100, 0) ' Red Game Title Color
_PALETTECOLOR 8, _RGB32(0, 130, 210) ' Blue Game Title Color

DIM AS _UNSIGNED INTEGER V, W, X, Y, Z, X1, X2, X3, X4
DIM AS _UNSIGNED _BYTE Player, Opponent, Rotation, Move, NextRotation, PreviousRotation
DIM AS _UNSIGNED _BIT Selected, CanRotateNext, CanRotatePrevious, RotatePlay, BoardSpace(6, 7), Playable(6, 7)
DIM AS _UNSIGNED _BYTE BoardPlayer(6, 7), BoardRotation(6, 7), CapturedPieces(2)
DIM AS _UNSIGNED INTEGER BoardX(6, 7), BoardY(6, 7), CapturedX(2, 10), CapturedY(2, 10), RotateX(2)

Player = 1: Opponent = 2:
CapturedPieces(1) = 0: CapturedPieces(2) = 0

' Setup Board Players
FOR Z = 1 TO 6: FOR Y = 1 TO 7: BoardSpace(Z, Y) = 1: NEXT: NEXT
BoardSpace(1, 1) = 0: BoardSpace(1, 7) = 0: BoardSpace(6, 1) = 0: BoardSpace(6, 7) = 0

' Setup Board Piece Rotations
FOR Z = 2 TO 5: BoardPlayer(Z, 1) = 1: BoardRotation(Z, 1) = 3: BoardPlayer(Z, 7) = 2: BoardRotation(Z, 7) = 7: NEXT
FOR Z = 1 TO 6: BoardPlayer(Z, 2) = 1: BoardRotation(Z, 2) = 3: BoardPlayer(Z, 6) = 2: BoardRotation(Z, 6) = 7: NEXT

' Setup Captured Pieces Storage Section
X = 350
FOR Z = 1 TO 9 STEP 2
   CapturedX(2, Z) = 923: CapturedY(2, Z) = X
   CapturedX(2, Z + 1) = 993: CapturedY(2, Z + 1) = X
   CapturedX(1, Z) = 1151: CapturedY(1, Z) = X
   CapturedX(1, Z + 1) = 1221: CapturedY(1, Z + 1) = X
   X = X + 70
NEXT

' Set Playing Piece Arrows
Arrow$(1, 1) = "C6TA0BR16TA23U40TA157U40TA115D17TA65D17TA35BU20P6,6" '    Player 1 Up Arrow
Arrow$(1, 2) = "C6TA0BR9BD12TA157D40TA23L40TA65D17TA115L17TA0BU10P6,6" '  Player 1 Up Right Arrow
Arrow$(1, 3) = "C6TA0BD16TA23R40TA157R40TA115L17TA65L17TA35BR20P6,6" '    Player 1 Right Arrow
Arrow$(1, 4) = "C6TA0BL12BD9TA157L40TA23U40TA65L17TA115U17TA0BR10P6,6" '  Player 1 Down Right Arrow
Arrow$(1, 5) = "C6TA0BL16TA23D40TA157D40TA115U17TA65U17TA35BD20P6,6" '    Player 1 Down Arrow
Arrow$(1, 6) = "C6TA0BR12BD9TA23L40TA157D40TA115L17TA65D17TA0BL10P6,6" '  Player 1 Down Left Arrow
Arrow$(1, 7) = "C6TA0BU16TA23L40TA157L40TA115R17TA65R17TA35BL20P6,6" '    Player 1 Left Arrow
Arrow$(1, 8) = "C6TA0BR10BU10TA157R40TA23D40TA65R17TA115D17TA0BL10P6,6" ' Player 1 Up Left Arrow
Arrow$(2, 1) = "C9TA0BR16TA23U40TA157U40TA115D17TA65D17TA35BU20P9,9" '    Player 2 Up Arrow
Arrow$(2, 2) = "C9TA0BR9BD12TA157D40TA23L40TA65D17TA115L17TA0BU10P9,9" '  Player 2 Up Right Arrow
Arrow$(2, 3) = "C9TA0BD16TA23R40TA157R40TA115L17TA65L17TA35BR20P9,9" '    Player 2 Right Arrow
Arrow$(2, 4) = "C9TA0BL12BD9TA157L40TA23U40TA65L17TA115U17TA0BR10P9,9" '  Player 2 Down Right Arrow
Arrow$(2, 5) = "C9TA0BL16TA23D40TA157D40TA115U17TA65U17TA35BD20P9,9" '    Player 2 Down Arrow
Arrow$(2, 6) = "C9TA0BR12BD9TA23L40TA157D40TA115L17TA65D17TA0BL10P9,9" '  Player 2 Down Left Arrow
Arrow$(2, 7) = "C9TA0BU16TA23L40TA157L40TA115R17TA65R17TA35BL20P9,9" '    Player 2 Right Arrow
Arrow$(2, 8) = "C9TA0BR10BU10TA157R40TA23D40TA65R17TA115D17TA0BL10P9,9" ' Player 2 Up Left Arrow
Arrow$(3, 1) = "C1TA0BR16TA23U40TA157U40TA115D17TA65D17TA35BU20P1,1" '    No Rotate Up Arrow
Arrow$(3, 2) = "C1TA0BR9BD12TA157D40TA23L40TA65D17TA115L17TA0BU10P1,1" '  No Rotate Up Right Arrow
Arrow$(3, 3) = "C1TA0BD16TA23R40TA157R40TA115L17TA65L17TA35BR20P1,1" '    No Rotate Right Arrow
Arrow$(3, 4) = "C1TA0BL12BD9TA157L40TA23U40TA65L17TA115U17TA0BR10P1,1" '  No Rotate Down Right Arrow
Arrow$(3, 5) = "C1TA0BL16TA23D40TA157D40TA115U17TA65U17TA35BD20P1,1" '    No Rotate Down Arrow
Arrow$(3, 6) = "C1TA0BR12BD9TA23L40TA157D40TA115L17TA65D17TA0BL10P1,1" '  No Rotate Down Left Arrow
Arrow$(3, 7) = "C1TA0BU16TA23L40TA157L40TA115R17TA65R17TA35BL20P1,1" '    No Rotate Left Arrow
Arrow$(3, 8) = "C1TA0BR10BU10TA157R40TA23D40TA65R17TA115D17TA0BL10P1,1" ' No Rotate Up Left Arrow

BoardSpace$ = "C15TA0BR33BU14U20L20TA45U20TA135U20TA0L20D20TA135U20TA225U20TA0D20R20TA225U20TA45R20TA0R20U20TA45R20U20TA0BL3P2,15"
GameTitle$ = "C15TA0BR33BU14U13L13TA45U13TA135U13TA0L13D13TA135U13TA225U13TA0D13R13TA225U13TA45R13TA0R13U13TA45R13U13TA0BL3P15,15"
CapturedPieces$ = "CAPTURED PIECES"

' Draw Board
PSET (378, 10), 15: DRAW "TA0L214TA45L218TA0D407TA45D218TA0R522TA45R218TA0U407TA45U218TA0L330BD3P1,15"

X = 80
FOR Z = 1 TO 6
   W = 80
   FOR Y = 1 TO 7
      IF BoardSpace(Z, Y) THEN PSET (W, X), 1: DRAW BoardSpace$
      IF BoardPlayer(Z, Y) THEN X1 = W: X2 = X: X3 = BoardPlayer(Z, Y): X4 = BoardRotation(Z, Y): GOSUB DrawPiece
      BoardX(Z, Y) = W: BoardY(Z, Y) = X
      W = W + 115
   NEXT
   X = X + 115
NEXT

' Draw Game Title
X = 883
FOR Z = 1 TO 6

   PSET (X, 45), 15: DRAW GameTitle$

   SELECT CASE Z
      CASE 1, 4, 6
         IF Z = 1 THEN W = 4 ELSE W = 8
         CIRCLE (X + 11, 40), 18, W: CIRCLE (X + 11, 40), 10, W: PAINT (X - 5, 40), W
      CASE 2
         CIRCLE (X + 11, 40), 18, 8, .80, 5.40: CIRCLE (X + 11, 40), 10, 8, .80, 5.25:
         PSET (X + 11, 40), 15: DRAW "C8TA45BR10R7BL17BD10D7": PAINT (X - 5, 40), 8
      CASE 3
         PSET (X + 11, 60), 4: DRAW "TA0R4U29R5E8L34F8R5D29R4BU3P4,4"
      CASE 5
         CIRCLE (X + 11, 40), 18, 4, .80, 0.25: CIRCLE (X + 11, 40), 10, 4, .80, 5.5
         PSET (X + 11, 40), 4: DRAW "TA45BR10R7BL17TA0BR17BU3L20D8R12": PAINT (X - 5, 40), 4
   END SELECT

   X = X + 71
NEXT

' Draw Captured Pieces Stoage Sections
LINE (883, 310)-(1033, 670), 1, BF: LINE (883, 310)-(1033, 670), 15, B
LINE (1111, 310)-(1261, 670), 1, BF: LINE (1111, 310)-(1261, 670), 15, B

X = 310
FOR Z = 1 TO 15
   _PRINTSTRING (1068, X), MID$(CapturedPieces$, Z, 1)
   X = X + 25
NEXT

StartGame:
Move = 1: CanRotateNext = 1: CanRotatePrevious = 1

' Draw Player Indicator
X1 = 1072: X2 = 121: X3 = Player: X4 = 1: GOSUB DrawPiece
LOCATE 8, 116: PRINT "Player:"; Player;
LOCATE 8, 146: PRINT "Move #:"; Move;

ChoosePiece:
LOCATE 45, 117: PRINT "       Choose a Piece to Play       ";

GetBoardLocation:
DO WHILE _MOUSEINPUT
   FOR Z = 1 TO 6
      FOR Y = 1 TO 7
         IF _MOUSEX > BoardX(Z, Y) - 30 AND _MOUSEX < BoardX(Z, Y) + 30 AND _MOUSEY > BoardY(Z, Y) - 30 AND _MOUSEY < BoardY(Z, Y) + 30 THEN Selected = 1 ELSE Selected = 0
         IF _MOUSEBUTTON(1) AND BoardPlayer(Z, Y) = Player AND Selected THEN
            GOSUB ReleaseButton: CIRCLE (BoardX(Z, Y), BoardY(Z, Y)), 55, 15
            Row = Z: Column = Y: Rotation = BoardRotation(Z, Y): GOTO ChoosePlay
         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 GetBoardLocation

ChoosePlay:
LOCATE 8, 146: PRINT "Move #:"; Move;

' Display Piece for Rotation
X1 = 1072: X2 = 230: X3 = Player: X4 = Rotation: GOSUB DrawPiece

' Get Next and Previous Rotations
IF Rotation = 1 THEN PreviousRotation = 8 ELSE PreviousRotation = Rotation - 1
IF Rotation = 8 THEN NextRotation = 1 ELSE NextRotation = Rotation + 1

' Display Next and Previous Piece Rotations
X = 960
FOR Z = 1 TO 2
   X1 = X: X2 = 230
   IF (Z = 1 AND CanRotatePrevious = 1) OR (Z = 2 AND CanRotateNext = 1) THEN X3 = Player ELSE X3 = 3
   IF Z = 1 THEN X4 = PreviousRotation ELSE X4 = NextRotation
   GOSUB DrawPiece: RotateX(Z) = X
   X = X + 224
NEXT

LOCATE 19, 112: PRINT "Counter Clockwise                Clockwise";

' Set Board Playable Locations to 0
FOR Z = 1 TO 6: FOR Y = 1 TO 7: Playable(Z, Y) = 0: NEXT: NEXT

' Check Playable Board Locations
X = 0
IF Move = 1 THEN Playable(Row, Column) = 1
IF Row - 1 >= 1 THEN IF BoardSpace(Row - 1, Column) AND BoardPlayer(Row - 1, Column) <> Player AND BoardRotation(Row, Column) = 1 THEN Playable(Row - 1, Column) = 1: X = 1
IF Row + 1 <= 6 THEN IF BoardSpace(Row + 1, Column) AND BoardPlayer(Row + 1, Column) <> Player AND BoardRotation(Row, Column) = 5 THEN Playable(Row + 1, Column) = 1: X = 1
IF Column - 1 >= 1 THEN IF BoardSpace(Row, Column - 1) AND BoardPlayer(Row, Column - 1) <> Player AND BoardRotation(Row, Column) = 7 THEN Playable(Row, Column - 1) = 1: X = 1
IF Column + 1 <= 7 THEN IF BoardSpace(Row, Column + 1) AND BoardPlayer(Row, Column + 1) <> Player AND BoardRotation(Row, Column) = 3 THEN Playable(Row, Column + 1) = 1: X = 1
IF Row - 1 >= 1 AND Column - 1 >= 1 THEN IF BoardSpace(Row - 1, Column - 1) AND BoardPlayer(Row - 1, Column - 1) <> Player AND BoardRotation(Row, Column) = 8 THEN Playable(Row - 1, Column - 1) = 1: X = 1
IF Row + 1 <= 6 AND Column + 1 <= 7 THEN IF BoardSpace(Row + 1, Column + 1) AND BoardPlayer(Row + 1, Column + 1) <> Player AND BoardRotation(Row, Column) = 4 THEN Playable(Row + 1, Column + 1) = 1: X = 1
IF Row - 1 >= 1 AND Column + 1 <= 7 THEN IF BoardSpace(Row - 1, Column + 1) AND BoardPlayer(Row - 1, Column + 1) <> Player AND BoardRotation(Row, Column) = 2 THEN Playable(Row - 1, Column + 1) = 1: X = 1
IF Row + 1 <= 6 AND Column - 1 >= 1 THEN IF BoardSpace(Row + 1, Column - 1) AND BoardPlayer(Row + 1, Column - 1) <> Player AND BoardRotation(Row, Column) = 6 THEN Playable(Row + 1, Column - 1) = 1: X = 1

LOCATE 45, 117: PRINT "Choose Rotation or Board Location";

GetPlayChoice:
DO WHILE _MOUSEINPUT
   ' Piece Rotation
   RotatePlay = 0
   FOR Z = 1 TO 2
      IF _MOUSEX > RotateX(Z) - 50 AND _MOUSEX < RotateX(Z) + 50 AND _MOUSEY > 180 AND _MOUSEY < 280 THEN Selected = 1 ELSE Selected = 2
      IF Selected AND ((Z = 1 AND CanRotatePrevious) OR (Z = 2 AND CanRotateNext)) THEN
         LINE (RotateX(Z) - 50, 180)-(RotateX(Z) + 50, 280), 15, B
      ELSE
         LINE (RotateX(Z) - 50, 180)-(RotateX(Z) + 50, 280), 0, B
      END IF
      IF _MOUSEBUTTON(1) AND Selected THEN
         GOSUB ReleaseButton
         ' Rotate Piece Counter Clockwise
         IF Z = 1 AND CanRotatePrevious THEN
            RotatePlay = 1: Rotation = PreviousRotation: CanRotateNext = 0: GOTO MakeMove
         END IF
         ' Rotate Piece Clockwise
         IF Z = 2 AND CanRotateNext THEN
            RotatePlay = 1: Rotation = NextRotation: CanRotatePrevious = 0: GOTO MakeMove
         END IF
      END IF
   NEXT

   ' Move Piece
   FOR Z = 1 TO 6
      FOR Y = 1 TO 7
         IF _MOUSEX > BoardX(Z, Y) - 30 AND _MOUSEX < BoardX(Z, Y) + 30 AND _MOUSEY > BoardY(Z, Y) - 30 AND _MOUSEY < BoardY(Z, Y) + 30 THEN Selected = 1 ELSE Selected = 0
         IF _MOUSEBUTTON(1) AND Playable(Z, Y) AND Selected THEN
            IF Z = Row AND Y = Column AND Move = 1 THEN CIRCLE (BoardX(Z, Y), BoardY(Z, Y)), 55, 1: LINE (880, 180)-(1234, 308), 0, BF: GOTO ChoosePiece ELSE GOTO MakeMove
         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 GetPlayChoice

MakeMove:
' Remove Piece from Board
BoardPlayer(Row, Column) = 0: BoardRotation(Row, Column) = 0
PAINT (BoardX(Row, Column), BoardY(Row, Column)), 2, 15
CIRCLE (BoardX(Row, Column), BoardY(Row, Column)), 55, 1

IF RotatePlay = 0 THEN
   ' Check for Capture
   IF BoardPlayer(Z, Y) = Opponent THEN
      PAINT (BoardX(Z, Y), BoardY(Z, Y)), 2, 15
      CapturedPieces(Opponent) = CapturedPieces(Opponent) + 1
      X1 = CapturedX(Opponent, CapturedPieces(Opponent))
      X2 = CapturedY(Opponent, CapturedPieces(Opponent))
      X3 = Opponent: IF Opponent = 1 THEN X4 = 8 ELSE X4 = 2
      GOSUB DrawPiece
   END IF
   ' Move Piece on Board
   Row = Z: Column = Y: BoardPlayer(Z, Y) = Player: BoardRotation(Z, Y) = Rotation
   X1 = BoardX(Z, Y): X2 = BoardY(Z, Y): X3 = Player: X4 = Rotation: GOSUB DrawPiece
ELSE
   ' Rotate Piece
   BoardPlayer(Row, Column) = Player: BoardRotation(Row, Column) = Rotation
   X1 = BoardX(Row, Column): X2 = BoardY(Row, Column): X3 = Player: X4 = Rotation: GOSUB DrawPiece
END IF

EndPlay:
' Remove Rotate Piece Area from View
LINE (880, 180)-(1234, 308), 0, BF

' Check for Winner
IF CapturedPieces(Opponent) = 10 GOTO Winner

IF Move = 1 THEN Move = 2: GOTO ChoosePlay

' Remove Board Position Cursor
CIRCLE (BoardX(Row, Column), BoardY(Row, Column)), 55, 1

Move = 1: SWAP Player, Opponent: GOTO StartGame

ReleaseButton:
DO WHILE _MOUSEINPUT
   IF _MOUSEBUTTON(1) = 0 THEN RETURN
LOOP
GOTO ReleaseButton

DrawPiece:
' Draw Piece Base
SELECT CASE X4
   CASE 1, 3, 5, 7
      PSET (X1, X2), 2
      IF X3 = 1 THEN DRAW "C3TA0BU42TA45L59D59R59U59TA0BD10P3,3"
      IF X3 = 2 THEN DRAW "C7TA0BU42TA45L59D59R59U59TA0BD10P7,7"
      IF X3 = 3 THEN DRAW "C2TA0BU42TA45L59D59R59U59TA0BD10P2,2"
   CASE 2, 4, 6, 8
      IF X3 = 1 THEN V = 3 ELSE IF X3 = 2 THEN V = 7 ELSE V = 2
      LINE (X1 - 30, X2 - 29)-(X1 + 28, X2 + 29), V, BF
END SELECT
' Draw Piece Arrow
PSET (X1, X2), POINT(X1, X2): DRAW Arrow$(X3, X4)
RETURN

Winner:
LOCATE 44, 123: PRINT "Player"; Player; "is the Winner!";
LOCATE 45, 117: PRINT "    Play Another Game? (Y or N)    ";

GetYorN: A$ = UCASE$(INKEY$): IF A$ = "" GOTO GetYorN
IF A$ = "Y" THEN RUN
IF A$ = "N" THEN SYSTEM
IF ASC(A$) = 27 AND FullScreen = 0 THEN FullScreen = -1: _FULLSCREEN _SQUAREPIXELS , _SMOOTH ELSE IF ASC(A$) = 27 THEN FullScreen = 0: _FULLSCREEN _OFF
GOTO GetYorN



Attached Files
.pdf   Octogo-Board-Game-Description.pdf (Size: 220.32 KB / Downloads: 87)
Print this item

  Goblin's Gold Board Game
Posted by: Donald Foster - 05-02-2023, 05:10 AM - Forum: Donald Foster - Replies (5)

This is my take on the abstract strategy board game, Goblin's Gold. I have included a description of the game and how it's played.

Hope you enjoy playing.

Donald

Goblin's Gold is a 2 to 4 player abstract strategy board game with some luck and memory.
The object of the game is to get the Wizard back to your corner of the board first.
The Wizard is placed in the center of a maze that has invisible walls. Each player, in turn, maneuvers the Wizard through the maze one step at a time. Once a player encounters a wall, that wall will appear and play goes to the next player trying to maneuver the Wizard back to their corner from that position on the maze.
Paying attention to and remembering the moves of the other players can help you guide the Wizard back through a good known path. Or you can adventure out and try a shortcut to your corner of the board.
For each move on the board, a circle will appear on the board indicating a space where the Wizard can be attempted to moved to.
Game Controls:
Keyboard to choose the number of players and pressing <ENTER>.
Keyboard to choose Y or N to play game again when has ended and press <ENTER>.
Left Mouse Button to choose space on the board to move Wizard to.


.bas   Goblin's Gold.bas (Size: 12.76 KB / Downloads: 68)

[Image: Goblins-gold.webp]


[Image: Goblins-Gold-Screenshot.png]

Print this item

  HELP! I find an issue using _DEVICES!
Posted by: TempodiBasic - 05-01-2023, 10:58 PM - Forum: Help Me! - Replies (10)

Hi QB64 coders

I was attempting to accomplish this task
detecting a joystick and its settings of  buttons/axis

using the original code I thought that I made an error in typing code. So with the goal to solve this issue of detecting a Joystick before to change its settings of _BUTTONS, I fall in this issue that you can live running this code and following these instructions:
1.  copy and paste this code into QB64 IDE
2.  take near you an USB joystick
3.  press F5 after QB64 IDE with this demo code has got the focus
4. you should get message "NO Joystick! 2   0   0    0"
5. pressing ENTER key you should get the same message on the screen
6. Plug in the USB joystick to the PC/Notebook and wait for the sound of controller connected by Windows 11
7. press 3 times ENTER Key, you should get a message "Joystick detected  3 .........." three times
8. disconnect the USB joystick and wait for the sound of controller disconnected by Windows 11
9. press ENTER key and WHAT message do you get back?

Here the code that I used

Code: (Select All)
 
ReDim Shared Ax(1 To 1) As Integer, Bx(1 To 1) As Integer, Wx(1 To 1) As Integer
ReDim Shared Axm As Integer, Bxm As Integer, Wxm As Integer
Dim Kh As Integer

Cls
Print " Press ESC to quit and Enter to detect joystick"
Print " JoyStick  Axis        Buttons      Wheels"
Print IsJoystick%, Axm, Bxm, Wxm
View Print 4 To 24
Kh = 0
While Kh <> 27
    Kh = _KeyHit
    If (Kh) = 13 Then Print IsJoystick%, Axm, Bxm, Wxm
    Locate 24, 1: Print Kh;
    _Limit 30
Wend
End

'*****************************************************************
'            JOYSTICK DETECTION
'*****************************************************************
Function IsJoystick% ()
    Dim HMD%: HMD% = HowManyDevice%

    If HMD% = 0 Then
        Print " No input devices!": End
    Else
        Locate , 1: Print HMD%
    End If

    If HMD% = 3 Then
        Locate , 4: Print "Joystick detected";
        IsJoystick% = -1
        Axm = _LastAxis(3)
        Bxm = _LastButton(3)
        Wxm = _LastWheel(3)
    Else
        ' all cases in which HMD% <>3
        Locate , 10: Print " NO Joystick!";
        IsJoystick% = 0
        Axm = 0
        Bxm = 0
        Wxm = 0
    End If
    Print HMD%, Axm, Bxm, Wxm
End Function

Function HowManyDevice%
    HowManyDevice% = 0 ' error value
    HowManyDevice% = _Devices ' value detected
End Function
'*****************************************************************
'        END Subs and Functions for JOYSTICK DETECTION
'*****************************************************************

Here my weird output


[Image: immagine-2023-05-02-004435348.png]

detection is stuck!

So please make bigger my knowledge with your feedbacks!
Where is the mistake in the code?
Thank you for your apport!

Print this item

  Graphics doodling.
Posted by: James D Jarvis - 05-01-2023, 08:50 PM - Forum: Programs - Replies (3)

Nothing all that fancy just playing doodling with code.

Twirly uses WASD and a couple other keys to alter the generated image

Code: (Select All)
'Twirly
Screen _NewImage(800, 500, 32)
ib& = _NewImage(800, 500, 32)
Dim klr As _Unsigned Long
Randomize Timer
cx = 400
cy = 250
id = 0
rtn = 0
Do
    _Limit 20
    For n = 1 To Int(1 + Rnd * 8)
        px = Int(1 + Rnd * 400) / Int(1 + Rnd * 8)
        py = Int(1 + Rnd * 250) / Int(1 + Rnd * 4)
        cd = Int(1 + Rnd * 6)
        klr = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
        Circle (cx + px, cy + py), cd, klr
        Circle (cx + px, cy - py), cd, klr
        Circle (cx - px, cy + py), cd, klr
        Circle (cx - px, cy - py), cd, klr
    Next n

    _PutImage (0, 0)-(799, 499), 0, ib&, (id, id)-(799 - id, 499 - id)
    RotoZoom_jan23 cx, cy, ib&, 1, 1, rtn

    'Do
    kk$ = InKey$
    Select Case kk$
        Case "W", "w" 'move center up
            cy = cy - 1
        Case "S", "s" 'move center down
            cy = cy + 1
        Case "A", "a" 'move center left
            cx = cx - 1
        Case "D", "d" 'move center right
            cx = cx + 1
        Case "Z", "z" 'zoom in
            id = id + 1
        Case "X", "x" 'zoom out
            id = id - 1
        Case "Q", "q" 'rotate
            rtn = rtn - 1
        Case "E", "e" 'counter-rotate
            rtn = rtn + 1
        Case "O", "o" 'return to center of screen
            rtn = 0
            id = 0
            cx = 400
            cy = 250
    End Select
    _Display
    'Loop Until kk$ <> ""
Loop Until kk$ = Chr$(27)




Sub RotoZoom_jan23 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2 * xScale: py(0) = -H& / 2 * yScale: px(1) = -W& / 2 * xScale: py(1) = H& / 2 * yScale
    px(2) = W& / 2 * xScale: py(2) = H& / 2 * yScale: px(3) = W& / 2 * xScale: py(3) = -H& / 2 * yScale
    sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub


Kzoom just started with me wondering about using rotozoom to alter an image. 
Code: (Select All)
'kzoom
Screen _NewImage(800, 500, 32)
ti& = _NewImage(800, 500, 32)
'pres esc to exit
Dim klr As _Unsigned Long
maxx = 1600
maxy = 1000
dw = 0
cx = 400
cy = 250
cdx = -1
cdy = -1
Randomize Timer
sc = 1
Window (-maxx, -maxy)-(maxx, maxy)
Do
    _Limit 8000
    px = Int(Rnd * 200)
    py = Int(Rnd * 200)
    klr = _RGB32(rr, gg, bb)
    rr = rr + 1
    If rr = 256 Then
        rr = Int(Rnd * 32)
        gg = gg + 1
    End If
    If gg = 256 Then
        gg = Int(Rnd * 32)
        bb = bb + 1
    End If
    If bb = 256 Then bb = Int(Rnd * 32)
    PSet (px, py), klr
    PSet (-px, py), klr
    PSet (-px, -py), klr
    PSet (px, -py), klr
    ' If Rnd * 10000 < 2 Then
    'd = Int(Rnd * maxy)
    'Circle (px, py), d, klr
    'Circle (-px, py), d, klr
    ' Circle (px, -py), d, klr
    'Circle (-px, -py), d, klr
    'End If

    c = c + 1
    If c = 2 Then
        ox = maxx - 4
        oy = maxy - 4
        Select Case dw
            Case 0
                maxx = maxx - 1
                maxy = maxy - 1
                If maxy < 10 Then dw = 1
            Case 1
                maxx = maxx + 1
                maxy = maxy + 1
                If maxy > 10000 Then dw = 0

        End Select
        Window (-maxx, -maxy)-(maxx, maxy)
        _PutImage , 0, ti&, (-ox, -oy)-(ox, oy)
        c = 0
    End If
    rc = rc + 1
    If rc = 1000 Then
        rot = rot + .1
        If rot > 1440 Then rot = 0
        rc = 0
        _PutImage , 0, ti&
        RotoZoom23d cx, cy, ti&, sc, sc, rot
        sc = sc * 1.001
        If sc > 4 Then sc = 1
        cx = cx + .01 * cdx
        cy = cy + .01 * cdy
        If Rnd * 8 < 2 Then cdx = cdx * -1
        If Rnd * 8 < 2 Then cdy = cdy * -1
    End If
    _Display
    ' If Rnd * 9000 < 1 Then Line (0, 0)-(maxx, Int(Rnd * maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    'If Rnd * 9000 < 1 Then Line (0, 0)-(maxx, Int(Rnd * -maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    'If Rnd * 9000 < 1 Then Line (0, 0)-(-maxx, Int(Rnd * -maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    ' If Rnd * 9000 < 1 Then Line (0, 0)-(-maxx, Int(Rnd * maxy)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    kk$ = InKey$

Loop Until kk$ = Chr$(27)



Sub RotoZoom23d (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    Wi& = _Width(Image&): Hi& = _Height(Image&)
    W& = Wi& / 2 * xScale
    H& = Hi& / 2 * yScale
    px(0) = -W&: py(0) = -H&: px(1) = -W&: py(1) = H&
    px(2) = W&: py(2) = H&: px(3) = W&: py(3) = -H&
    sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    '_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    ' _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))


    _MapTriangle (0, 0)-(0, Hi& - 1)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(Wi& - 1, 0)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

Print this item

  Reverse INSTR ?
Posted by: TerryRitchie - 05-01-2023, 05:19 AM - Forum: Help Me! - Replies (4)

I could have swore I saw a post a while back stating that a reverse INSTR command was either introduced or someone created one but I am having no luck searching for it.

InStrRev (from VB) was quite handy and I find myself needing a QB64 equivalent.

Am I hallucinating? Is my age starting to show? Does anyone else remember this post?

-------- THERE IT IS ----------

UPDATE: I was just about to post this but decided one last time to search the Wiki using the VB name INSTRREV and there it was! The INSTR page in the Wiki makes no mention of INSTRREV. searching for INSTR in the Wiki takes you to the INSTR page with no way of seeing that INSTRREV exists.

Print this item

  Keyboard scancodes.
Posted by: eoredson - 04-30-2023, 05:23 AM - Forum: Help Me! - Replies (2)

Hi,

I have been using the following keyboard scancodes for awhile, but I can't get it to detect Ctrl-Alt-Delete at all:

Code: (Select All)
Print "Test keyboard scancodes. Press <Esc> to quit"

On Timer(1) CtrlBreak
Timer On
x = _Exit

Const KEY_RSHIFT& = 100303
Const KEY_LSHIFT& = 100304

Const KEY_RCTRL& = 100305
Const KEY_LCTRL& = 100306

Const KEY_RALT& = 100307
Const KEY_LALT& = 100308

Do
    _Limit 100
    x& = _KeyHit
    If x& > 0 Then
        If x& = KEY_RALT& Then
            Print "Right-Alt-"
        End If
        If x& = KEY_LALT& Then
            Print "Left-Alt-"
        End If
        If x& = KEY_RSHIFT& Then
            Print "Right-Shift-"
        End If
        If x& = KEY_LSHIFT& Then
            Print "Left-Shift-"
        End If
        If x& = KEY_RCTRL& Then
            Print "Right-Ctrl-"
        End If
        If x& = KEY_LCTRL& Then
            Print "Left-Ctrl-"
        End If
    End If
    If x& < 0 Then
        Select Case x&
            Case -12
                Print "Keypad-5"
            Case -108
                Print "Ctrl-KeyPad-5"
            Case -20
                Print "Caps lock"
            Case -144
                Print "Num lock"
            Case -145
                Print "Scroll lock"
            Case -44
                Print "Print-Screen"
                'Case Else
                '    Print x&
        End Select
    End If
    x$ = InKey$
    If Len(x$) Then
        If x$ = Chr$(27) Then
            Exit Do
        Else
            If Len(x$) = 2 Then
                Print Asc(Right$(x$, 1))
            Else
                Print Asc(x$)
            End If
        End If
    End If
Loop
Timer Off
End

Sub CtrlBreak
    x = _Exit
    If x Then
        Print "Ctrl-Break"
    End If
End Sub

Print this item

  BAM: PUTSTRING prototyping
Posted by: CharlieJV - 04-29-2023, 09:56 PM - Forum: QBJS, BAM, and Other BASICs - Replies (11)

I had a wee bug in my first prototype, and since I'm planning on doing all kinds of prototyping as I plan out an include library for the thing, I figured best to aggregate developments in one thread.


The fundamental PUTSTRING feature to graphically position a string on the screen:



The PUTSTRING feature to "roll/unroll" a single character in one or more simultaneous directions (right, left, down, up; each in amounts of between 1 and 7 pixels), graphically positioned on the screen:

Print this item

  BAM: _LETCHR$ and _GETCHR$
Posted by: CharlieJV - 04-28-2023, 01:40 AM - Forum: QBJS, BAM, and Other BASICs - Replies (16)

Print this item

  C file functions in QB64 ???
Posted by: Jack - 04-26-2023, 11:00 AM - Forum: Help Me! - Replies (11)

I wonder if it's possible to get the C file functions working in QB64, specifically fopen, fprintf and fclose
I tried the following but it won't compile

Code: (Select All)
Type iobuf
    ptr As _Offset 'zstring ptr
    cnt As Long
    bas As _Offset 'zstring ptr
    flag As Long
    file As Long
    charbuf As Long
    bufsiz As Long
    tmpfname As _Offset 'zstring ptr
End Type

Declare Library
    Function fopen%& (file_name As String, mode As String)
    Function fclose& (file_ptr As _Offset)
    Function fprintf& (file_ptr As _Offset, frmt As String, st As String)
End Declare

Dim As _Offset fp
Dim As String fln, md, frmt, text
Dim As Long status

fln = "fopen-test.txt" + Chr$(0)
md = "w" + Chr$(0)
frmt = "%s\n" + Chr$(0)
text = "hello world" + Chr$(0)

fp = fopen(fln, md)
status = fprintf(fp, frmt, text)
Print "status = fprintf(fp, frmt, text) = "; status
status = fclose(fp)

the compiler log follows
Quote:internal\c\c_compiler\bin\c++.exe -O2 -w -std=gnu++11 -DGLEW_STATIC -DFREEGLUT_STATIC -Iinternal\c\libqb/include -Iinternal\c/parts/core/src/ -Iinternal\c/parts/core/glew/include/ -DDEPENDENCY_NO_SOCKETS -DDEPENDENCY_NO_PRINTER -DDEPENDENCY_NO_ICON -DDEPENDENCY_NO_SCREENIMAGE internal\c/qbx.cpp -c -o internal\c/qbx.o
In file included from internal\c/qbx.cpp:2333:
internal\c/../temp/main.txt: In function 'void QBMAIN(void*)':
internal\c/../temp/main.txt:29:35: error: cannot convert 'intptr_t*' {aka 'long long int*'} to 'FILE*' {aka '_iobuf*'}
  29 | *__LONG_STATUS=(  int32  )fprintf(__OFFSET_FP,(char*)(__STRING_FRMT)->chr,(char*)(__STRING_TEXT)->chr);
      |                                  ^~~~~~~~~~~
      |                                  |
      |                                  intptr_t* {aka long long int*}
In file included from internal\c\libqb/include/audio.h:21,
                from internal\c/qbx.cpp:1:
D:/QB64pe-3.6.0+/internal/c/c_compiler/x86_64-w64-mingw32/include/stdio.h:357:20: note:  initializing argument 1 of 'int fprintf(FILE*, const char*, ...)'
  357 | int fprintf (FILE *__stream, const char *__format, ...)
      |              ~~~~~~^~~~~~~~
internal\c/../temp/main.txt:48:34: error: cannot convert 'intptr_t*' {aka 'long long int*'} to 'FILE*' {aka '_iobuf*'}
  48 | *__LONG_STATUS=(  int32  )fclose(__OFFSET_FP);
      |                                  ^~~~~~~~~~~
      |                                  |
      |                                  intptr_t* {aka long long int*}
D:/QB64pe-3.6.0+/internal/c/c_compiler/x86_64-w64-mingw32/include/stdio.h:615:28: note:  initializing argument 1 of 'int fclose(FILE*)'
  615 |  int __cdecl fclose(FILE *_File);
      |                      ~~~~~~^~~~~
mingw32-make: *** [Makefile:410: internal\c/qbx.o] Error 1

I know that QB64 has file functions but I have a reason to want the C file functions

<edit>
fopen works, it's the other two functions that fail

Print this item

  Can't start QB64PE 3.6.0 more than once.
Posted by: Fifi - 04-25-2023, 11:50 PM - Forum: General Discussion - Replies (4)

Hello all,
Sorry but I've been away for a while and I'm locked with an old problem with QBPE64 3.6.0 that I just installed on a baremetal Acer Notebook.
After the installation, QB64PE starts normally and I can change the size of the IDE.
However, if I quit QB64PE then restart it later, I always get the following error message box:
 
Internal IDE Error
(module: ide_methods, on line: 18218)
< OK>

However, I can't even click on the OK button and I've only to quit QB64PE and I can't use it anymore.

I know this is an old problem and that it was solved when removing a configuration file but I can't remember what file it is and where it's located.

TIA for your help.
Cheers
Fifi

Print this item