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.
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...................
Code: (Select All)
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
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
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
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
_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!
'
'========================================================================
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
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
'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
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.
'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)
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.
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
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
I'll probably switch to type variables before going any further.
Oh, since INKEY$ is very familiar to me, but I get a bit PISSED OFF now and then by its inability to detect press and release without adding a slightly imperfect coding workaround, I decided to migrate to _KEYHIT by using a _KEYHIT to INKEY$ conversion method. Lucky for me I migrated just before Inauguration day, or I might have HIT A WALL on that one!
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.
Code: (Select All)
'' 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)
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
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
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.