So while making some routines into libraries we have this common problem when arrays are involved, which is...

How to use an array in the main or calling routine without having to stick a REDIM a$(0) in that routine.

In other words say we need a$() in the calling routine and the library we are going to add for that routine like a mouse routine.

Main:
mouse x, y, a$()

Sub mouse (x, y, a$())
    Static initiate
    If initiate = 0 Then
        initiate = 1
        ReDim a$(_Height)
    End If
End Sub

Now this will fail with a Duplicate Definition error, because a$() is being introduced as an array to be passed into the mouse sub, and therefore it must be initially defined in that calling routine, before it is passed.

So we have this, which will work...

Main:
ReDim a$(0)
mouse x, y, a$()

Sub mouse (x, y, a$())
    Static initiate
    If initiate = 0 Then
        initiate = 1
        ReDim a$(_Height)
    End If
End Sub

...but we have to remember when we make the mouse routine part into a library, and use INCLUDE to add it to the main program, we also must remember it manually add the Redim() code in the calling procedure or make a companion library bi file that needs to also be included to add the needed Redim() statement in the main.

So am I missing any other library making alternatives here? If not, I feel a bit more compelled to just work with Shared arrays in a bi file, instead of passing them at all.

Pete

To help us all keep up with the changes in QB64PE we have created this page:
https://qb64phoenix.com/qb64wiki/index.p...d_Versions
(page also accessible from the Wiki Main page -> Keyword References -> Other section)

For every released version in GitHub, there is a release page which explains what is new. You may have seen this information before. But what you might not know is that @RhoSigma and the rest of the team maintain the wiki each time new things are added, changed, etc. and it can be hard to keep track of everything.

This new page centralizes the change logs in one spot, allowing you to do a full text search in the wiki for the version number vX.y.z which the wiki mentions explicitly when versions are relevant to a change/addition/fix, as well as the GitHub release itself through the version tag, which contains the developers journal of what happened for that release.

Now there is one spot to check for new things.

It might be fun for everyone to go through the list just to see what's new, improved, etc.

For example, @SierraKen didn't realize the SOUND keyword had more waveforms now, and now that he does know he integrated that feature into his new MouseTank game.

Huge thanks to @RhoSigma for maintaining this wiki the way he has which has made this possible - thank you for your service!

no literally thats all you can do in this code! for now anyway.

Now with interactions. (well a few at the moment)
Now with collisions!
Using a NEW MFI file!


Arrow keys - to move. Only the four main directions, as that's all the character sprites I have(might make diagonal ones... )
Shift keys - to run! Holding down shift goes from walking to running.
Spacebar - exit popup window
ESC -  to quit(outside of popup window)
Enter key - to interact with some objects.

and the world STILL just goes on and on and on and on...................

TYPE World_data

ID AS _BYTE

END TYPE



TYPE Character_data

X AS _UNSIGNED _BYTE

Y AS _UNSIGNED _BYTE

Direction AS _BYTE

Act AS _BYTE

END TYPE



TYPE Game

Event AS _BYTE

END TYPE



DIM SHARED World_Map(255, 255) AS World_data, P AS Character_data

DIM SHARED World_Sprite(255, 255) AS World_data, G AS Game, M$(64)

DIM SHARED Layer(16) AS LONG

CONST Default_Key_Right = 19712, Default_Key_Left = 19200, Default_Key_Up = 18432, Default_Key_Down = 20480

CONST Default_Key_RShift = 100303, Default_Key_LShift = 100304

CONST MOVING = -1: IDLE = 0

CONST TRUE = -1, FALSE = NOT TRUE

'Events

CONST Fire_Event = 1, InterAct_Event = 2, Action_Fail = 3, Treasure_Event = 4, NPC_Event = 5, Gross_Event = 6



SCREEN _NEWIMAGE(800, 600, 32)

Layer(0) = _DISPLAY

Layer(1) = _COPYIMAGE(_DISPLAY)

Layer(2) = _NEWIMAGE(32 * 24, 32 * 24, 32)

'Layer(3) = _LOADIMAGE("testtileset3.bmp", 32)

'Layer(4) = _LOADIMAGE("character_greenhair.bmp", 32)

Layer(5) = _COPYIMAGE(Layer(2))

'Layer(6) = _LOADIMAGE("popupwindow.bmp", 32)

'Layer(7) = _LOADIMAGE("cruknight_dead.bmp", 32)



MFI_Loader "InfWorld.MFI"



_CLEARCOLOR _RGB32(0), Layer(4)

_CLEARCOLOR _RGB32(225, 0, 126), Layer(3)

_CLEARCOLOR _RGB32(34, 34, 35), Layer(3)

_SETALPHA 128, , Layer(6)

_CLEARCOLOR _RGB32(0), Layer(6)

_CLEARCOLOR _RGB32(255), Layer(7)



_PRINTMODE _KEEPBACKGROUND



World_Map(2, 2).ID = 63

World_Sprite(255, 255).ID = 1 'fire(anim)

World_Sprite(5, 25).ID = 2 'Treasure

World_Sprite(25, 10).ID = 3 'Corpse



M$(0) = "OUCH!"

M$(1) = "I'm not ready to be cremated yet!"

M$(2) = "Press SpaceBar"

M$(3) = "HMMMMM...."

M$(4) = "There is nothing I can do with that."

M$(5) = "OOOooo SHINY!"

M$(6) = "I have found some treasure on the Ground!"

M$(7) = "EXCUSE ME!?"

M$(8) = "DISTGUSTING!"

M$(9) = "This guy has been here a while. Nothing"

M$(10) = "to do but get away from the smell!"

UpDate_MapLayer

ClearLayerT Layer(5)



DO

IF _KEYDOWN(Default_Key_Down) AND (Player_Screen_X%% = 0) THEN P.Direction = 0

IF _KEYDOWN(Default_Key_Left) AND (Player_Screen_Y%% = 0) THEN P.Direction = 1

IF _KEYDOWN(Default_Key_Right) AND (Player_Screen_Y%% = 0) THEN P.Direction = 2

IF _KEYDOWN(Default_Key_Up) AND (Player_Screen_X%% = 0) THEN P.Direction = 3



IF _KEYDOWN(Default_Key_Down) OR _KEYDOWN(Default_Key_Left) OR _KEYDOWN(Default_Key_Right) OR _KEYDOWN(Default_Key_Up) THEN P.Act = MOVING ELSE P.Act = IDLE

IF _KEYDOWN(Default_Key_RShift) OR _KEYDOWN(Default_Key_LShift) THEN Speed%% = 2 ELSE Speed%% = 1



IF P.Act = MOVING THEN IF Collision THEN P.Act = IDLE

IF _KEYDOWN(13) THEN G.Event = InterAct_Event: P.Act = IDLE



IF P.Act = MOVING OR Player_Screen_Y%% <> 0 OR Player_Screen_X%% <> 0 THEN

  SELECT CASE P.Direction

  CASE 0

    Player_Screen_Y%% = Player_Screen_Y%% + Speed%%

  CASE 1

    Player_Screen_X%% = Player_Screen_X%% - Speed%%

  CASE 2

    Player_Screen_X%% = Player_Screen_X%% + Speed%%

  CASE 3

    Player_Screen_Y%% = Player_Screen_Y%% - Speed%%

  END SELECT

END IF

IF Player_Screen_Y%% >= (32 + Speed%%) THEN P.Y = P.Y + 1: Player_Screen_Y%% = 0: UpDate_MapLayer

IF Player_Screen_Y%% <= (-32 - Speed%%) THEN P.Y = P.Y - 1: Player_Screen_Y%% = 0: UpDate_MapLayer

