10-27-2022, 07:45 PM
I've been wanting to make a multiplayer Spacewar! type game, maybe with elements of Asteroids and other similar games, and what better way to learn than to look under the hood of a similar program and modify it? So I studied Terry Ritchie's "Widescreen Asteroids", which is very nicely done, but it turned out to be a lot more complicated than I have time and brain power for. However, Terry's game uses a simple method of defining vector objects line by line, so using that as a starting point, I have the beginning of a game.
So far all it does is draw some of the objects from Widescreen Asteroids and move them around the screen. Next is to figure out how to rotate them and translate the rotation angle into dx, dy to move in a given direction, and then figure out how to do collisions.
Anyway maybe this will help someone interested in learning about this... enjoy
So far all it does is draw some of the objects from Widescreen Asteroids and move them around the screen. Next is to figure out how to rotate them and translate the rotation angle into dx, dy to move in a given direction, and then figure out how to do collisions.
Anyway maybe this will help someone interested in learning about this... enjoy
Code: (Select All)
_Title "Simple vector graphics v0.09 mostly by madscijr" ' display in the Window's title bar
' Simple test of vector graphics,
' borrowed graphics objects and format from Widescreen Asteroids by Terry Ritchie.
' TO DO:
' * rotate objects
' * translate rotation angle into dx,dy to move in direction of angle
' * speed up?
' * detect collisions
' BOOLEAN CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' HOLDS POSITION AND VELOCITY OF ALL OBJECTS
Type ObjectType
x As Integer
y As Integer
dx As Integer
dy As Integer
cx As Integer
cy As Integer
IsEnabled As Integer
End Type ' ObjectType
' HOLDS DEFINITION OF ALL OBJECTS
Type CoordType
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
color As _Unsigned Long
IsLast As Integer
End Type ' CoordType
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = TRUE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' OBJECT VARIABLES
ReDim Shared m_arrObject(1 To 8) As ObjectType
ReDim Shared m_arrLines(1 To 8, 1 To 32) As CoordType
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
$Console
_Delay 4
_Console On
_Echo "Started " + m_ProgramName$
_Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
Screen 0
Print m_ProgramName$ + " finished."
Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
_Console Off
End If
' ****************************************************************************************************************************************************************
System ' return control to the operating system
End
' /////////////////////////////////////////////////////////////////////////////
Sub main
' LOCAL VARIABLES
Dim iFPS As Integer: iFPS = 120
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim imgBack&
Dim imgMiddle&
Dim imgFront&
Dim iWhich As Integer: iWhich = 1
Dim bQuit As Integer: bQuit = FALSE
Dim in$
Dim sError As String: sError = ""
Dim iX As Integer
Dim iY As Integer
Dim sKey As String
Dim iMinX As Integer: iMinX = 0
Dim iMaxX As Integer: iMaxX = 800
Dim iMinY As Integer: iMinY = 0
Dim iMaxY As Integer: iMaxY = 640
' =============================================================================
' INITIALIZE
Screen _NewImage(800, 640, 32) ' 100 text columns x 40 text rows
'imgBack& = _NewImage(800, 640, 32) ' background
'imgMiddle& = _NewImage(800, 640, 32) ' other stuff
'imgFront& = _NewImage(800, 640, 32) ' foreground
' =============================================================================
' START NEW GAME
Do
_KeyClear
' CONFIGURE PRINTING FOR _PrintString
_PrintMode _FillBackground
'_PrintMode _KEEPBACKGROUND
' INIT VARS
sKey = ""
iX = 0: iY = 0
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
m_arrObject(iObject).IsEnabled = FALSE
m_arrObject(iObject).x = iX
m_arrObject(iObject).y = iY
m_arrObject(iObject).dx = RandomNumber%(-5, 5)
m_arrObject(iObject).dy = RandomNumber%(-5, 5)
m_arrObject(iObject).cx = 0
m_arrObject(iObject).cy = 0
iX = iX + 200
If iX > 800 Then
iX = 0
iY = iY + 200
If iY > 640 Then
iY = 0
End If
End If
Next iObject
InitVectorObjects
' MAIN LOOP
While TRUE = TRUE
' REDRAW BACKGROUND LAYERS
DrawLayers imgBack&, imgMiddle&, imgFront&
'_Dest 0: Cls , cBlack
' SHOW TEXT
DrawText sKey, iWhich
' MOVE + DRAW ENABLED OBJECTS
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
' Only enabled objects
If m_arrObject(iObject).IsEnabled = TRUE Then
' Move along X axis
m_arrObject(iObject).cx = m_arrObject(iObject).cx + 1
If m_arrObject(iObject).cx > (10 - Abs(m_arrObject(iObject).dx)) Then
m_arrObject(iObject).cx = 0
If m_arrObject(iObject).dx < 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x - 1
If m_arrObject(iObject).x < iMinX Then
m_arrObject(iObject).x = iMaxX
End If
ElseIf m_arrObject(iObject).dx > 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x + 1
If m_arrObject(iObject).x > iMaxX Then
m_arrObject(iObject).x = iMinX
End If
End If
End If
' Move along Y axis
m_arrObject(iObject).cy = m_arrObject(iObject).cy + 1
If m_arrObject(iObject).cy > (10 - Abs(m_arrObject(iObject).dy)) Then
m_arrObject(iObject).cy = 0
If m_arrObject(iObject).dy < 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y - 1
If m_arrObject(iObject).y < iMinY Then
m_arrObject(iObject).y = iMaxY
End If
ElseIf m_arrObject(iObject).dy > 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y + 1
If m_arrObject(iObject).y > iMaxY Then
m_arrObject(iObject).y = iMinY
End If
End If
End If
' Draw object's line segments
For iLine = LBound(m_arrLines, 2) To UBound(m_arrLines, 2)
'Line (x1%, y1%)-(x2%, y2%), arrColor(arrStars(iLoop).ColorIndex), BF
Line _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x1, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y1) _
- _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x2, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y2) _
, _
m_arrLines(iObject, iLine).color ' , BF
If m_arrLines(iObject, iLine).IsLast = TRUE Then
Exit For
End If
Next iLine
End If
Next iObject
' UPDATE THE SCREEN
_Display
' PROCESS INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
sKey = ""
' QUIT?
If _Button(KeyCode_Escape%) Then
bQuit = TRUE
Exit While
End If
' OTHER INPUT 1-6 SELECTS WHICH OBJECT TO CHANGE
If _Button(KeyCode_1%) Then
sKey = sKey + "1,"
iWhich = 1
ElseIf _Button(KeyCode_2%) Then
sKey = sKey + "2,"
iWhich = 2
ElseIf _Button(KeyCode_3%) Then
sKey = sKey + "3,"
iWhich = 3
ElseIf _Button(KeyCode_4%) Then
sKey = sKey + "4,"
iWhich = 4
ElseIf _Button(KeyCode_5%) Then
sKey = sKey + "5,"
iWhich = 5
ElseIf _Button(KeyCode_6%) Then
sKey = sKey + "6,"
iWhich = 6
End If
' GET DIRECTION
If _Button(KeyCode_Left%) Then
sKey = sKey + "LEFT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx - 1
If m_arrObject(iWhich).dx < -10 Then m_arrObject(iWhich).dx = -10
ElseIf _Button(KeyCode_Right%) Then
sKey = sKey + "RIGHT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx + 1
If m_arrObject(iWhich).dx > 10 Then m_arrObject(iWhich).dx = 10
ElseIf _Button(KeyCode_Up%) Then
sKey = sKey + "UP,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy - 1
If m_arrObject(iWhich).dy < -10 Then m_arrObject(iWhich).dy = -10
ElseIf _Button(KeyCode_Down%) Then
sKey = sKey + "DOWN,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy + 1
If m_arrObject(iWhich).dy > 10 Then m_arrObject(iWhich).dy = 10
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' CONTROL GAME SPEED
_Limit iFPS
Wend
' UPDATE THE SCREEN
_Display
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 2
' PLAY ANOTHER ROUND OR QUIT?
If bQuit = FALSE Then
If bExit = FALSE Then Sleep
Color cWhite, cBlack
Else
Exit Do
End If
Loop
' RETURN TO AUTODISPLAY
_AutoDisplay
End Sub ' main
' /////////////////////////////////////////////////////////////////////////////
' VECTOR OBJECT DEFINITIONS
Sub InitVectorObjects
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
iObject = 1
iLine = 1
Restore VectorData
For iLoop = 1 To 1024
Read x1
Read y1
Read x2
Read y2
Read r1
Read g1
Read b1 ' -255 means no more data, -254 means last set for this object
If b1 = -255 Then
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
Exit For
ElseIf b1 = -254 Then
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
iObject = iObject + 1
iLine = 1
If iObject > UBound(m_arrLines, 1) Then Exit For
Else
m_arrLines(iObject, iLine).x1 = x1
m_arrLines(iObject, iLine).y1 = y1
m_arrLines(iObject, iLine).x2 = x2
m_arrLines(iObject, iLine).y2 = y2
m_arrLines(iObject, iLine).color = _RGB32(r1, g1, b1)
m_arrLines(iObject, iLine).IsLast = FALSE
iLine = iLine + 1
If iLine > UBound(m_arrLines, 2) Then Exit For
End If
Next iLoop%
VectorData:
'objaster1 = purple
Data 2,-41,31,-50,128,0,255
Data 31,-50,56,-23,128,0,255
Data 56,-23,37,-10,128,0,255
Data 37,-10,61,13,128,0,255
Data 61,13,32,62,128,0,255
Data 32,62,-22,43,128,0,255
Data -22,43,-40,57,128,0,255
Data -40,57,-62,34,128,0,255
Data -62,34,-47,7,128,0,255
Data -47,7,-62,-26,128,0,255
Data -62,-26,-32,-63,128,0,255
Data -32,-63,2,-41,128,0,255
Data 0,0,0,0,-254,-254,-254
'objaster2 = red
Data -28,-62,22,-62,255,0,0
Data 22,-62,61,-28,255,0,0
Data 61,-28,61,13,255,0,0
Data 61,13,23,57,255,0,0
Data 23,57,-6,62,255,0,0
Data -6,62,-6,15,255,0,0
Data -6,15,-36,47,255,0,0
Data -36,47,-59,14,255,0,0
Data -59,14,-35,1,255,0,0
Data -35,1,-62,-9,255,0,0
Data -62,-9,-28,-62,255,0,0
Data 0,0,0,0,-254,-254,-254
'objaster3 = orange
Data 9,-62,60,-21,255,165,0
Data 60,-21,62,-3,255,165,0
Data 62,-3,24,13,255,165,0
Data 24,13,53,34,255,165,0
Data 53,34,38,55,255,165,0
Data 38,55,20,40,255,165,0
Data 20,40,-37,61,255,165,0
Data -37,61,-63,15,255,165,0
Data -63,15,-57,-24,255,165,0
Data -57,-24,-24,-24,255,165,0
Data -24,-24,-38,-45,255,165,0
Data -38,-45,9,-62,255,165,0
Data 0,0,0,0,-254,-254,-254
'objmouse = yellow
Data 0,-10,6,3,255,255,0
Data 6,3,1,2,255,255,0
Data 1,2,1,10,255,255,0
Data 1,10,-1,10,255,255,0
Data -1,10,-1,2,255,255,0
Data -1,2,-6,3,255,255,0
Data -6,3,0,-10,255,255,0
Data 0,0,0,0,-254,-254,-254
'objship = cyan
Data 0,-15,10,15,0,255,255
Data 10,15,6,11,0,255,255
Data 6,11,-6,11,0,255,255
Data -6,11,-10,15,0,255,255
Data -10,15,0,-15,0,255,255
Data 0,0,0,0,-254,-254,-254
'Data 0,18,0,18,0,255,255
'Data 0,0,0,0,-254,-254,-254
'objufo = green
Data -4,-16,4,-16,0,255,0
Data 4,-16,10,-6,0,255,0
Data 10,-6,25,5,0,255,0
Data 25,5,10,16,0,255,0
Data 10,16,-10,16,0,255,0
Data -10,16,-25,5,0,255,0
Data -25,5,-10,-6,0,255,0
Data -10,-6,-4,-16,0,255,0
Data -10,-6,10,-6,0,255,0
Data -25,5,25,5,0,255,0
Data 0,0,0,0,-255,-255,-255
End Sub ' InitVectorObjects
' /////////////////////////////////////////////////////////////////////////////
' (RE)DRAW SCREEN
Sub DrawLayers (imgBack&, imgMiddle&, imgFront&)
_Dest 0
Cls , cBlack
If TRUE = FALSE Then
If imgBack& < -1 Then
_PutImage , imgBack&, 0
End If
If imgMiddle& < -1 Then
_PutImage , imgMiddle&, 0
End If
If imgFront& < -1 Then
_PutImage , imgFront&, 0
End If
End If
End Sub ' DrawLayers
' /////////////////////////////////////////////////////////////////////////////
' SHOW INSTRUMENTS + INSTRUCTIONS
' 800x600 = 40 rows x 100 columns
sub DrawText( _
sKey as string, _
iWhich as integer _
)
Dim iObject As Integer
Dim iX As Integer
Dim iY As Integer
Color cWhite
PrintAt 1, 1, "Simple 2D vector graphics test"
Color cYellow
PrintAt 3, 1, "Press 1-6 to select active object."
PrintAt 4, 1, "Arrow keys move active object."
iY = 6
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
If m_arrObject(iObject).IsEnabled = TRUE Then
Color cCyan
Else
Color cGray
End If
PrintAt iY, 1, "" + _
"obj #" + cstr$(iObject) + _
"(" + cstr$(m_arrObject(iObject).x) + "," + cstr$(m_arrObject(iObject).y) + ")" + _
"(" + cstr$(m_arrObject(iObject).dx) + "," + cstr$(m_arrObject(iObject).dy) + ")" + _
"(" + cstr$(m_arrObject(iObject).cx) + "," + cstr$(m_arrObject(iObject).cy) + ")" + _
""
iY = iY + 1
Next iObject
' SHOW INPUT
'if m_bDebug=TRUE then
Color cLime
PrintAt 20, 1, "Controls : " + RightPadString$(sKey, 10, " ") + " "
Color cWhite
PrintAt 21, 1, "Object # : " + cstr$(iWhich)
'end if
' SHOW COORDINATES
End Sub ' DrawText
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function DblToInt% (dblOld As Double)
Dim dblNew As Double
Dim sValue As String
Dim iPos As Integer
dblNew = RoundDouble#(dblOld, 0)
'sValue = _Trim$(Str$(dblNew))
sValue = DblToStr$(dblNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' DblToInt% = Val(Left$(sValue, iPos - 1))
'Else
' DblToInt% = Val(sValue)
'End If
DblToInt% = Val(sValue)
End Function ' DblToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function DblToStr$ (n#)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n#)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
DblToStr$ = result$
End Function ' DblToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)
Dim dblNew As Double
dblNew = RoundDouble#(dblValue, intNumPlaces)
DblRoundedToStr$ = DblToStr$(dblNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DoubleABS# (dblValue As Double)
If Sgn(dblValue) = -1 Then
DoubleABS# = 0 - dblValue
Else
DoubleABS# = dblValue
End If
End Function ' DoubleABS#
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function FloatToStr$ (n##)
value$ = UCase$(LTrim$(Str$(n##)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n = 1 To L%
If Mid$(valu$, n, 1) <> "." Then
num$ = num$ + Mid$(valu$, n, 1)
End If
Next n
Else
FloatToStr$ = value$
Exit Function
End If
FloatToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' FloatToStr$
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
Function IsNum% (text$)
Dim a$
Dim b$
a$ = _Trim$(text$)
b$ = _Trim$(Str$(Val(text$)))
If a$ = b$ Then
IsNum% = TRUE
Else
IsNum% = FALSE
End If
End Function ' IsNum%
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
Dim result$
Dim i As Long
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
Function LeftPadString$ (myString$, toWidth%, padChar$)
LeftPadString$ = Right$(String$(toWidth%, padChar$) + myString$, toWidth%)
End Function ' LeftPadString$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
Function LongABS& (lngValue As Long)
If Sgn(lngValue) = -1 Then
LongABS& = 0 - lngValue
Else
LongABS& = lngValue
End If
End Function ' LongABS&
' /////////////////////////////////////////////////////////////////////////////
' iRow% and iCol% are 0-based in this version
Sub PrintAt (iRow%, iCol%, sText$)
'_PrintString (iCol% * 8, iRow% * 16), sText$
_PrintString (iCol% * 8, iRow% * 16), sText$
'_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function RightPadString$ (myString$, toWidth%, padChar$)
RightPadString$ = Left$(myString$ + String$(toWidth%, padChar$), toWidth%)
End Function ' RightPadString$
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too complicated.
' There ya go! Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT: Modified to add another option to round scientific,
' since you had it's description included in your example.
' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT
Function Round## (num##, digits%)
Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUp## (num##, digits%)
RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDown## (num##, digits%)
RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientific## (num##, digits%)
RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE
Function RoundDouble# (num#, digits%)
RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUpDouble# (num#, digits%)
RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownDouble# (num#, digits%)
RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificDouble# (num#, digits%)
RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%
End Function
' /////////////////////////////////////////////////////////////////////////////
Function SmallestOf3% (i1%, i2%, i3%)
Dim iMin%
iMin% = i1%
If i2% < iMin% Then iMin% = i2%
If i3% < iMin% Then iMin% = i3%
SmallestOf3% = iMin%
End Function ' SmallestOf3
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
'cWhite = _RGB32(254, 254, 254)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
'cEmpty~& = -1
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub DebugPrint (MyString As String)
If m_bDebug = TRUE Then
'_Echo MyString
ReDim arrLines(-1) As String
Dim iLoop As Integer
split MyString, Chr$(13), arrLines()
For iLoop = LBound(arrLines) To UBound(arrLines)
_Echo arrLines(iLoop)
Next iLoop
End If
End Sub ' DebugPrint
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #REFERENCE
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
MeToo movement. I just abbreviate it as M'oo.