I have this snippet to get the number of processor cores.
Problem is that the SHELL command produces a unicode text file and LINE INPUT is not able to read the text correctly.
Manually converting tmp.txt to an ascii file solves the problem.
Question is why is the file created as unicode by default?
Can I influence this from within QB64?
OS is Win 11.
Btw.: I tried also OPEN ... FOR BINARY - doesn't change anything (e.g. LINE INPUT still can't read UNICODE as text):
Code: (Select All)
returncode% = SHELL("wmic cpu get NumberOfCores >tmp.txt")
IF _FILEEXISTS("tmp.txt") THEN
OPEN "tmp.txt" FOR INPUT AS #1
DO UNTIL EOF(1)
LINE INPUT #1, a$
?">";a$;"<";filecount%;",len=";len(a$)
filecount% = filecount% + 1
LOOP
CLOSE #1
END IF
#315, #319, #327 - Implemented a new "Code Export" feature reachable via the "File" menu. - @RhoSigma-QB64
Useful for authors of tutorials, documentations or Wiki pages, they can now easily export the currently edited code and insert it in their work. The code is highlighted according to the currently chosen color scheme in the IDE and the keywords are linked to its respective Wiki pages.
Export is possible as Hypertext (.html), Rich Text (.rtf) or Wiki encoded text (.txt).
If Declare Library is in an '$include'd file, then it can also find header files that are relative to the location of the '$include'd file rather than the original source file.
Bug Fixes
#319 - Fixed the "Update All Pages" process in the IDE. - @RhoSigma-QB64
Creation/renaming/deletion of new/old Wiki pages shouldn't break the update process, but instead reflect the made changes in the local help too.
Going back through some of my coding I found I've used Else and If where I perhaps should have used ELSEIF. It seemed to work out ok but I'm not sure if there is difference in how these two work together.
For example
If ..... then
....
....
...Else
... if .. then
...
...
Else
......
......
End if
V's
If ... then
....
....
ElseIF .... then
.....
....
Else
....
End If
The logic flow would suggest there is no difference.
I know how much time and effort there has been in discussing sorting algorithms,
but I wanted to post this program that tests 6 different sorting subroutines and their timings.
Glad to share one practical etude written entirely in QB64 - Schizandra - an open-source 100% FREE GUI tool for Linux/Windows. The attached file contains the sourcecode and the binaries, as for the 44GB file, it is to be shared when I find hosting... maybe later this week.
Whenever the need for checking some word spelling (or derivatives i.e. sister-words) arises then Schizandra comes in handy as ... first line of defense.
Recently, I bought the cutest computer ever - 4 cores/threads, FANLESS, 8GB DDR4 2400Mhz, nvme SSD. It is excellent for off-line usage, trumping tablets and such with its power and miniaturistic/ergonomic design.
Basically, one can make quick searches into 45 mainstay corpora (put under one roof and sorted, thus each word is within its eventual cluster).
Didn't make the wildcard/fuzzy functionality since this revision is initial, it is as simple as possible.
Love that simplistic format, it will be used for other similar GUI utilities.
Featuring:
- 881,283,514 distinct English words;
- using 8x16 and 16x32 state-of-the-art Japanese fonts;
- always dealing with 152x40 characters (in modes below 2K using 8x16 font, in modes 2K+ it uses 16x32 font);
- easy on the eyes;
- works on old laptops (as my Thinkpad 11e called 'Djudjeto') with HD resolution i.e. 1366x768.
Code: (Select All)
README.TXT
Schizandra quick overview
This is the initial release of the HUGEST English wordlist lookuperess :P
Many a corpus are included, see the .PDF file.
Just run the elf/exe on Linux/Windows.
Enfun!
2023-May-03,
Sanmayce
P.S.
My main email is no longer functional, the new one is sanmayce@yahoo.com
As always, I am open for suggestions, new functionalities and critiques.
Ok, I know that the size of the mantissa of double is 53 bits, see if you can guess what values will be printed by this snippet
Code: (Select All)
Dim As Double x
x = 9007199254740992 ' 2^53
Print x
x = x + 1#
Print x
x = x + 1#
Print x
Print "================="
x = 9007199254740998
Print x
x = x + 1#
Print x
x = x + 1#
Print x
Print "================="
x = 9999999999999998
Print x
x = x + 1#
Print x
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$
![[Image: Goblins-gold.webp]](https://i.ibb.co/pfpXy02/Goblins-gold.webp)
![[Image: Goblins-Gold-Screenshot.png]](https://i.ibb.co/vXpbDk1/Goblins-Gold-Screenshot.png)
![[Image: immagine-2023-05-02-004435348.png]](https://i.ibb.co/SvQZwxP/immagine-2023-05-02-004435348.png)