IF Player_Screen_X%% <= (-32 - Speed%%) THEN P.X = P.X - 1: Player_Screen_X%% = 0: UpDate_MapLayer

IF Player_Screen_X%% >= (32 + Speed%%) THEN P.X = P.X + 1: Player_Screen_X%% = 0: UpDate_MapLayer



Run_Sprite_Layer



_PUTIMAGE (7, 7)-STEP(567, 567), Layer(2), Layer(1), (64 + Player_Screen_X%%, 64 + Player_Screen_Y%%)-STEP(567, 567)

_PUTIMAGE (7, 7)-STEP(567, 567), Layer(5), Layer(1), (64 + Player_Screen_X%%, 64 + Player_Screen_Y%%)-STEP(567, 567)



_PUTIMAGE (289, 264)-STEP(39, 51), Layer(4), Layer(1), (0 + 21 * frame%%, 0 + 27 * P.Direction)-STEP(19, 25)



_PRINTSTRING (600, 0), STR$(Player_Screen_Y%%), Layer(1)

_PRINTSTRING (600, 18), STR$(Player_Screen_X%%), Layer(1)

_PRINTSTRING (600, 36), STR$(P.X), Layer(1)

_PRINTSTRING (600, 54), STR$(P.Y), Layer(1)

_PRINTSTRING (600, 72), STR$(G.Event), Layer(1)



_PUTIMAGE , Layer(1), Layer(0)

IF G.Event THEN Run_Event_Handler: P.Act = IDLE

ClearLayer Layer(1)

ClearLayerT Layer(5)

IF P.Act = MOVING OR Player_Screen_Y%% <> 0 OR Player_Screen_X%% <> 0 THEN Fc%% = Fc%% + Speed%% ELSE frame%% = 0

IF Fc%% >= 16 THEN frame%% = frame%% + 1: Fc%% = 0

IF frame%% = 8 THEN frame%% = 0



_LIMIT 60

LOOP UNTIL INKEY$ = CHR$(27)



'SCREEN Layer(2)

'LINE (64 + Player_Screen_X%%, 64 + Player_Screen_Y%%)-STEP(567, 567), _RGB32(255, 0, 0), B



SUB Place_Tile (ID_tag AS _BYTE, X AS INTEGER, Y AS INTEGER)

SELECT CASE ID_tag

  CASE 0 'grass default

  _PUTIMAGE (X, Y)-STEP(31, 31), Layer(3), Layer(2), (114, 66)-STEP(15, 15)

  CASE 63 'small crystal

  _PUTIMAGE (X, Y)-STEP(31, 31), Layer(3), Layer(2), (114, 66)-STEP(15, 15)

  _PUTIMAGE (X, Y)-STEP(31, 31), Layer(3), Layer(2), (788, 146)-STEP(15, 15)

END SELECT

END SUB



SUB Place_Sprites (ID_tag AS _BYTE, X AS INTEGER, Y AS INTEGER)

STATIC Fire AS _BYTE, Fire_Frame AS _BYTE

SELECT CASE ID_tag

  CASE 1 'Fire Sprite

  _PUTIMAGE (X, Y - 16)-STEP(31, 31), Layer(3), Layer(5), (66, 66 + 16 * Fire)-STEP(15, 15)

  CASE 2 'treasure

  _PUTIMAGE (X, Y - 16)-STEP(31, 31), Layer(3), Layer(5), (338, 162)-STEP(15, 15)

  CASE 3 'corpse (need to fix layer when finished

  _PUTIMAGE (X, Y - 16)-STEP(39, 43), Layer(7), Layer(5), (0, 0)-STEP(19, 21)



END SELECT

Fire_Frame = Fire_Frame + 1

IF Fire_Frame = 8 THEN Fire = Fire + 1: Fire_Frame = 0

IF Fire = 4 THEN Fire = 0

END SUB



SUB UpDate_MapLayer

ClearLayer Layer(2)

FOR x%% = 0 TO 21

  FOR y%% = 0 TO 21

  PX~%% = x%% + P.X - 11

  py~%% = y%% + P.Y - 11

  Place_Tile World_Map(PX~%%, py~%%).ID, x%% * 32, y%% * 32

  '_PRINTSTRING (x%% * 32, y%% * 32), HEX$(PX~%%) + HEX$(py~%%), Layer(2)

  NEXT

NEXT

END SUB



SUB Run_Sprite_Layer

FOR x%% = 0 TO 21

  FOR y%% = 0 TO 21

  PX~%% = x%% + P.X - 11

  py~%% = y%% + P.Y - 11

  IF World_Sprite(PX~%%, py~%%).ID THEN Place_Sprites World_Sprite(PX~%%, py~%%).ID, x%% * 32, y%% * 32

  NEXT

NEXT

END SUB







FUNCTION Collision%% ()

Result%% = FALSE 'no collision

SELECT CASE P.Direction

  CASE 0

  PY~%% = P.Y + 1

  IF World_Map(P.X, PY~%%).ID <> 0 THEN Result%% = TRUE 'collision detected with world object

  IF World_Sprite(P.X, PY~%%).ID <> 0 THEN Result%% = TRUE: G.Event = TRUE 'collision detected with sprite object

  CASE 1

  PX~%% = P.X - 1

  IF World_Map(PX~%%, P.Y).ID <> 0 THEN Result%% = TRUE 'collision detected with world object

  IF World_Sprite(PX~%%, P.Y).ID <> 0 THEN Result%% = TRUE: G.Event = TRUE 'collision detected with sprite object

  CASE 2

  PX~%% = P.X + 1

  IF World_Map(PX~%%, P.Y).ID <> 0 THEN Result%% = TRUE 'collision detected with world object

  IF World_Sprite(PX~%%, P.Y).ID <> 0 THEN Result%% = TRUE: G.Event = TRUE 'collision detected with sprite object

  CASE 3

  PY~%% = P.Y - 1

  IF World_Map(P.X, PY~%%).ID <> 0 THEN Result%% = TRUE 'collision detected with world object

  IF World_Sprite(P.X, PY~%%).ID <> 0 THEN Result%% = TRUE: G.Event = TRUE 'collision detected with sprite object

END SELECT

Collision = Result%%

END FUNCTION



SUB ClearLayer (L&)

old& = _DEST

_DEST L&

CLS ' ,0

_DEST old&

END SUB



SUB ClearLayerT (L&)

old& = _DEST

_DEST L&

CLS , 0

_DEST old&

END SUB



SUB Run_Event_Handler

SELECT CASE P.Direction 'get the sprite id that player touched

  CASE 0

  PY~%% = P.Y + 1

  PX~%% = P.X

  Id%% = World_Sprite(P.X, PY~%%).ID

  Id2%% = World_Map(P.X, PY~%%).ID

  CASE 1

  PX~%% = P.X - 1

  PY~%% = P.Y

  Id%% = World_Sprite(PX~%%, P.Y).ID

  Id2%% = World_Map(PX~%%, P.Y).ID

  CASE 2

  PX~%% = P.X + 1

  PY~%% = P.Y

  Id%% = World_Sprite(PX~%%, P.Y).ID

  Id2%% = World_Map(PX~%%, P.Y).ID

  CASE 3

  PY~%% = P.Y - 1

  PX~%% = P.X

  Id%% = World_Sprite(P.X, PY~%%).ID

  Id2%% = World_Map(P.X, PY~%%).ID

END SELECT

IF G.Event = TRUE THEN

  SELECT CASE Id%%

  CASE Fire_Event 'Fire HOT!

    Popup_Message_Window Fire_Event

  CASE 2 ' treasure

    Popup_Message_Window Treasure_Event

    World_Sprite(PX~%%, PY~%%).ID = 0 'remove treasure

  CASE 3 'corpse

    Popup_Message_Window Gross_Event

  END SELECT

