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)
' 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
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
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
' 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
' 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
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
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.
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
detection is stuck!
So please make bigger my knowledge with your feedbacks!
Where is the mistake in the code?
Thank you for your apport!
'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)
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$
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.
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
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:
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
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.