' Isomatric mapping demo re-revisited
' Version 2.18 by madscijr
' Based on Isometric Mapping Demo
' by SMcNeill, bplus, and others at
' https://www.qb64.org/forum/index.php?topic=1903.30
' This crude version uses a 3-dimensional array (32x32x32)
' to store blocks of different colors,
' and draws them to the screen in 2.5D "isometric".
'_ScreenMove _Middle
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
'$CONSOLE
'_DELAY 4
'_CONSOLE ON
'_ECHO "Debugging on..."
' ****************************************************************************************************************************************************************
' =============================================================================
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' boolean constants
' constants for map
' constants for drawing on the screen
Const cScreenOffsetX
= 450 ' 500 Const cScreenOffsetY
= 50 ' 300
' =============================================================================
' GLOBAL VARIABLES
' =============================================================================
' INITIALIZE
iGridSize = 10 ' < 10 is causing problems with PAINT
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapEmpty
' -----------------------------------------------------------------------------
' DRAW FLOOR
iZ% = 0
arrGrid(iLoopX%, iLoopY%, iZ%) = cMapTileFloor
' -----------------------------------------------------------------------------
' DRAW BLOCKS TO CHECK ORIENTATION
arrGrid(0, 0, 1) = cMapRedWall
arrGrid(32, 0, 1) = cMapBlueWall
arrGrid(0, 32, 1) = cMapGreenWall
arrGrid(32, 32, 1) = cMapYellowWall
arrGrid(0, 16, 1) = cMapOrangeWall
arrGrid(32, 16, 1) = cMapPurpleWall
' -----------------------------------------------------------------------------
' DRAW SOME OBJECTS
iX% = 5
iY% = 2
iNextWall% = cMapRedWall
iLoopZ% = 1
iLoopY% = iY%
For iLoopX%
= iX%
To (iX%
+ 10) arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
iNextWall% = cMapBlueWall
iLoopZ% = 1
iLoopY% = iY% + 8
For iLoopX%
= iX%
To (iX%
+ 10) arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
iNextWall% = cMapGreenWall
iLoopZ% = 1
iLoopX% = iX% + 1
For iLoopY%
= (iY%
+ 1) To (iY%
+ 7) arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
iNextWall% = cMapYellowWall
iLoopZ% = 1
iLoopX% = iX% + 9
For iLoopY%
= (iY%
+ 1) To (iY%
+ 7) arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
' -----------------------------------------------------------------------------
' DRAW A PYRAMID
iX% = 15
iY% = 15
iZ% = 1
iPosX1% = iX%
iPosX2% = iX% + 10
iPosY1% = iY%
iPosY2% = iY% + 10
bContinue = TRUE
' PLOT NEXT LEVEL
For iLoopX%
= iPosX1%
To iPosX2%
For iLoopY%
= iPosY1%
To iPosY2%
iNextWall% = cMapRedWall
iNextWall% = cMapPurpleWall
iNextWall% = cMapBlueWall
iNextWall% = cMapGreenWall
iNextWall% = cMapYellowWall
iNextWall% = cMapOrangeWall
arrGrid(iLoopX%, iLoopY%, iZ%) = iNextWall%
' MOVE UP A LEVEL
iPosX1% = iPosX1% + 1
iPosX2% = iPosX2% - 1
iPosY1% = iPosY1% + 1
iPosY2% = iPosY2% - 1
' QUIT AFTER WE REACH THE TOP
If (iPosX1%
<= iPosX2%
) And (iPosY1%
<= iPosY2%
) Then iZ% = iZ% + 1
bContinue = FALSE
' -----------------------------------------------------------------------------
' DRAW PIPES
iX% = 5 ' RandomNumber(0, 32)
iY% = 28 ' RandomNumber(0, 32)
iZ% = 1 ' 32
bFirst = TRUE
iMove% = 4
iCount% = 0
bFinished = FALSE
iNextX% = iX%
iNextY% = iY%
iNextZ% = iZ%
iMove% = iMove% + 1
iMove% = 0
' MOVE UP FOR FIRST MOVE
iNum% = 2
bFirst = FALSE
iNum% = RandomNumber(1, 6)
iNextZ% = iNextZ% - 1
iNextZ% = iNextZ% + 1
iNextX% = iNextX% - 1
iNextX% = iNextX% + 1
iNextY% = iNextY% - 1
iNextY% = iNextY% + 1
If arrGrid
(iNextX%
, iNextY%
, iNextZ%
) = cMapEmpty
Then iCount% = iCount% + 1
iX% = iNextX%
iY% = iNextY%
iZ% = iNextZ%
iNextWall% = cMapRedWall
iNextWall% = cMapPurpleWall
iNextWall% = cMapBlueWall
iNextWall% = cMapGreenWall
iNextWall% = cMapYellowWall
iNextWall% = cMapOrangeWall
arrGrid(iX%, iY%, iZ%) = iNextWall%
' HAVE WE PLACED MAX # OF BLOCKS?
bFinished = TRUE
' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
iOpen% = 0
If arrGrid
(iX%
, iY%
, iZ%
- 1) <> cMapEmpty
Then iOpen% = iOpen% + 1
If arrGrid
(iX%
, iY%
, iZ%
+ 1) <> cMapEmpty
Then iOpen% = iOpen% + 1
If arrGrid
(iX%
- 1, iY%
, iZ%
) <> cMapEmpty
Then iOpen% = iOpen% + 1
If arrGrid
(iX%
+ 1, iY%
, iZ%
) <> cMapEmpty
Then iOpen% = iOpen% + 1
If arrGrid
(iX%
, iY%
- 1, iZ%
) <> cMapEmpty
Then iOpen% = iOpen% + 1
If arrGrid
(iX%
, iY%
+ 1, iZ%
) <> cMapEmpty
Then iOpen% = iOpen% + 1
' QUIT IF NO OPEN SPACES AVAILABLE
' NOWHERE TO GO, EXIT
bFinished = TRUE
' -----------------------------------------------------------------------------
' Draw the map in 3D Isometic Perspective
bTile = FALSE
For iLoopX%
= 0 To 32 'STEP -1 For iLoopY%
= 0 To 32 'STEP -1 ' DETERMINE COLOR
If arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapTileFloor
Then iColor = cGray&
bTile = FALSE
iColor = cLightGray&
bTile = TRUE
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapRedWall
Then iColor = cRed&
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapBlueWall
Then iColor = cBlue&
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapGreenWall
Then iColor = cGreen&
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapYellowWall
Then iColor = cYellow&
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapOrangeWall
Then iColor = cOrange&
ElseIf arrGrid
(iLoopX%
, iLoopY%
, iLoopZ%
) = cMapPurpleWall
Then iColor = cPurple&
iColor = cEmpty&
' CALCULATE POSITION
iZ% = iLoopZ% * iGridSize + cGridOffsetZ
iPosX1% = iLoopX% * iGridSize + cGridOffsetX
iPosY1% = iLoopY% * iGridSize + cGridOffsetY
iPosX2% = iPosX1% + iGridSize
iPosY2% = iPosY1% + iGridSize
IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iZ%, iGridSize, cScreenOffsetX, cScreenOffsetY, iColor
' -----------------------------------------------------------------------------
' GIVE OPTION TO VIEW MAP AS TEXT
Input "See a text dump (y/n)? ", i2$
iMinX% = -1
iMaxX% = -1
iMinY% = -1
iMaxY% = -1
iMinZ% = -1
iMaxZ% = -1
iNext% = arrGrid(iLoopX%, iLoopY%, iLoopZ%)
If iNext%
<> cMapEmpty
And iNext%
<> cMapTileFloor
Then iMinX% = iLoopX%
iMinY% = iLoopY%
iMinZ% = iLoopZ%
iMaxX% = iLoopX%
iMaxY% = iLoopY%
iMaxZ% = iLoopZ%
For iLoopZ%
= iMinZ%
To iMaxZ%
Print "Map Z=" + cstr$
(iLoopZ%
) + ":"
For iLoopY%
= iMinY%
To iMaxY%
sLine = ""
For iLoopX%
= iMinX%
To iMaxX%
iNext% = arrGrid(iLoopX%, iLoopY%, iLoopZ%)
If iNext%
<= cMapOrangeWall
Then sLine = sLine + cstr$(iNext%)
sLine = sLine + " "
sLine = sLine + " "
Input "Press <ENTER> to continue", i2$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
'_CONSOLE OFF
' ****************************************************************************************************************************************************************
' -----------------------------------------------------------------------------
' FINISHED
Input "Press <ENTER> to continue", i2$
System ' return control to the operating system Print ProgramName$
+ " finished."
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
CX2I = x - y
' /////////////////////////////////////////////////////////////////////////////
CY2I = (x + y) / 2
' /////////////////////////////////////////////////////////////////////////////
' since we're drawing a diamond and not a square box, we can't use Line BF.
' We have to manually down the 4 points of the line.
Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), iColor
Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), iColor
Paint (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + 4), iColor
'and fill the diamond solid Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), &HFFFFFFFF
' /////////////////////////////////////////////////////////////////////////////
' Like IsoLine, we're going to have to draw our lines manually.
' only in this case, we also need a Z coordinate to tell us how
' THICK/TALL/HIGH to make our tile
' MODIFIED by madscijr to draw a single block of height iHeight at Z axis
'Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
' Let's just do all the math first this time.
' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
TempX1 = CX2I(x, y) + xoffset
TempY1 = CY2I(x, y) + yoffset
TempX2 = CX2I(x2, y) + xoffset
TempY2 = CY2I(x2, y) + yoffset
TempX3 = CX2I(x2, y2) + xoffset
TempY3 = CY2I(x2, y2) + yoffset
TempX4 = CX2I(x, y2) + xoffset
TempY4 = CY2I(x, y2) + yoffset
' The top
fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
' the left side
'fquad TempX4, TempY4 - z, TempX4, TempY4, TempX3, TempY3, TempX3, TempY3 - z, _RGB32(.25 * r, .5 * g, .75 * b)
fquad TempX4
, TempY4
- z
, TempX4
, TempY4
- z
+ iHeight
, TempX3
, TempY3
- z
+ iHeight
, TempX3
, TempY3
- z
, _RGB32(.25 * r
, .5 * g
, .75 * b
)
' and then for the right side
'fquad TempX3, TempY3 - z, TempX3, TempY3, TempX2, TempY2, TempX2, TempY2 - z, _RGB32(.75 * r, .3 * g, .3 * b)
fquad TempX3
, TempY3
- z
, TempX3
, TempY3
- z
+ iHeight
, TempX2
, TempY2
- z
+ iHeight
, TempX2
, TempY2
- z
, _RGB32(.75 * r
, .3 * g
, .3 * b
) ' no need to draw any height, if there isn't any.
' /////////////////////////////////////////////////////////////////////////////
' found at abandoned, outdated and now likely malicious qb64 dot net website
' don’t go there: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
' /////////////////////////////////////////////////////////////////////////////
' 2019-11-20 Steve saves some time with STATIC
' and saves and restores last dest
' /////////////////////////////////////////////////////////////////////////////
' original fill quad that may be at fault using Steve's fTri version
' need 4 non linear points (not all on 1 line) list them clockwise
' so x2, y2 is opposite of x4, y4
ftri1 x1, y1, x2, y2, x4, y4, K
ftri1 x3, y3, x2, y2, x4, y4, K
' /////////////////////////////////////////////////////////////////////////////
' update 2019-12-16 needs orig fTri
' need 4 non linear points (not all on 1 line)
' list them clockwise so x2, y2 is opposite of x4, y4
ftri x1, y1, x2, y2, x3, y3, K
ftri x3, y3, x4, y4, x1, y1, K
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
sResult = ""
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
GetBinary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
' See also: GetBit256%, SetBit256%
'DIM iTemp AS INTEGER
iResult = FALSE
bContinue = TRUE
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
'if any of the bits in iBit are false, return false
iResult = FALSE
bContinue = FALSE
iResult = TRUE
GetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the integer that corresponds to a binary string of length 8
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
iResult
= iResult
+ 2 ^ iLoop
* Val(Mid$(strBinary
, Len(strBinary
) - iLoop
, 1))
GetIntegerFromBinary% = iResult
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
IsNum% = TRUE
IsNum% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' 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.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
LongABS& = 0 - lngValue
LongABS& = lngValue
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
'x = 1: y = 2: z$ = "Three"
sError = "Error in PrintFile$ : File not found. Cannot append."
Open sFileName
For Output As #1 ' opens and clears an existing file or creates new empty file ' WRITE places text in quotes in the file
'WRITE #1, x, y, z$
'WRITE #1, sText
' PRINT does not put text inside quotes
'PRINT "File created with data. Press a key!"
'K$ = INPUT$(1) 'press a key
'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
'INPUT #2, a, b, c$
'CLOSE #2
'PRINT a, b, c$
'WRITE a, b, c$
PrintFile$ = sError
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
' 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%
' /////////////////////////////////////////////////////////////////////////////
sFileName = "c:\temp\maze_test_1.txt"
sText
= "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random" bAppend = FALSE
sError = PrintFile$(sFileName, sText, bAppend)
bAppend = TRUE
iErrorCount = 0
iMin = 0
iMax = iCols - 1
iNum = RandomNumber(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
iMin = 0
iMax = iRows - 1
iNum = RandomNumber(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Print "Finished generating numbers. Errors: " + Str$(iErrorCount
) Print "Error creating file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Input "Press <ENTER> to continue", sInput$
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
' VARIABLES:
Dim lngLocation
As Long ' The address of the [Find] substring within the [Text] string. Dim strBefore
As String ' The characters before the string to be replaced. Dim strAfter
As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation
= InStr(1, Text2
, Find2
)
' PROCESSING:
' While [Find2] appears in [Text2]...
' Extract all Text2 before the [Find2] substring:
strBefore
= Left$(Text2
, lngLocation
- 1)
' Extract all text after the [Find2] substring:
strAfter
= Right$(Text2
, ((Len(Text2
) - (lngLocation
+ Len(Find2
) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation
= InStr(1, Text2
, Find2
)
' Next instance of [Find2]...
' OUTPUT:
Replace$ = Text2
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
' See also: GetBit256%, SetBit256%
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
sVal = "1"
sVal = "0"
strResult = ""
strResult = strResult + sVal
strResult
= strResult
+ Mid$(sNum
, iLoop
, 1) iResult = GetIntegerFromBinary%(strResult)
iResult = iNum
SetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' 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.
Sub split
(in$
, delimiter$
, result$
()) start = 1
start = start + 1
finish
= InStr(start
, in$
, delimiter$
) result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////
Input "Press <ENTER> to continue", in$
' /////////////////////////////////////////////////////////////////////////////
' WaitForKey "Press <ESC> to continue", 27, 0
' WaitForKey "Press <ENTER> to begin;", 13, 0
' waitforkey "", 65, 5
Sub WaitForKey
(prompt$
, KeyCode&
, DelaySeconds%
) ' SHOW PROMPT (IF SPECIFIED)
' WAIT FOR KEY
' PAUSE AFTER (IF SPECIFIED)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' NOTE: these are mostly negative numbers
' and have to be forced to positive
' when stored in the dictionary
' (only cEmpty& should be negative)
cOrangeRed&
= _RGB32(255, 69, 0)
cDarkOrange&
= _RGB32(255, 140, 0)
cOrange&
= _RGB32(255, 165, 0)
cYellow&
= _RGB32(255, 255, 0)
cChartreuse&
= _RGB32(127, 255, 0)
cMediumSpringGreen&
= _RGB32(0, 250, 154)
cDeepSkyBlue&
= _RGB32(0, 191, 255)
cDodgerBlue&
= _RGB32(30, 144, 255)
cSeaBlue&
= _RGB32(0, 64, 255)
cBluePurple&
= _RGB32(64, 0, 255)
cDeepPurple&
= _RGB32(96, 0, 255)
cPurple&
= _RGB32(128, 0, 255)
cPurpleRed&
= _RGB32(128, 0, 192)
cDarkRed&
= _RGB32(160, 0, 64)
cBrickRed&
= _RGB32(192, 0, 32)
cDarkGreen&
= _RGB32(0, 100, 0)
cOliveDrab&
= _RGB32(107, 142, 35)
cLightPink&
= _RGB32(255, 182, 193)
cHotPink&
= _RGB32(255, 105, 180)
cDeepPink&
= _RGB32(255, 20, 147)
cMagenta&
= _RGB32(255, 0, 255)
cDimGray&
= _RGB32(105, 105, 105)
cGray&
= _RGB32(128, 128, 128)
cDarkGray&
= _RGB32(169, 169, 169)
cSilver&
= _RGB32(192, 192, 192)
cLightGray&
= _RGB32(211, 211, 211)
cGainsboro&
= _RGB32(220, 220, 220)
cWhiteSmoke&
= _RGB32(245, 245, 245)
cWhite&
= _RGB32(255, 255, 255)
cDarkBrown&
= _RGB32(128, 64, 0)
cLightBrown&
= _RGB32(196, 96, 0)
cKhaki&
= _RGB32(240, 230, 140)
cEmpty& = -1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++