ELSEIF G.Event = InterAct_Event THEN

  SELECT CASE Id2%%

  CASE 63 'crystal

    Popup_Message_Window Action_Fail

  END SELECT

END IF



END SUB



SUB Popup_Message_Window (Message%%)

_PUTIMAGE (300 - (376 / 2), 32), Layer(6), Layer(0)



_PRINTSTRING (600, 90), STR$(Message%%), Layer(0)



SELECT CASE Message%%

  CASE Fire_Event

  COLOR _RGB32(0)

  _PRINTSTRING (300 - 8 * LEN(M$(0)) \ 2, 54), M$(0)

  COLOR _RGB32(255)

  _PRINTSTRING (300 - 8 * LEN(M$(1)) \ 2, 96), M$(1)

  COLOR _RGB32(212)

  _PRINTSTRING (300 - 8 * LEN(M$(2)) \ 2, 192), M$(2)

  CASE Action_Fail

  COLOR _RGB32(0)

  _PRINTSTRING (300 - 8 * LEN(M$(3)) \ 2, 54), M$(3)

  COLOR _RGB32(255)

  _PRINTSTRING (300 - 8 * LEN(M$(4)) \ 2, 96), M$(4)

  COLOR _RGB32(212)

  _PRINTSTRING (300 - 8 * LEN(M$(2)) \ 2, 192), M$(2)

  CASE Treasure_Event

  COLOR _RGB32(0)

  _PRINTSTRING (300 - 8 * LEN(M$(5)) \ 2, 54), M$(5)

  COLOR _RGB32(255)

  _PRINTSTRING (300 - 8 * LEN(M$(6)) \ 2, 96), M$(6)

  COLOR _RGB32(212)

  _PRINTSTRING (300 - 8 * LEN(M$(2)) \ 2, 192), M$(2)

  CASE Gross_Event

  COLOR _RGB32(0)

  _PRINTSTRING (300 - 8 * LEN(M$(8)) \ 2, 54), M$(8)

  COLOR _RGB32(255)

  _PRINTSTRING (300 - 8 * LEN(M$(9)) \ 2, 96), M$(9)

  _PRINTSTRING (300 - 8 * LEN(M$(10)) \ 2, 112), M$(10)

  COLOR _RGB32(212)

  _PRINTSTRING (300 - 8 * LEN(M$(2)) \ 2, 192), M$(2)



END SELECT

DO: LOOP UNTIL _KEYDOWN(32)

_KEYCLEAR

G.Event = FALSE

END SUB



SUB MFI_Loader (FN$)

DIM Size(128) AS LONG, FOffset(128) AS LONG

OPEN FN$ FOR BINARY AS #1

GET #1, , c~%% 'retrieve number of files

FOR I~%% = 1 TO c~%%

  GET #1, , FOffset(I~%%)

  GET #1, , Size(I~%%)

  FOffset&(I~%%) = FOffset&(I~%%) + 1

NEXT I~%%

'Adjust window,add title, and show music volume warning while finishing loading

_SCREENMOVE 10, 10

_TITLE "'Infinate World' UniKorn ProDucKions 2025"

_KEYCLEAR

Layer(4) = LoadGFX(FOffset(1), Size(1)) '

Layer(3) = LoadGFX(FOffset(2), Size(2)) '

Layer(6) = LoadGFX(FOffset(3), Size(3)) '

Layer(7) = LoadGFX(FOffset(4), Size(4)) '

CLOSE #1

IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"

END SUB





FUNCTION LoadGFX& (Foff&, Size&)

IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"

OPEN "temp.dat" FOR BINARY AS #3

dat$ = SPACE$(Size&)

GET #1, Foff&, dat$

PUT #3, , dat$

CLOSE #3

LoadGFX& = _LOADIMAGE("temp.dat", 32)

END FUNCTION

Attached Files

  InfWorld.MFI (Size: 386.67 KB / Downloads: 37)

One of my most useful little ten minute programs that I've came up with for a while, though this is for Windows Only:

Dim WinMse As POINTAPI

Type POINTAPI: As Long X_Pos, Y_Pos: End Type



Declare Dynamic Library "User32"

    Function GetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long)

    Function SetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)

    Function GetAsyncKeyState% (ByVal vkey As Long)

    Function GetCursorPos (lpPoint As POINTAPI)

End Declare

Width 12, 1 'large enough to hold our color value in hex

GWL_STYLE = -16

ws_border = &H800000

WS_VISIBLE = &H10000000

_Title "Color Picker"

hwnd& = _WindowHandle

winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)

_Delay .2

a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& And WS_VISIBLE)



Color 15

Do

    _Limit 30

    z = GetCursorPos(WinMse)

    _ScreenMove WinMse.X_Pos + 1, WinMse.Y_Pos + 1

    tempimage = _ScreenImage

    Cls , 0

    _Source tempimage: Print Hex$(Point(WinMse.X_Pos, WinMse.Y_Pos));: _Source 0

    _FreeImage tempimage

    _Display

Loop Until GetAsyncKeyState(1) Or GetAsyncKeyState(2) Or GetAsyncKeyState(27)

System

No shooting please!

_Title "Return of the Cheese Chewer(s) by bplus 2018-08-06"

' QB64 X 64 version 1.2 20180228/86  from git b301f92



' 2018-07-13 eRATication - modified from Asteroids game

' 2018-07-15 eRATication 2

' color rats, eliminate jerks when kill rat,

' decrease rat size as life progresses

' 2018-07-15 some minor changes since post of e #2

' 2018-07-20 eRATication 3

' Shooter: location controlled by mouse

'          mouse left and right button works like left and right arrow keys.

' Code: use type for objects, simplify math where possible

'       complete makeover of code.

'       Fixed problem of running into burning rat.

' Display: Life # and Points on screen as Fellippe suggested.

' Points: should be directly proportional to rat's speed and indirectly

'          proportional to size, so speed\size!

'          but compare that to number of shots taken!



'2018-08-06 Return of the Cheese Chewer(s)

' All that cheese going to waste?

' nope! redesigned shooter to chucky cheese rat eater





'================================ Instructions ==========================

'

'                     Move cheese, eat rats, get a-round(er)

'

'                               Eat or be eaten!

'

'========================================================================



'screen dimensions

Const ww = 1280

Const wh = 740

Const cx0 = 400

Const cy0 = 300

Const ratPack = 5

Const maxLife = 3



Type cheeseType

    x As Integer

    y As Integer

    r As Integer

    a As Double 'curr angle

    ma As Double 'mouth angle

    dma As Integer 'mouth angle growing 1 or shrinking -1

End Type



Type rat

    x As Integer

    y As Integer

    r As Integer

    dx As Integer

    dy As Integer

    c As _Unsigned Long

    dead As Integer

End Type



Screen _NewImage(ww, wh, 32)

_FullScreen

Randomize Timer



Dim Shared life, nRats, points, GameOn, newRound, cheese&

Dim Shared r(maxLife * ratPack + maxLife) As rat

Dim Shared chucky As cheeseType



restart:



chucky.x = ww / 2

chucky.y = wh / 2

chucky.r = 50

chucky.a = 0 'mouth direction

chucky.ma = _Pi(1 / 3) 'mouth angle

chucky.dma = 1 'mouth angle direction up or down

lastx = ww / 2: lasty = wh / 2

life = 1

nRats = life * ratPack

points = 0

GameOn = 1

newRound = 0

For i = 0 To nRats

    newRat i

Next

growCheese



_MouseHide

While GameOn

    Cls

    newRound = 0



    'KISS control!!!

    While _MouseInput: Wend

    chucky.x = _MouseX: chucky.y = _MouseY

    If chucky.x <> lastx Or chucky.y <> lasty Then

        chucky.a = _Atan2(chucky.y - lasty, chucky.x - lastx)

        lastx = chucky.x: lasty = chucky.y

    End If

    If _MouseButton(1) Then chucky.a = chucky.a - _Pi(10 / 360)

    If _MouseButton(2) Then chucky.a = chucky.a + _Pi(10 / 360)

    While chucky.a < 0

        chucky.a = chucky.a + _Pi(2)

    Wend

    While chucky.a >= _Pi(2)

        chucky.a = chuck.a - _Pi(2)

    Wend

    If _KeyDown(27) Then _MouseShow: End

    drawChucky

    stats

    handleRats

    If newRound Then

        'chucky  goes, round over show last frame to see rat overlap

        For ra = 0 To _Pi(2) Step _Pi(1 / 24)

            xx = chucky.x + (chucky.r + 20) * Cos(ra)

            yy = chucky.y + (chucky.r + 20) * Sin(ra)

            xx2 = chucky.x + 5 * chucky.r * Cos(ra)

            yy2 = chucky.y + 5 * chucky.r * Sin(ra)

            ln xx, yy, xx2, yy2, _RGB32(200, 0, 0)

        Next

        _Display

        _Delay 1.5

        If life + 1 <= maxLife Then

            life = life + 1

            nRats = life * ratPack

            'new set o rats

            For i = 0 To nRats

                newRat i

            Next

        Else

            GameOn = 0

        End If

    Else

        chucky.r = 50 + Int(points / 5)

        If chucky.r > 150 Then chucky.r = 150

        _Display

        _Limit 30

    End If

Wend

_Delay 4 ' pause to examine score,

' no play again prompt necessary, of course you want to play again!

GoTo restart



Sub newRat (iRat)

    side = rand(1, 4)

    Select Case life

        Case Is = 1: m = 1

        Case Is = 2: m = 1.125

        Case Is = 3: m = 1.5

    End Select

    Select Case side

        Case 1

            r(iRat).x = 0: r(iRat).y = rand(0, wh)

            r(iRat).dx = rand(1, 6) * m: r(iRat).dy = rand(-4, 4) * m

        Case 2

            r(iRat).x = ww: r(iRat).y = rand(0, wh)

            r(iRat).dx = rand(-6, -1) * m: r(iRat).dy = rand(-4, 4) * m

        Case 3

            r(iRat).x = rand(0, ww): r(iRat).y = 0

            r(iRat).dx = rand(-6, 6) * m: r(iRat).dy = rand(1, 4) * m

        Case 4

            r(iRat).x = rand(0, ww): r(iRat).y = wh:

            r(iRat).dx = rand(-6, 6) * m: r(iRat).dy = rand(-4, -1) * m

    End Select

    r(iRat).r = rand(10, 60 / m)

    r(iRat).dead = 0

    r = rand(60, 255): g = r \ 2 + rand(0, 10): b = g \ 2

    r(iRat).c = _RGB32(r, g, b)

End Sub



Sub handleRats ()

    For i = 0 To nRats

        If r(i).dead = 0 Then 'if rat not dead move it

            r(i).x = r(i).x + r(i).dx

            r(i).y = r(i).y + r(i).dy

        End If



        ' rat collides with chucky:

        If ((r(i).x - chucky.x) ^ 2 + (r(i).y - chucky.y) ^ 2) ^ .5 < .85 * chucky.r And r(i).dead = 0 Then

            'Who gets who ??

            'if rat (abdomen) in chucky's mouth chucky lives, rat dies... otherwise vice versa

            'we can determine this from the angle between two centers and the direction = direction of chucky's mouth

            mx = chucky.x + .5 * chucky.r * Cos(chucky.a)

            my = chucky.y + .5 * chucky.r * Sin(chucky.a)

            If ((r(i).x - mx) ^ 2 + (r(i).y - my) ^ 2) ^ .5 < .65 * chucky.r Then 'very near center of mouth

                'rat dies

                If r(i).dead = 0 Then

                    r(i).dead = 1

                    points = points + life

                End If

            Else

                newRound = 1 'draw rest of rats to show collisions

            End If

        End If

        'is the rat on screen

        If r(i).x > 0 And r(i).x < ww And r(i).y > 0 And r(i).y < wh Then 'inbounds

            If r(i).dead Then 'show the burn out until reaches rat radius

                r(i).dead = r(i).dead + 2

                If r(i).dead < r(i).r Then

                    For d = 1 To 2 * r(i).r

                        r1 = rand(-r(i).r, r(i).r): ra1 = Rnd * _Pi(2): r2 = Rnd

                        dx1 = chucky.x + .5 * chucky.r * Cos(chucky.a) + r2 * r1 * Cos(ra1)

                        dy1 = chucky.y + .5 * chucky.r * Sin(chucky.a) + r2 * r1 * Sin(ra1)

                        fcirc dx1, dy1, 2, _RGB32(255 - r(i).dead, 128 - r(i).dead, 0)

                    Next

                Else

                    newRat i

                End If

            Else

                'draw it

                Dim heading As Single

                heading = _Atan2(r(i).dy, r(i).dx)

                noseX = r(i).x + 2 * r(i).r * Cos(heading)

                noseY = r(i).y + 2 * r(i).r * Sin(heading)

                neckX = r(i).x + .75 * r(i).r * Cos(heading)

                neckY = r(i).y + .75 * r(i).r * Sin(heading)

                tailX = r(i).x + 2 * r(i).r * Cos(heading + _Pi)

                tailY = r(i).y + 2 * r(i).r * Sin(heading + _Pi)

                earLX = r(i).x + r(i).r * Cos(heading - _Pi(1 / 12))

                earLY = r(i).y + r(i).r * Sin(heading - _Pi(1 / 12))

                earRX = r(i).x + r(i).r * Cos(heading + _Pi(1 / 12))

                earRY = r(i).y + r(i).r * Sin(heading + _Pi(1 / 12))

                fcirc r(i).x, r(i).y, .65 * r(i).r, r(i).c

                fcirc neckX, neckY, r(i).r * .3, r(i).c

                fTri noseX, noseY, earLX, earLY, earRX, earRY, r(i).c

                fcirc earLX, earLY, r(i).r * .3, r(i).c

                fcirc earRX, earRY, r(i).r * .3, r(i).c

                wX = .5 * r(i).r * Cos(heading - _Pi(11 / 18))

                wY = .5 * r(i).r * Sin(heading - _Pi(11 / 18))

                ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, r(i).c

                wX = .5 * r(i).r * Cos(heading - _Pi(7 / 18))

                wY = .5 * r(i).r * Sin(heading - _Pi(7 / 18))

                ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, r(i).c

                ln r(i).x, r(i).y, tailX, tailY, r(i).c

            End If

        Else 'out of bounds

            newRat i

        End If

    Next

End Sub



Sub drawChucky ()

    'first makeCheese and use cheese& image to build chucky image

    'dim shared chucky as cheeseType



    'first chucky's mouth angle

    chucky.ma = chucky.ma + _Pi(1 / 5) * chucky.dma

    If chucky.ma > _Pi(5 / 6) Then chucky.ma = _Pi(5 / 6): chucky.dma = -1 * chucky.dma

    If chucky.ma < _Pi(1 / 12) Then chucky.ma = _Pi(1 / 12): chucky.dma = -1 * chucky.dma

    ma2 = .5 * chucky.ma



    'next first leg of chucky

    x1 = chucky.x + chucky.r * Cos(chucky.a + ma2)

    y1 = chucky.y + chucky.r * Sin(chucky.a + ma2)

    'first leg of cheese

    cx1 = cx0 + chucky.r * Cos(ma2)

    cy1 = cy0 + chucky.r * Sin(ma2)



    'take small traingles off cheese& image  and map them onto main screen at chucky's and mouth angle position

    stepper = _Pi(1 / 20)

    starter = ma2 + stepper

    stopper = _Pi(2) - ma2

    For a = starter To stopper Step stepper

        'one to one ratio of mapping

        x2 = chucky.x + chucky.r * Cos(chucky.a + a)

        y2 = chucky.y + chucky.r * Sin(chucky.a + a)

        cx2 = cx0 + chucky.r * Cos(a)

        cy2 = cy0 + chucky.r * Sin(a)

        _MapTriangle (cx0, cy0)-(cx1, cy1)-(cx2, cy2), cheese& To(chucky.x, chucky.y)-(x1, y1)-(x2, y2), 0

        x1 = x2: y1 = y2: cx1 = cx2: cy1 = cy2

    Next

End Sub





Sub growCheese () 'make this more self contained than first version, all hole stuff just in here

    curr& = _Dest

    If cheese& Then _FreeImage cheese&

    cheese& = _NewImage(ww, wh, 32)

    _Dest cheese&

    nHoles = 300: maxHoleLife = 20: maxHoleRadius = 7: tfStart = 1

    Dim hx(nHoles), hy(nHoles), hLife(nHoles)

    For i = 1 To nHoles

        GoSub newHole

    Next

    tfStart = 0

    For layr = 1 To 30

        Line (0, 0)-(ww, wh), _RGBA32(255, 255, 0, 50), BF 'layer of cheese

        For i = 1 To nHoles 'holes in layer

            If hLife(i) + 1 > maxHoleLife Then GoSub newHole Else hLife(i) = hLife(i) + 1

            hx(i) = hx(i) + Rnd * 2 - 1

            hy(i) = hy(i) + Rnd * 2 - 1

            If hLife(i) < maxHoleRadius Then

                radius = hLife(i)

            ElseIf maxHoleLife - hLife(i) < maxHoleRadius Then

                radius = maxHoleLife - hLife(i)

            Else

                radius = maxHoleRadius

            End If

            fcirc hx(i), hy(i), radius, _RGBA32(0, 0, 0, 50)

        Next

    Next

    _Dest curr&

    Exit Sub



    newHole:

    hx(i) = ww * Rnd

    hy(i) = wh * Rnd

    If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1

    Return



End Sub



Sub stats ()

    Color _RGB(200, 225, 255)

    _PrintString (5, 5), "Life #" + LTrim$(Str$(life)) + "  Points:" + Str$(points)

End Sub



Function rand% (lo%, hi%)

    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%

End Function



' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0

Sub fTri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    a& = _NewImage(1, 1, 32)

    _Dest a&

    PSet (0, 0), K

    _Dest 0

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

    _FreeImage a& '<<< this is important!

End Sub



Sub ln (x1, y1, x2, y2, K As _Unsigned Long)

    Line (x1, y1)-(x2, y2), K

End Sub



'Steve McNeil's  copied from his forum   note: Radius is too common a name

Sub fcirc (CX As Long, CY As Long, R As Long, c As _Unsigned Long)

    Dim subRadius As Long, RadiusError As Long

    Dim X As Long, Y As Long



    subRadius = Abs(R)

    RadiusError = -subRadius

    X = subRadius

    Y = 0



    If subRadius = 0 Then PSet (CX, CY), c: Exit Sub



    ' Draw the middle span here so we don't draw it twice in the main loop,

    ' which would be a problem with blending turned on.

    Line (CX - X, CY)-(CX + X, CY), c, BF



    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), c, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), c, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), c, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), c, BF

    Wend

End Sub

Here is a game I've been working on for a few days called Mouse Tank.
You use your mouse to move your little tank anywhere on the screen while dodging the monsters and shooting them 
with your left mouse button. Also you can turn the turret cannon using your mouse wheel. 
I know B+ made something similar to this years ago but I realized that half-way into making it. 
I hope you all enjoy it. I had a blast making it.

@bplus

-Ken

'Mouse Tank by SierraKen

'January 21, 2025



'Thank you to the QB64 Phoenix Forum, including B+ for the help over the years.



_Title "Mouse Tank - by SierraKen"



Screen _NewImage(800, 600, 32)



Randomize Timer



num = 40



Dim oldx(100), oldy(100)

Dim d1(100), d2(100), s(100), d(100), t(100)

Dim x(100), y(100), xx(100), yy(100), si(100), red(100), green(100), blue(100)

Dim nox(100), llx(100), lly(100)



start:



level = 1

score = 0

health = 50

healthp = 100



Cls

_AutoDisplay



Locate 3, 25: Print "M O U S E  T A N K"

Locate 5, 25: Print "By SierraKen"

Locate 10, 25: Print "Move your tank around with your mouse."

Locate 11, 25: Print "Turn your cannon turret with your mouse wheel."

Locate 12, 25: Print "Press left mouse button to fire at monsters."

Locate 13, 25: Print "To pause and unpause, press Space Bar."

Locate 14, 25: Print "Press Esc anytime to quit."

Locate 18, 25: Print "Center Mouse on screen and click left mouse Button to begin."

Do

    If _MouseInput Then mi = 1

Loop Until mi = 1 And _MouseButton(1)



start2:

Cls



_Title "Score: " + Str$(score) + "    Health: " + Str$(healthp) + "%    Level: " + Str$(level)



oldx = 400

oldy = 300



hits = 0



bx = 1

bx2 = 1



mw = -90

r1 = 4

r2 = 30

r3 = 25

loops = 0

For size = 1 To num

    si(size) = (Rnd * 10) + 10

Next size



For colors = 1 To num

    red(colors) = Int(Rnd * 100) + 155

    green(colors) = Int(Rnd * 100) + 155

    blue(colors) = Int(Rnd * 100) + 155

Next colors



Do

    _Limit 400

    For n = 1 To num

        If nox(n) = 1 Then GoTo skip:

        If d1(n) > d2(n) Then s(n) = s(n) + .1

        If d2(n) > d1(n) Then s(n) = s(n) - .1

        d(n) = d(n) + 1

        If d(n) > t(n) Then

            oldx(n) = oldx(n) + x(n)

            oldy(n) = oldy(n) + y(n)

            bugchange d1(n), d2(n), d(n), t(n)

        End If

        x(n) = Cos(s(n) * _Pi / 180) * d(n)

        y(n) = Sin(s(n) * _Pi / 180) * d(n)

        xx(n) = x(n) + oldx(n)

        yy(n) = y(n) + oldy(n)

        If xx(n) > 750 Then oldx(n) = 50: Cls: bugchange d1(n), d2(n), d(n), t(n)

        If xx(n) < 50 Then oldx(n) = 750: Cls: bugchange d1(n), d2(n), d(n), t(n)

        If yy(n) > 550 Then oldy(n) = 50: Cls: bugchange d1(n), d2(n), d(n), t(n)

        If yy(n) < 50 Then oldy(n) = 550: Cls: bugchange d1(n), d2(n), d(n), t(n)

        fillCircle xx(n), yy(n), si(n), _RGB32(red(n), green(n), blue(n))

        fillCircle xx(n) - (si(n) * .3), yy(n) - (si(n) * .3), si(n) * .2, _RGB32(255, 0, 0)

        fillCircle xx(n) + (si(n) * .3), yy(n) - (si(n) * .3), si(n) * .2, _RGB32(255, 0, 0)

        fillCircle xx(n), yy(n), 3, _RGB32(255, 0, 0)

        For sz = .1 To si(n) * .4 Step .1

            Circle (xx(n), yy(n) + (si(n) * .4)), sz, _RGB32(255, 0, 0), , , .35

        Next sz

        skip:

        If _MouseInput Then

            mx = _MouseX

            my = _MouseY

            If _MouseButton(1) Then

                laser = 1

                lx = mx

                ly = my + 25

            End If

            If _MouseWheel Then

                mw = mw + _MouseWheel * 5

            End If

        End If



        If laser = 1 Then

            lx2 = Cos(mw * _Pi / 180)

            ly2 = Sin(mw * _Pi / 180)

            lx = lx2 / 2 + lx

            ly = ly2 / 2 + ly

            fillCircle lx, ly, r1, _RGB32(255, 0, 5)

            For chk = 1 To num



                distance = Sqr((lx - xx(chk)) ^ 2 + (ly - yy(chk)) ^ 2)

                If distance <= r1 + r2 Then

                    DetectCollision = -1 ' True (collision detected)

                Else

                    DetectCollision = 0 ' False (no collision)

                End If



                If DetectCollision And nox(chk) <> 1 Then

                    For explosion = 1 To 100

                        Circle (lx, ly), explosion, _RGB32(255, 0, 0)

                        llx(explosion) = lx

                        lly(explosion) = ly

                    Next explosion

                    Sound 75, .1 '

                    oldx(chk) = -100: nox(chk) = 1

                    score = score + 10

                    _Title "Score: " + Str$(score) + "    Health: " + Str$(healthp) + "%    Level: " + Str$(level)

                    hits = hits + 1

                    laser = 0

                    ly = -3

                    GoTo skip2:

                End If

            Next chk

        End If



        skip2:

        If ly < -2 Then

            laser = 0

            ly = 0

        End If

        If hits > num - 1 Then

            Cls

            ly = 0

            laser = 0

            For nn = 1 To num

                nox(nn) = 0

            Next nn

            level = level + 1

            num = num + 2

            If num > 75 Then num = 75

            GoTo start2

        End If



        'Draw your tank.

        For mxx = -25 To 25 Step .25

            Line (mx, my - 5)-(mx - mxx, my + 25), _RGB32(127, 255, 127)

        Next mxx

        For mxx2 = 1 To 25 Step .25

            Line (mx, my - 5)-(mx + mxx2, my + 25), _RGB32(127, 255, 127)

        Next mxx2



        For mxx = -25 To 25 Step .25

            Line (mx, my + 50)-(mx + mxx, my + 25), _RGB32(127, 255, 127)

        Next mxx

        For mxx2 = 1 To 25 Step .25

            Line (mx, my + 50)-(mx - mxx2, my + 25), _RGB32(127, 255, 127)

        Next mxx2

        fillCircle mx, my + 25, 15, _RGB32(0, 0, 255)

        fillCircle mx, my + 25, 7, _RGB32(127, 255, 127)



        'Draw your tank turret cannon.

        s1 = 90 - mw

        x = Int(Sin(s1 / 180 * _Pi) * 30) + mx

        y = Int(Cos(s1 / 180 * _Pi) * 30) + my

        Line (mx, my + 25)-(x, y + 25), _RGB32(255, 0, 0)

        If loops < 1000 Then GoTo skip3

        'Detect collision with monsters.

        For chk = 1 To num



            distance = Sqr((mx - xx(chk)) ^ 2 + (my - yy(chk)) ^ 2)

            If distance <= r3 + r2 Then

                DetectCollision = -1 ' True (collision detected)

            Else

                DetectCollision = 0 ' False (no collision)

            End If

            If DetectCollision And nox(chk) <> 1 Then

                health = health - .005

                healthp = Int((health / 50) * 100)

                _Title "Score: " + Str$(score) + "    Health: " + Str$(healthp) + "%    Level: " + Str$(level)

                If health < .01 Then

                    For explosion = 1 To 200

                        Circle (mx, my + 25), explosion, _RGB32(255, 0, 0)

                    Next explosion

                    For snd = 100 To 150 Step 5

                        Sound snd, .1

                    Next snd

                    Locate 20, 30: Print "G A M E    O V E R"

                    Locate 25, 30: Input "Again (Y/N)"; ag$

                    If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then GoTo start

                    End

                End If

            End If

        Next chk

        skip3:



        If loops < 1000 Then

            loops = loops + 1

        End If



    Next n

    b$ = InKey$

    If b$ = " " Then

        Do: c$ = InKey$:

            If c$ = Chr$(27) Then End

        Loop Until c$ = " "

    End If

    _Display

    Cls

Loop Until b$ = Chr$(27)

End





Sub bugchange (d1, d2, d, t)

    d1 = Rnd * 360

    d2 = Rnd * 360

    d = 0

    t = Int(Rnd * 360) + 1

End Sub



'from Steve Gold standard

Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    Wend

End Sub

I thought I'd put this in a demo for @bplus to have a look at the mouse function. I want to add my other mapping routine as an option. This one uses arrays. Basically my goal is to pack as many methods and actions as I use in many of my apps into this one subroutine, if possible.

Demo: Press keys, hold keys like ctrl, click mouse, use wheel, hover/click buttons, drag, etc.

ReDim Shared y_btl(2), y_bbr(2), x_btl(2), x_bbr(2), button$(2)

nob = 2

Color 15, 1

If mapping = 0 Then

    Locate 10, 50: y_btl(1) = CsrLin: x_btl(1) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(1) = CsrLin: x_bbr(1) = Pos(0) - 1

    button$(1) = " Button 1 "

    Locate 11, 51: Print " Button 1 ";



    Locate 10, 65: y_btl(2) = CsrLin: x_btl(2) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(2) = CsrLin: x_bbr(2) = Pos(0) - 1

    button$(2) = " Button 2 "

    Locate 11, 66: Print " Button 2 ";

Else

    Locate 10, 50: Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    button$(1) = " Button 1 "

    Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217)

    Locate 11, 51: Print " Button 1 ";



    Locate 10, 65: Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217)

    button$(2) = " Button 2 "

    Locate 11, 66: Print " Button 2 ";

End If

PCopy 0, 1

Color 7, 0

Locate 1, 1

Do

    MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$()



    If drag Then

        If olddrag <> drag Then

            If drag > 0 Then Print "Drag Right. Status ="; Else Print "Drag Left. Status = ";

            Print drag

            olddrag = drag

        End If

    Else

        olddrag = 0

    End If

    If oldlb <> lb Then

        Select Case lb

            Case 0: Print "Left Button Up - Button Status ="; lb

            Case -1: Print "Left Button Down - Button Status = "; lb

            Case 1: Print "Left Button Pressed - Button Status ="; lb

            Case 2: Print "Left Button Released - Button Status ="; lb

        End Select

        If lb = 0 Then Print "Number of clicks ="; clkcnt

    End If

    If oldmb <> mb Then

        Select Case mb

            Case 0: Print "Middle Button Up - Button Status ="; mb

            Case -1: Print "Middle Button Down - Button Status = "; mb

            Case 1: Print "Middle Button Pressed - Button Status ="; mb

            Case 2: Print "Middle Button Released - Button Status ="; mb

        End Select

    End If

    If oldrb <> rb Then

        Select Case rb

            Case 0: Print "Right Button Up - Button Status ="; rb

            Case -1: Print "Right Button Down - Button Status = "; rb

            Case 1: Print "Right Button Pressed - Button Status ="; rb

            Case 2: Print "Right Button Released - Button Status ="; rb

        End Select

    End If

    If oldmw <> mw Then

        If mw < 0 Then Print "Mouse Wheel Up - Wheel Status ="; mw

        If mw > 0 Then Print "Mouse Wheel Down - Wheel Status ="; mw

    End If

    If oldalt% <> alt% Then

        If alt% < 0 Then Print "Alt Button Down" Else Print "Alt Button Released"

    End If

    If oldctrl% <> ctrl% Then

        If ctrl% < 0 Then Print "Ctrl Button Down" Else Print "Ctrl Button Released"

    End If

    If oldshift% <> shift% Then

        If shift% < 0 Then Print "Shift Button Down" Else Print "Shift Button Released"

    End If

    If oldalt <> alt And alt < 0 Then

        Print "Alt Key Pressed";

        If AltToggle Then Print " / Alt Toggle Status: On" Else Print " / Alt Toggle Status: Off"

    End If

    If k& < 0 Then oldb$ = ""

    Select Case Len(b$)

        Case 1

            If oldb$ <> b$ Then Print "You Pressed: ";: x = CVI(MKI$(Asc(b$))): Print Chr$(x); "  Chr$(" + LTrim$(Str$(x)) + ")"

            oldb$ = b$

        Case 2

            If oldb$ <> b$ Then Print "You Pressed: "; "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + "  Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34)

            oldb$ = b$

    End Select



    oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: oldalt = alt

    If CsrLin > _Height - 2 Then Cls: PCopy 1, 0

Loop



Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$())

    Dim As Integer b_hover, i, oldmw

    Static As Integer oldmy, oldmx, hover, mwy, oldmwy, b_active

    Static z1 As Single

    _Limit 60

    If alt Then alt = 0

    If Len(autokey$) Then

        b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)

        autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)

        Exit Sub

    Else

        k& = _KeyHit

        If k& = 100307 Or k& = 100308 Then

            alt = -1

            AltToggle = 1 - AltToggle

            Exit Sub

        End If

        If k& > 0 Then

            b$ = MKI$(k&)

            If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and alt.

            If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)

        Else

            b$ = ""

        End If

    End If

    If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0

    If lb > 0 Then

        If lb = 1 Then

            lb = -1

        Else

            lb = 0

        End If

    End If

    If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0

    If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0

    While _MouseInput

        mwy = mwy + _MouseWheel

    Wend

    my = _MouseY

    mx = _MouseX

    b_hover = 0

    For i = 1 To nob ' number of buttons.

        If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then

            b_hover = i

            Exit For

        End If

    Next

    If lb = -1 Then

        If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then

            If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.

        End If

    End If

    If drag = 0 Then

        If mwy <> oldmw Then

            mw = Sgn(mwy - oldmwy): mwy = 0

        Else

            mw = 0

        End If

        oldmwy = mwy

        If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0

        If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0

        If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0

    End If

    If lb = -1 And _MouseButton(1) = 0 Then

        lb = 2: drag = 0: hover = 0

    ElseIf rb = -1 And _MouseButton(2) = 0 Then

        rb = 2

    ElseIf mb = -1 And _MouseButton(3) = 0 Then

        mb = 2

    End If

    If _MouseButton(1) Then

        If lb = 0 Then

            lb = 1: z1 = Timer

            clkcnt = clkcnt + 1

        End If

    ElseIf _MouseButton(2) And rb = 0 Then

        rb = 1

    ElseIf _MouseButton(3) And mb = 0 Then

        mb = 1

    End If

    If b_active Then

        If b_hover Then

            If lb = 1 Or lb = 0 Then ' Button clicked. Flash effect.

                s1 = CsrLin: s2 = Pos(0)

                c1 = _DefaultColor: c2 = _BackgroundColor

                If lb = 1 Then Color 15, 3 Else Color 1, 3

                Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)

                Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

                Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);

                Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);

                Color c1, c2

                Locate s1, s2

            End If

        Else

            s1 = CsrLin: s2 = Pos(0)

            c1 = _DefaultColor: c2 = _BackgroundColor

            Color 15, 1

            Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)

            Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

            Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);

            Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);

            Color c1, c2

            Locate s1, s2

            b_active = 0

        End If

    Else

        If b_hover And oldmy <> 0 Then

            If b_active = 0 Then

                s1 = CsrLin: s2 = Pos(0)

                c1 = _DefaultColor: c2 = _BackgroundColor

                Color 1, 3

                Locate y_btl(b_hover), x_btl(b_hover): Print Chr$(218) + String$(10, 196) + Chr$(191)

                Locate , x_btl(b_hover): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

                Locate , x_btl(b_hover): Print Chr$(192) + String$(10, 196) + Chr$(217);

                Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);

                Color c1, c2

                Locate s1, s2

                b_active = b_hover

            End If

        End If

    End If

    oldmy = my: oldmx = mx

End Sub

"Less lines does not = more readable code"

agreed! 100% but this does not mean less readable either. Fact is readable is an opinion and that is based on ones personal experiences.
(BTW "Less lines <> readable code" less words but don't use it in an English paper )

I think there is a legitimate positive challenge to reduce the lines of code. I think of it as boiling down a code's essence. It is NOT some useless exercise even if it gets silly except silly with colons of course

In reducing lines of code here, what step had I taken that wasn't instructive to a beginner?
Never did I say well you can put it all one one line by using colons because that is not helpful in learning; thats what a bot would do, nothing to learn there. Seems the use _IIF was a popular outcome of this thread. I think _InputBox$ dialog has some great advantages over the simpler Input. How many newbies know about multiple assignments from one Input prompt?

The final one-liner here is less than appealing because it exceeds a certain tolerable line width. line extensions? eeeeh only if you must! better than having to use a horizontal scroller. Thats when I consider shortening variable names or strings.

Tell me, you look at a text book that is 1000 pages and you look at a summary statement one line long, which are you more inclined to read?
Maybe the one-liner will help motivate you to read the text book.

Anyone remember the 1980's arcade game (and later home computer / console game) Qix ?

I was thinking about how to re-create the "line monster" (the Qix) from this game.  Basically it is an array of lines (ie:  (x1,y1) and (x2,y2) coordinates).  A line is drawn, then the color is dimmed a little, and the next line is drawn.  This produces a fade out effect.  The coordinates of the first line are changed each time the monster moves.  Each remaining line is a copy of the one before it in the array.  The code would be something like this:

for q = last_line to 2 step -1
    line(q) = line(q-1)
next q
update_coords line(1)

In the 1980's game, the array contained only a handful of lines, maybe a dozen or so at most.  This was likely done because of hardware limitations (both CPU speeds, and screen resolution).  Today, with our high-res screens and faster CPUs, we can make the array much longer...

Below is my first attempt at doing this.  It is not the most elegant code, but it works.  The array is 135 lines long (const cnqlen, ie: Qix Length).  It doesn't look exactly like the arcade.  It sort of reminds me of the old "Mystify" screen saver for Windows...  The line will change colors every few seconds, or you can press 1-7 to change colors.

'' Qix line experiment 1 (first attempt at reproducing the "line monster" from the 1980's game Qix)

'' by Abazek    2025-Jan-19

''

'' Future plans:

'' 1. Optimize the code (there are parts of this I could do differently/better)

'' 2. Greater variety of movement (perhaps RND, or SIN and COS, so cx/cy can be more than just 1, 0, or -1)

'' 3. Qix size limits (ie: if qixA and qixB get too far apart, change cx/cy to bring them closer together)



Const cnqlen = 135

Const cnfade = 2

Const cnSPD = 0.05

Const cnResX = 1280

Const cnResY = 960

Const cnMinChg = 25

Const cnMaxChg = 100

Const defx1 = 620

Const defy1 = 460

Const defx2 = 660

Const defy2 = 500



Type coord

    x As Integer

    y As Integer

    c As Integer

End Type



Dim qixA(cnqlen) As coord

Dim qixB(cnqlen) As coord

Dim scn&, pixcolr&

Dim a$, qq, d1, d2, colr, fw, flag, cl, clrchg, whenclr

Dim showc

Dim Shared cx, cy, chgdirA, chgdirB, whenChgA, whenChgB



Randomize Timer

scn& = _NewImage(cnResX, cnResY, 32)

Screen scn&

Cls 0, _RGB(0, 0, 0)

_Title "Qix Experiment 1"



For qq = 1 To cnqlen

    qixA(qq).x = defx1

    qixA(qq).y = defy1

    qixA(qq).c = 7

    qixB(qq).x = defx2

    qixB(qq).y = defy2

    qixB(qq).c = 7

Next qq

GoSub changedirA

GoSub changedirB



chgdirA = 0

chgdirB = 0

clrchg = 0

whenclr = cnMaxChg

showc = 0

flag = 0

While flag = 0

    GoSub MoveQix

    If showc = 1 Then GoSub ShowCoords

    GoSub DrawQix

    Color _RGB32(128, 128, 128)

    Locate 1, 1

    Print "ESC or SPACE to exit.  S to show coordintates.  D to hide coordintates.  1-7 manually change color."

    ''GoSub framewait

    _Delay cnSPD

    ''GoSub WaitKey

    a$ = InKey$

    If a$ = Chr$(27) Then flag = 1

    If a$ = Chr$(32) Then flag = 1

    If a$ = "S" Or a$ = "s" Then showc = 1: Cls

    If a$ = "D" Or a$ = "d" Then showc = 0: Cls

    If a$ = "1" Then cl = 1: GoSub ManualClr

    If a$ = "2" Then cl = 2: GoSub ManualClr

    If a$ = "3" Then cl = 3: GoSub ManualClr

    If a$ = "4" Then cl = 4: GoSub ManualClr

    If a$ = "5" Then cl = 5: GoSub ManualClr

    If a$ = "6" Then cl = 6: GoSub ManualClr

    If a$ = "7" Then cl = 7: GoSub ManualClr

Wend

End



WaitKey:

a$ = InKey$

If a$ = "" Then GoTo WaitKey

If a$ = Chr$(27) Then flag = 1

Return



framewait:

fw = Timer

While (Abs(Timer - fw) < cnSPD)

Wend

Return



ShowCoords:

For qq = 1 To cnqlen

    If qq < 51 Then

        Locate (qq + 1), 1

    ElseIf qq < 101 Then

        Locate (qq - 49), 50

    ElseIf qq < 151 Then

        Locate (qq - 99), 100

    Else

        Locate 51, 100

    End If

    Color _RGB32(128, 128, 128)

    Print "Coords "; qq; " = ("; qixA(qq).x; ","; qixA(qq).y; ") - ("; qixB(qq).x; ","; qixB(qq).y; ")"

Next qq

Locate 52, 1

Print "Timer = "; Timer; "  Delay="; cnSPD; "  ChgdirA="; chgdirA; "/"; whenChgA; "  ChgdirB="; chgdirB; "/"; whenChgB;

colr = 128

GoSub setColor

Color pixcolr&

Print "  Color "; clrchg; "/"; whenclr; "  "

Return



DrawQix:

colr = 1

For qq = cnqlen To 1 Step -1

    cl = qixA(qq).c

    GoSub setColor

    Color pixcolr&

    Line (qixA(qq).x, qixA(qq).y)-(qixB(qq).x, qixB(qq).y), pixcolr&

    colr = colr + cnfade

    If colr > 255 Then colr = 255

Next qq

Color _RGB32(1, 1, 1)

Return



MoveQix:

For qq = cnqlen To 2 Step -1

    qixA(qq).x = qixA(qq - 1).x

    qixA(qq).y = qixA(qq - 1).y

    qixA(qq).c = qixA(qq - 1).c

    qixB(qq).x = qixB(qq - 1).x

    qixB(qq).y = qixB(qq - 1).y

    qixB(qq).c = qixB(qq - 1).c

Next qq

qq = 1

chgdirA = chgdirA + 1

chgdirB = chgdirB + 1

clrchg = clrchg + 1

If chgdirA > whenChgA Then

    GoSub changedirA

End If

If chgdirB > whenChgB Then

    GoSub changedirB

End If

If clrchg > whenclr Then

    GoSub changeClr

    qixA(qq).c = cl

    qixB(qq).c = cl

End If

SetMoveDir d1

cx = cx * 2

cy = cy * 2

qixA(qq).x = qixA(qq).x + cx

qixA(qq).y = qixA(qq).y + cy

If qixA(qq).x < 1 Then qixA(qq).x = 1: GoSub changedirA

If qixA(qq).x > cnResX Then qixA(qq).x = cnResX: GoSub changedirA

If qixA(qq).y < 1 Then qixA(qq).y = 1: GoSub changedirA

If qixA(qq).y > cnResY Then qixA(qq).y = cnResY: GoSub changedirA

SetMoveDir d2

cx = cx * 2

cy = cy * 2

qixB(qq).x = qixB(qq).x + cx

qixB(qq).y = qixB(qq).y + cy

If qixB(qq).x < 1 Then qixB(qq).x = 1: GoSub changedirB

If qixB(qq).x > cnResX Then qixB(qq).x = cnResX: GoSub changedirB

If qixB(qq).y < 1 Then qixB(qq).y = 1: GoSub changedirB

If qixB(qq).y > cnResY Then qixB(qq).y = cnResY: GoSub changedirB

Return



changedirA:

d1 = Int(Rnd * 8) + 1

cl = cnMaxChg - cnMinChg

whenChgA = Int(Rnd * cl) + cnMinChg

chgdirA = 0

Return



changedirB:

d2 = Int(Rnd * 8) + 1

cl = cnMaxChg - cnMinChg

whenChgB = Int(Rnd * cl) + cnMinChg

chgdirB = 0

Return



changeClr:

cl = Int(Rnd * 7) + 1

clrchg = 0

Return



ManualClr:

qixA(1).c = cl

qixB(1).c = cl

clrchg = 0

Return



setColor:

Select Case cl

    Case 1

        pixcolr& = _RGB32(colr, 0, 0)

    Case 2

        pixcolr& = _RGB32(0, colr, 0)

    Case 3

        pixcolr& = _RGB32(colr, colr, 0)

    Case 4

        pixcolr& = _RGB32(0, 0, colr)

    Case 5

        pixcolr& = _RGB32(colr, 0, colr)

    Case 6

        pixcolr& = _RGB32(0, colr, colr)

    Case Else

        pixcolr& = _RGB32(colr, colr, colr)

End Select

Return



Sub SetMoveDir (dir)

    Select Case dir

        Case 1

            cx = 1: cy = 0

        Case 2

            cx = 0: cy = 1

        Case 3

            cx = -1: cy = 0

        Case 4

            cx = 0: cy = -1

        Case 5

            cx = 1: cy = -1

        Case 6

            cx = -1: cy = 1

        Case 7

            cx = -1: cy = -1

        Case Else

            cx = 1: cy = 1

    End Select

End Sub

"Oh you speed demon" ah, Charlie I had so much less typing to do

That is freak'n interesting code you had back there @CharlieJV
https://qb64phoenix.com/forum/showthread...6#pid31416

I see your Input can take variable string for/in the prompt And something funny about IF THEN Structure there too.
I must warn newbies that this BAM code is NOT QB64pe code but a very close cousin.