QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: madscijr on November 29, 2021, 06:38:21 pm

Title: Isometric Mapping Demo re-visited
Post by: madscijr on November 29, 2021, 06:38:21 pm
I was playing with the code for the Isometric Mapping Demo
by SMcNeill, bplus, and others, at
https://www.qb64.org/forum/index.php?topic=1903.30 (https://www.qb64.org/forum/index.php?topic=1903.30)
and got it to draw and render some objects in different colors.
I modified the rendering routine to draw a single block at the Z coordinate, instead of drawing UP TO the Z coordinate.
The code is crude but it works - enjoy.

Code: QB64: [Select]
  1. ' Isomatric mapping demo re-revisited
  2. ' Version 2.18 by madscijr
  3.  
  4. ' Based on Isometric Mapping Demo
  5. ' by SMcNeill, bplus, and others at
  6. ' https://www.qb64.org/forum/index.php?topic=1903.30
  7.  
  8. ' This crude version uses a 3-dimensional array (32x32x32)
  9. ' to store blocks of different colors,
  10. ' and draws them to the screen in 2.5D "isometric".
  11.  
  12. Screen _NewImage(1024, 720, 32)
  13. '_ScreenMove _Middle
  14.  
  15. ' ****************************************************************************************************************************************************************
  16. ' ACTIVATE DEBUGGING WINDOW
  17. '$CONSOLE
  18. '_DELAY 4
  19. '_CONSOLE ON
  20. '_ECHO "Debugging on..."
  21. ' ****************************************************************************************************************************************************************
  22.  
  23. ' =============================================================================
  24. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
  25. ' div: int1% = num1% \ den1%
  26. ' mod: rem1% = num1% MOD den1%
  27.  
  28. ' boolean constants
  29. Const FALSE = 0
  30. Const TRUE = Not FALSE
  31.  
  32. ' constants for map
  33. Const cMapEmpty = 0
  34. Const cMapTileFloor = 32
  35. Const cMapRedWall = 1
  36. Const cMapPurpleWall = 2
  37. Const cMapBlueWall = 3
  38. Const cMapGreenWall = 4
  39. Const cMapYellowWall = 5
  40. Const cMapOrangeWall = 6
  41. Const cMapWater = 48
  42.  
  43. ' constants for drawing on the screen
  44. Const cGridOffsetX = 50
  45. Const cGridOffsetY = 50
  46. Const cGridOffsetZ = 0
  47. Const cScreenOffsetX = 450 ' 500
  48. Const cScreenOffsetY = 50 ' 300
  49. Const cScreenOffsetZ = 0
  50.  
  51. ' =============================================================================
  52. ' GLOBAL VARIABLES
  53. Dim ProgramPath$
  54. Dim ProgramName$
  55.  
  56. Dim Shared iGridSize As Integer
  57. Dim arrGrid(32, 32, 32) As _Byte ' x,y,z
  58. Dim iX%
  59. Dim iY%
  60. Dim iZ%
  61. Dim iNextX%
  62. Dim iNextY%
  63. Dim iNextZ%
  64. Dim iMaxSize%
  65. Dim iSize%
  66. Dim iLoopX%
  67. Dim iLoopY%
  68. Dim iPosX1%
  69. Dim iPosX2%
  70. Dim iPosY1%
  71. Dim iPosY2%
  72. Dim iPosZ1%
  73. Dim iPosZ2%
  74. Dim bTile As Integer
  75. Dim iNextWall%
  76. Dim bContinue As Integer
  77. Dim i2$
  78. Dim iMinX%
  79. Dim iMaxX%
  80. Dim iMinY%
  81. Dim iMaxY%
  82. Dim iMinZ%
  83. Dim iMaxZ%
  84. Dim sLine As String
  85. Dim iNext%
  86. Dim iLoop%
  87. Dim iNum%
  88. Dim bFinished As Integer
  89. Dim iCount%
  90. Dim iOpen%
  91. Dim iMove%
  92. Dim bFirst As Integer
  93.  
  94. ' =============================================================================
  95. ' INITIALIZE
  96. ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
  97. ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
  98. iGridSize = 10 ' < 10 is causing problems with PAINT
  99.  
  100. ' -----------------------------------------------------------------------------
  101. ' INITIALIZE MAP TO EMPTY
  102. For iLoopZ% = 0 To 32
  103.     For iLoopX% = 0 To 32
  104.         For iLoopY% = 0 To 32
  105.             arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapEmpty
  106.         Next iLoopY%
  107.     Next iLoopX%
  108. Next iLoopZ%
  109.  
  110. ' -----------------------------------------------------------------------------
  111. ' DRAW FLOOR
  112. iZ% = 0
  113. For iLoopX% = 0 To 32
  114.     For iLoopY% = 0 To 32
  115.         arrGrid(iLoopX%, iLoopY%, iZ%) = cMapTileFloor
  116.     Next iLoopY%
  117. Next iLoopX%
  118.  
  119. ' -----------------------------------------------------------------------------
  120. ' DRAW BLOCKS TO CHECK ORIENTATION
  121. arrGrid(0, 0, 1) = cMapRedWall
  122. arrGrid(32, 0, 1) = cMapBlueWall
  123. arrGrid(0, 32, 1) = cMapGreenWall
  124. arrGrid(32, 32, 1) = cMapYellowWall
  125. arrGrid(0, 16, 1) = cMapOrangeWall
  126. arrGrid(32, 16, 1) = cMapPurpleWall
  127.  
  128. ' -----------------------------------------------------------------------------
  129. ' DRAW SOME OBJECTS
  130.  
  131. If TRUE = TRUE Then
  132.     iX% = 5
  133.     iY% = 2
  134.  
  135.     iNextWall% = cMapRedWall
  136.     iLoopZ% = 1
  137.     iLoopY% = iY%
  138.     For iLoopX% = iX% To (iX% + 10)
  139.         arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
  140.     Next iLoopX%
  141.  
  142.     iNextWall% = cMapBlueWall
  143.     iLoopZ% = 1
  144.     iLoopY% = iY% + 8
  145.     For iLoopX% = iX% To (iX% + 10)
  146.         arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
  147.     Next iLoopX%
  148.  
  149.     iNextWall% = cMapGreenWall
  150.     iLoopZ% = 1
  151.     iLoopX% = iX% + 1
  152.     For iLoopY% = (iY% + 1) To (iY% + 7)
  153.         arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
  154.     Next iLoopY%
  155.  
  156.     iNextWall% = cMapYellowWall
  157.     iLoopZ% = 1
  158.     iLoopX% = iX% + 9
  159.     For iLoopY% = (iY% + 1) To (iY% + 7)
  160.         arrGrid(iLoopX%, iLoopY%, iLoopZ%) = iNextWall%
  161.     Next iLoopY%
  162.  
  163. ' -----------------------------------------------------------------------------
  164. ' DRAW A PYRAMID
  165.  
  166. If TRUE = TRUE Then
  167.     iX% = 15
  168.     iY% = 15
  169.     iZ% = 1
  170.     iPosX1% = iX%
  171.     iPosX2% = iX% + 10
  172.     iPosY1% = iY%
  173.     iPosY2% = iY% + 10
  174.  
  175.     bContinue = TRUE
  176.     Do
  177.         ' PLOT NEXT LEVEL
  178.         For iLoopX% = iPosX1% To iPosX2%
  179.             For iLoopY% = iPosY1% To iPosY2%
  180.                 Select Case iZ% Mod 6
  181.                     Case 1:
  182.                         iNextWall% = cMapRedWall
  183.                     Case 2:
  184.                         iNextWall% = cMapPurpleWall
  185.                     Case 3:
  186.                         iNextWall% = cMapBlueWall
  187.                     Case 4:
  188.                         iNextWall% = cMapGreenWall
  189.                     Case 5:
  190.                         iNextWall% = cMapYellowWall
  191.                     Case Else:
  192.                         iNextWall% = cMapOrangeWall
  193.                 End Select
  194.                 arrGrid(iLoopX%, iLoopY%, iZ%) = iNextWall%
  195.             Next iLoopY%
  196.         Next iLoopX%
  197.  
  198.         ' MOVE UP A LEVEL
  199.         iPosX1% = iPosX1% + 1
  200.         iPosX2% = iPosX2% - 1
  201.         iPosY1% = iPosY1% + 1
  202.         iPosY2% = iPosY2% - 1
  203.  
  204.         ' QUIT AFTER WE REACH THE TOP
  205.         If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
  206.             iZ% = iZ% + 1
  207.         Else
  208.             bContinue = FALSE
  209.         End If
  210.  
  211.     Loop Until bContinue = FALSE
  212.  
  213. ' -----------------------------------------------------------------------------
  214. ' DRAW PIPES
  215.  
  216. IF TRUE=TRUE THEN
  217.         iX% = 5 ' RandomNumber(0, 32)
  218.         iY% = 28 ' RandomNumber(0, 32)
  219.         iZ% = 1 ' 32
  220.        
  221.         bFirst = TRUE
  222.         iMove% = 4
  223.         iCount% = 0
  224.         bFinished = FALSE
  225.         Do
  226.                 iNextX% = iX%
  227.                 iNextY% = iY%
  228.                 iNextZ% = iZ%
  229.  
  230.                 iMove% = iMove% + 1
  231.                 If iMove% > 4 Then
  232.                         iMove% = 0
  233.  
  234.                         If bFirst = TRUE Then
  235.                                 ' MOVE UP FOR FIRST MOVE
  236.                                 iNum% = 2
  237.                                 bFirst = FALSE
  238.                         Else
  239.                                 iNum% = RandomNumber(1, 6)
  240.                         End If
  241.                 End If
  242.  
  243.                 Select Case iNum%
  244.                         Case 1:
  245.                                 If iNextZ% > 0 Then
  246.                                         iNextZ% = iNextZ% - 1
  247.                                 End If
  248.                         Case 2:
  249.                                 If iNextZ% < 32 Then
  250.                                         iNextZ% = iNextZ% + 1
  251.                                 End If
  252.                         Case 3:
  253.                                 If iNextX% > 0 Then
  254.                                         iNextX% = iNextX% - 1
  255.                                 End If
  256.                         Case 4:
  257.                                 If iNextX% < 32 Then
  258.                                         iNextX% = iNextX% + 1
  259.                                 End If
  260.                         Case 5:
  261.                                 If iNextY% > 0 Then
  262.                                         iNextY% = iNextY% - 1
  263.                                 End If
  264.                         Case Else:
  265.                                 If iNextY% < 32 Then
  266.                                         iNextY% = iNextY% + 1
  267.                                 End If
  268.                 End Select
  269.  
  270.                 If arrGrid(iNextX%, iNextY%, iNextZ%) = cMapEmpty Then
  271.                         iCount% = iCount% + 1
  272.                         iX% = iNextX%
  273.                         iY% = iNextY%
  274.                         iZ% = iNextZ%
  275.  
  276.                         Select Case iCount% Mod 6
  277.                                 Case 1:
  278.                                         iNextWall% = cMapRedWall
  279.                                 Case 2:
  280.                                         iNextWall% = cMapPurpleWall
  281.                                 Case 3:
  282.                                         iNextWall% = cMapBlueWall
  283.                                 Case 4:
  284.                                         iNextWall% = cMapGreenWall
  285.                                 Case 5:
  286.                                         iNextWall% = cMapYellowWall
  287.                                 Case Else:
  288.                                         iNextWall% = cMapOrangeWall
  289.                         End Select
  290.                         arrGrid(iX%, iY%, iZ%) = iNextWall%
  291.  
  292.                         ' HAVE WE PLACED MAX # OF BLOCKS?
  293.                         If iCount% > 64 Then
  294.                                 bFinished = TRUE
  295.                         End If
  296.                 Else
  297.                         ' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
  298.                         iOpen% = 0
  299.                         If iZ% > 0 Then
  300.                                 If arrGrid(iX%, iY%, iZ% - 1) <> cMapEmpty Then
  301.                                         iOpen% = iOpen% + 1
  302.                                 End If
  303.                         End If
  304.                         If iZ% < 32 Then
  305.                                 If arrGrid(iX%, iY%, iZ% + 1) <> cMapEmpty Then
  306.                                         iOpen% = iOpen% + 1
  307.                                 End If
  308.                         End If
  309.                         If iX% > 0 Then
  310.                                 If arrGrid(iX% - 1, iY%, iZ%) <> cMapEmpty Then
  311.                                         iOpen% = iOpen% + 1
  312.                                 End If
  313.                         End If
  314.                         If iX% < 32 Then
  315.                                 If arrGrid(iX% + 1, iY%, iZ%) <> cMapEmpty Then
  316.                                         iOpen% = iOpen% + 1
  317.                                 End If
  318.                         End If
  319.                         If iY% > 0 Then
  320.                                 If arrGrid(iX%, iY% - 1, iZ%) <> cMapEmpty Then
  321.                                         iOpen% = iOpen% + 1
  322.                                 End If
  323.                         End If
  324.                         If iY% < 32 Then
  325.                                 If arrGrid(iX%, iY% + 1, iZ%) <> cMapEmpty Then
  326.                                         iOpen% = iOpen% + 1
  327.                                 End If
  328.                         End If
  329.  
  330.                         ' QUIT IF NO OPEN SPACES AVAILABLE
  331.                         If iOpen% = 0 Then
  332.                                 ' NOWHERE TO GO, EXIT
  333.                                 bFinished = TRUE
  334.                         End If
  335.                 End If
  336.  
  337.         Loop Until bFinished = TRUE
  338.  
  339. ' -----------------------------------------------------------------------------
  340. ' Draw the map in 3D Isometic Perspective
  341.  
  342. bTile = FALSE
  343. For iLoopZ% = 0 To 32
  344.     For iLoopX% = 0 To 32 'STEP -1
  345.         For iLoopY% = 0 To 32 'STEP -1
  346.             ' DETERMINE COLOR
  347.             If arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapTileFloor Then
  348.                 If bTile = TRUE Then
  349.                     iColor = cGray&
  350.                     bTile = FALSE
  351.                 Else
  352.                     iColor = cLightGray&
  353.                     bTile = TRUE
  354.                 End If
  355.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapRedWall Then
  356.                 iColor = cRed&
  357.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapBlueWall Then
  358.                 iColor = cBlue&
  359.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapGreenWall Then
  360.                 iColor = cGreen&
  361.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapYellowWall Then
  362.                 iColor = cYellow&
  363.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapOrangeWall Then
  364.                 iColor = cOrange&
  365.             ElseIf arrGrid(iLoopX%, iLoopY%, iLoopZ%) = cMapPurpleWall Then
  366.                 iColor = cPurple&
  367.             Else
  368.                 iColor = cEmpty&
  369.             End If
  370.                        
  371.             ' CALCULATE POSITION
  372.             iZ% = iLoopZ% * iGridSize + cGridOffsetZ
  373.             iPosX1% = iLoopX% * iGridSize + cGridOffsetX
  374.             iPosY1% = iLoopY% * iGridSize + cGridOffsetY
  375.             iPosX2% = iPosX1% + iGridSize
  376.             iPosY2% = iPosY1% + iGridSize
  377.             If iColor <> cEmpty& Then
  378.                 IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iZ%, iGridSize, cScreenOffsetX, cScreenOffsetY, iColor
  379.             End If
  380.  
  381.         Next iLoopY%
  382.     Next iLoopX%
  383. Next iLoopZ%
  384.  
  385. ' -----------------------------------------------------------------------------
  386. ' GIVE OPTION TO VIEW MAP AS TEXT
  387.  
  388. If TRUE = TRUE Then
  389.     Input "See a text dump (y/n)? ", i2$
  390.  
  391.     If LCase$(i2$) = LCase$("y") Then
  392.         iMinX% = -1
  393.         iMaxX% = -1
  394.         iMinY% = -1
  395.         iMaxY% = -1
  396.         iMinZ% = -1
  397.         iMaxZ% = -1
  398.         For iLoopZ% = 0 To 32
  399.             For iLoopX% = 0 To 32
  400.                 For iLoopY% = 0 To 32
  401.                     iNext% = arrGrid(iLoopX%, iLoopY%, iLoopZ%)
  402.                     If iNext% <> cMapEmpty And iNext% <> cMapTileFloor Then
  403.                         If iMinX% = -1 Then
  404.                             iMinX% = iLoopX%
  405.                         End If
  406.                         If iMinY% = -1 Then
  407.                             iMinY% = iLoopY%
  408.                         End If
  409.                         If iMinZ% = -1 Then
  410.                             iMinZ% = iLoopZ%
  411.                         End If
  412.                         If iLoopX% > iMaxX% Then
  413.                             iMaxX% = iLoopX%
  414.                         End If
  415.                         If iLoopY% > iMaxY% Then
  416.                             iMaxY% = iLoopY%
  417.                         End If
  418.                         If iLoopZ% > iMaxZ% Then
  419.                             iMaxZ% = iLoopZ%
  420.                         End If
  421.                     End If
  422.                 Next iLoopY%
  423.             Next iLoopX%
  424.         Next iLoopZ%
  425.  
  426.         For iLoopZ% = iMinZ% To iMaxZ%
  427.             Cls
  428.             Print "Map Z=" + cstr$(iLoopZ%) + ":"
  429.  
  430.             For iLoopY% = iMinY% To iMaxY%
  431.                 sLine = ""
  432.                 For iLoopX% = iMinX% To iMaxX%
  433.                     iNext% = arrGrid(iLoopX%, iLoopY%, iLoopZ%)
  434.                     If iNext% > cMapEmpty Then
  435.                         If iNext% <= cMapOrangeWall Then
  436.                             sLine = sLine + cstr$(iNext%)
  437.                         Else
  438.                             sLine = sLine + " "
  439.                         End If
  440.                     Else
  441.                         sLine = sLine + " "
  442.                     End If
  443.                 Next iLoopX%
  444.                 Print sLine
  445.             Next iLoopY%
  446.  
  447.             If iLoopZ% < iMaxZ% Then
  448.                 Input "Press <ENTER> to continue", i2$
  449.             End If
  450.         Next iLoopZ%
  451.     End If
  452.  
  453. ' ****************************************************************************************************************************************************************
  454. ' DEACTIVATE DEBUGGING WINDOW
  455. '_CONSOLE OFF
  456. ' ****************************************************************************************************************************************************************
  457.  
  458. ' -----------------------------------------------------------------------------
  459. ' FINISHED
  460. Input "Press <ENTER> to continue", i2$
  461.  
  462. System ' return control to the operating system
  463. Print ProgramName$ + " finished."
  464.  
  465. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  466. ' BEGIN GRAPHICS FUNCTIONS
  467. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  468.  
  469. ' /////////////////////////////////////////////////////////////////////////////
  470.  
  471. Function CX2I (x As Long, y As Long) 'Convert Cartesian X To Isometic coordinates
  472.     CX2I = x - y
  473. End Function ' CX2I
  474.  
  475. ' /////////////////////////////////////////////////////////////////////////////
  476.  
  477. Function CY2I (x As Long, y As Long) 'Convert Cartesian Y To Isometic coordinates
  478.     CY2I = (x + y) / 2
  479. End Function ' CY2I
  480.  
  481. ' /////////////////////////////////////////////////////////////////////////////
  482. ' since we're drawing a diamond and not a square box, we can't use Line BF.
  483. ' We have to manually down the 4 points of the line.
  484.  
  485. Sub IsoLine (x, y, x2, y2, xoffset, yoffset, iColor As _Unsigned Long)
  486.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), iColor
  487.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), iColor
  488.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), iColor
  489.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), iColor
  490.     Paint (CX2I(x, y) + xoffset, CY2I(x, y) + 4), iColor 'and fill the diamond solid
  491.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), &HFFFFFFFF
  492.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), &HFFFFFFFF
  493.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), &HFFFFFFFF
  494.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), &HFFFFFFFF
  495. End Sub ' IsoLine
  496.  
  497. ' /////////////////////////////////////////////////////////////////////////////
  498. ' Like IsoLine, we're going to have to draw our lines manually.
  499. ' only in this case, we also need a Z coordinate to tell us how
  500. ' THICK/TALL/HIGH to make our tile
  501.  
  502. ' MODIFIED by madscijr to draw a single block of height iHeight at Z axis
  503.  
  504. 'Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
  505. Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
  506.     r = _Red32(iColor): g = _Green32(iColor): b = _Blue32(iColor)
  507.  
  508.     ' Let's just do all the math first this time.
  509.     ' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
  510.     TempX1 = CX2I(x, y) + xoffset
  511.     TempY1 = CY2I(x, y) + yoffset
  512.     TempX2 = CX2I(x2, y) + xoffset
  513.     TempY2 = CY2I(x2, y) + yoffset
  514.     TempX3 = CX2I(x2, y2) + xoffset
  515.     TempY3 = CY2I(x2, y2) + yoffset
  516.     TempX4 = CX2I(x, y2) + xoffset
  517.     TempY4 = CY2I(x, y2) + yoffset
  518.  
  519.     ' The top
  520.     fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
  521.  
  522.     If z <> 0 Then
  523.         ' the left side
  524.         'fquad TempX4, TempY4 - z, TempX4, TempY4, TempX3, TempY3, TempX3, TempY3 - z, _RGB32(.25 * r, .5 * g, .75 * b)
  525.         fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.25 * r, .5 * g, .75 * b)
  526.  
  527.         ' and then for the right side
  528.         'fquad TempX3, TempY3 - z, TempX3, TempY3, TempX2, TempY2, TempX2, TempY2 - z, _RGB32(.75 * r, .3 * g, .3 * b)
  529.         fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.75 * r, .3 * g, .3 * b)
  530.     Else
  531.         ' no need to draw any height, if there isn't any.
  532.     End If
  533. End Sub ' IsoLine3D
  534.  
  535. ' /////////////////////////////////////////////////////////////////////////////
  536. ' found at abandoned, outdated and now likely malicious qb64 dot net website
  537. ' 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
  538.  
  539. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  540.     Dim D As Long
  541.     Dim a&
  542.  
  543.     D = _Dest
  544.     a& = _NewImage(1, 1, 32)
  545.     _Dest a&
  546.     PSet (0, 0), K
  547.     _Dest D
  548.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  549.     _FreeImage a& ' <<< this is important!
  550. End Sub ' ftri
  551.  
  552. ' /////////////////////////////////////////////////////////////////////////////
  553. ' 2019-11-20 Steve saves some time with STATIC
  554. ' and saves and restores last dest
  555.  
  556. Sub ftri1 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  557.     Dim D As Long
  558.     Static a&
  559.  
  560.     D = _Dest
  561.     If a& = 0 Then
  562.         a& = _NewImage(1, 1, 32)
  563.     End If
  564.     _Dest a&
  565.     _DontBlend a&
  566.     PSet (0, 0), K
  567.     _Blend a&
  568.     _Dest D
  569.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  570. End Sub ' ftri1
  571.  
  572. ' /////////////////////////////////////////////////////////////////////////////
  573. ' original fill quad that may be at fault using Steve's fTri version
  574. ' need 4 non linear points (not all on 1 line) list them clockwise
  575. ' so x2, y2 is opposite of x4, y4
  576.  
  577. Sub fquad1 (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  578.     ftri1 x1, y1, x2, y2, x4, y4, K
  579.     ftri1 x3, y3, x2, y2, x4, y4, K
  580. End Sub ' fquad1
  581.  
  582. ' /////////////////////////////////////////////////////////////////////////////
  583. ' update 2019-12-16 needs orig fTri
  584. ' need 4 non linear points (not all on 1 line)
  585. ' list them clockwise so x2, y2 is opposite of x4, y4
  586.  
  587. Sub fquad (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  588.     ftri x1, y1, x2, y2, x3, y3, K
  589.     ftri x3, y3, x4, y4, x1, y1, K
  590. End Sub ' fquad
  591.  
  592. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  593. ' END GRAPHICS FUNCTIONS
  594. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  595.  
  596. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  597. ' BEGIN GENERAL PURPOSE FUNCTIONS
  598. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  599.  
  600. ' /////////////////////////////////////////////////////////////////////////////
  601.  
  602. Function cstr$ (myValue)
  603.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  604.     cstr$ = _Trim$(Str$(myValue))
  605. End Function ' cstr$
  606.  
  607. ' /////////////////////////////////////////////////////////////////////////////
  608.  
  609. Function cstrl$ (myValue As Long)
  610.     cstrl$ = _Trim$(Str$(myValue))
  611. End Function ' cstrl$
  612.  
  613. ' /////////////////////////////////////////////////////////////////////////////
  614.  
  615. Function cstrs$ (myValue As Single)
  616.     ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  617.     cstrs$ = _Trim$(Str$(myValue))
  618. End Function ' cstrs$
  619.  
  620. ' /////////////////////////////////////////////////////////////////////////////
  621.  
  622. Function IIF (Condition, IfTrue, IfFalse)
  623.     If Condition Then IIF = IfTrue Else IIF = IfFalse
  624.  
  625. ' /////////////////////////////////////////////////////////////////////////////
  626.  
  627. Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
  628.     If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
  629.  
  630. ' /////////////////////////////////////////////////////////////////////////////
  631. ' From: Bitwise Manipulations By Steven Roman
  632. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  633.  
  634. ' Returns the 8-bit binary representation
  635. ' of an integer iInput where 0 <= iInput <= 255
  636.  
  637. Function GetBinary$ (iInput1 As Integer)
  638.     Dim sResult As String
  639.     Dim iLoop As Integer
  640.     Dim iInput As Integer: iInput = iInput1
  641.  
  642.     sResult = ""
  643.  
  644.     If iInput >= 0 And iInput <= 255 Then
  645.         For iLoop = 1 To 8
  646.             sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
  647.             iInput = iInput \ 2
  648.             'If iLoop = 4 Then sResult = " " + sResult
  649.         Next iLoop
  650.     End If
  651.  
  652.     GetBinary$ = sResult
  653. End Function ' GetBinary$
  654.  
  655. ' /////////////////////////////////////////////////////////////////////////////
  656. ' wonderfully inefficient way to read if a bit is set
  657. ' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
  658.  
  659. ' See also: GetBit256%, SetBit256%
  660.  
  661. Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
  662.     Dim iResult As Integer
  663.     Dim sNum As String
  664.     Dim sBit As String
  665.     Dim iLoop As Integer
  666.     Dim bContinue As Integer
  667.     'DIM iTemp AS INTEGER
  668.     Dim iNum As Integer: iNum = iNum1
  669.     Dim iBit As Integer: iBit = iBit1
  670.  
  671.     iResult = FALSE
  672.     bContinue = TRUE
  673.  
  674.     If iNum < 256 And iBit <= 128 Then
  675.         sNum = GetBinary$(iNum)
  676.         sBit = GetBinary$(iBit)
  677.         For iLoop = 1 To 8
  678.             If Mid$(sBit, iLoop, 1) = "1" Then
  679.                 'if any of the bits in iBit are false, return false
  680.                 If Mid$(sNum, iLoop, 1) = "0" Then
  681.                     iResult = FALSE
  682.                     bContinue = FALSE
  683.                     Exit For
  684.                 End If
  685.             End If
  686.         Next iLoop
  687.         If bContinue = TRUE Then
  688.             iResult = TRUE
  689.         End If
  690.     End If
  691.  
  692.     GetBit256% = iResult
  693. End Function ' GetBit256%
  694.  
  695. ' /////////////////////////////////////////////////////////////////////////////
  696. ' From: Bitwise Manipulations By Steven Roman
  697. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  698.  
  699. ' Returns the integer that corresponds to a binary string of length 8
  700.  
  701. Function GetIntegerFromBinary% (sBinary1 As String)
  702.     Dim iResult As Integer
  703.     Dim iLoop As Integer
  704.     Dim strBinary As String
  705.     Dim sBinary As String: sBinary = sBinary1
  706.  
  707.     iResult = 0
  708.     strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
  709.     For iLoop = 0 To Len(strBinary) - 1
  710.         iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
  711.     Next iLoop
  712.  
  713.     GetIntegerFromBinary% = iResult
  714. End Function ' GetIntegerFromBinary%
  715.  
  716. ' /////////////////////////////////////////////////////////////////////////////
  717. ' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
  718.  
  719. Function IsNum% (text$)
  720.     Dim a$
  721.     Dim b$
  722.     a$ = _Trim$(text$)
  723.     b$ = _Trim$(Str$(Val(text$)))
  724.     If a$ = b$ Then
  725.         IsNum% = TRUE
  726.     Else
  727.         IsNum% = FALSE
  728.     End If
  729. End Function ' IsNum%
  730.  
  731. ' /////////////////////////////////////////////////////////////////////////////
  732. ' Split and join strings
  733. ' https://www.qb64.org/forum/index.php?topic=1073.0
  734.  
  735. 'Combine all elements of in$() into a single string with delimiter$ separating the elements.
  736.  
  737. Function join$ (in$(), delimiter$)
  738.     result$ = in$(LBound(in$))
  739.     For i = LBound(in$) + 1 To UBound(in$)
  740.         result$ = result$ + delimiter$ + in$(i)
  741.     Next i
  742.     join$ = result$
  743. End Function ' join$
  744.  
  745. ' /////////////////////////////////////////////////////////////////////////////
  746. ' ABS was returning strange values with type LONG
  747. ' so I created this which does not.
  748.  
  749. Function LongABS& (lngValue As Long)
  750.     If Sgn(lngValue) = -1 Then
  751.         LongABS& = 0 - lngValue
  752.     Else
  753.         LongABS& = lngValue
  754.     End If
  755. End Function ' LongABS&
  756.  
  757. ' /////////////////////////////////////////////////////////////////////////////
  758. ' Returns blank if successful else returns error message.
  759.  
  760. Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
  761.     'x = 1: y = 2: z$ = "Three"
  762.  
  763.     Dim sError As String: sError = ""
  764.  
  765.     If Len(sError) = 0 Then
  766.         If (bAppend = TRUE) Then
  767.             If _FileExists(sFileName) Then
  768.                 Open sFileName For Append As #1 ' opens an existing file for appending
  769.             Else
  770.                 sError = "Error in PrintFile$ : File not found. Cannot append."
  771.             End If
  772.         Else
  773.             Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
  774.         End If
  775.     End If
  776.     If Len(sError) = 0 Then
  777.         ' WRITE places text in quotes in the file
  778.         'WRITE #1, x, y, z$
  779.         'WRITE #1, sText
  780.  
  781.         ' PRINT does not put text inside quotes
  782.         Print #1, sText
  783.  
  784.         Close #1
  785.  
  786.         'PRINT "File created with data. Press a key!"
  787.         'K$ = INPUT$(1) 'press a key
  788.  
  789.         'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
  790.         'INPUT #2, a, b, c$
  791.         'CLOSE #2
  792.  
  793.         'PRINT a, b, c$
  794.         'WRITE a, b, c$
  795.     End If
  796.  
  797.     PrintFile$ = sError
  798. End Function ' PrintFile$
  799.  
  800. ' /////////////////////////////////////////////////////////////////////////////
  801. ' Generate random value between Min and Max.
  802. Function RandomNumber% (Min%, Max%)
  803.     Dim NumSpread%
  804.  
  805.     ' SET RANDOM SEED
  806.     'Randomize ' Initialize random-number generator.
  807.  
  808.     ' GET RANDOM # Min%-Max%
  809.     'RandomNumber = Int((Max * Rnd) + Min) ' generate number
  810.  
  811.     NumSpread% = (Max% - Min%) + 1
  812.  
  813.     RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
  814.  
  815. End Function ' RandomNumber%
  816.  
  817. ' /////////////////////////////////////////////////////////////////////////////
  818.  
  819. Sub RandomNumberTest
  820.     Dim iCols As Integer: iCols = 10
  821.     Dim iRows As Integer: iRows = 20
  822.     Dim iLoop As Integer
  823.     Dim iX As Integer
  824.     Dim iY As Integer
  825.     Dim sError As String
  826.     Dim sFileName As String
  827.     Dim sText As String
  828.     Dim bAppend As Integer
  829.     Dim iMin As Integer
  830.     Dim iMax As Integer
  831.     Dim iNum As Integer
  832.     Dim iErrorCount As Integer
  833.     Dim sInput$
  834.  
  835.     sFileName = "c:\temp\maze_test_1.txt"
  836.     sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
  837.     bAppend = FALSE
  838.     sError = PrintFile$(sFileName, sText, bAppend)
  839.     If Len(sError) = 0 Then
  840.         bAppend = TRUE
  841.         iErrorCount = 0
  842.  
  843.         iMin = 0
  844.         iMax = iCols - 1
  845.         For iLoop = 1 To 100
  846.             iNum = RandomNumber(iMin, iMax)
  847.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  848.             sError = PrintFile$(sFileName, sText, bAppend)
  849.             If Len(sError) > 0 Then
  850.                 iErrorCount = iErrorCount + 1
  851.                 Print Str$(iLoop) + ". ERROR"
  852.                 Print "    " + "iMin=" + Str$(iMin)
  853.                 Print "    " + "iMax=" + Str$(iMax)
  854.                 Print "    " + "iNum=" + Str$(iNum)
  855.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  856.                 Print "    " + sError
  857.             End If
  858.         Next iLoop
  859.  
  860.         iMin = 0
  861.         iMax = iRows - 1
  862.         For iLoop = 1 To 100
  863.             iNum = RandomNumber(iMin, iMax)
  864.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  865.             sError = PrintFile$(sFileName, sText, bAppend)
  866.             If Len(sError) > 0 Then
  867.                 iErrorCount = iErrorCount + 1
  868.                 Print Str$(iLoop) + ". ERROR"
  869.                 Print "    " + "iMin=" + Str$(iMin)
  870.                 Print "    " + "iMax=" + Str$(iMax)
  871.                 Print "    " + "iNum=" + Str$(iNum)
  872.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  873.                 Print "    " + sError
  874.             End If
  875.         Next iLoop
  876.  
  877.         Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
  878.     Else
  879.         Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
  880.         Print sError
  881.     End If
  882.  
  883.     Input "Press <ENTER> to continue", sInput$
  884. End Sub ' RandomNumberTest
  885.  
  886. ' /////////////////////////////////////////////////////////////////////////////
  887. ' FROM: String Manipulation
  888. ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
  889. '
  890. 'SUMMARY:
  891. '   Purpose:  A library of custom functions that transform strings.
  892. '   Author:   Dustinian Camburides (dustinian@gmail.com)
  893. '   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
  894. '   Revision: 1.6
  895. '   Updated:  5/28/2012
  896.  
  897. 'SUMMARY:
  898. '[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
  899. 'INPUT:
  900. 'Text: The input string; the text that's being manipulated.
  901. 'Find: The specified sub-string; the string sought within the [Text] string.
  902. 'Add: The sub-string that's being added to the [Text] string.
  903.  
  904. Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
  905.     ' VARIABLES:
  906.     Dim Text2 As String
  907.     Dim Find2 As String
  908.     Dim Add2 As String
  909.     Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
  910.     Dim strBefore As String ' The characters before the string to be replaced.
  911.     Dim strAfter As String ' The characters after the string to be replaced.
  912.  
  913.     ' INITIALIZE:
  914.     ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
  915.     Text2 = Text1
  916.     Find2 = Find1
  917.     Add2 = Add1
  918.  
  919.     lngLocation = InStr(1, Text2, Find2)
  920.  
  921.     ' PROCESSING:
  922.     ' While [Find2] appears in [Text2]...
  923.     While lngLocation
  924.         ' Extract all Text2 before the [Find2] substring:
  925.         strBefore = Left$(Text2, lngLocation - 1)
  926.  
  927.         ' Extract all text after the [Find2] substring:
  928.         strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
  929.  
  930.         ' Return the substring:
  931.         Text2 = strBefore + Add2 + strAfter
  932.  
  933.         ' Locate the next instance of [Find2]:
  934.         lngLocation = InStr(1, Text2, Find2)
  935.  
  936.         ' Next instance of [Find2]...
  937.     Wend
  938.  
  939.     ' OUTPUT:
  940.     Replace$ = Text2
  941. End Function ' Replace$
  942.  
  943. ' /////////////////////////////////////////////////////////////////////////////
  944. ' fantastically inefficient way to set a bit
  945.  
  946. ' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
  947.  
  948. ' See also: GetBit256%, SetBit256%
  949.  
  950. ' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
  951. Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
  952.     Dim sNum As String
  953.     Dim sBit As String
  954.     Dim sVal As String
  955.     Dim iLoop As Integer
  956.     Dim strResult As String
  957.     Dim iResult As Integer
  958.     Dim iNum As Integer: iNum = iNum1
  959.     Dim iBit As Integer: iBit = iBit1
  960.     Dim bVal As Integer: bVal = bVal1
  961.  
  962.     If iNum < 256 And iBit <= 128 Then
  963.         sNum = GetBinary$(iNum)
  964.         sBit = GetBinary$(iBit)
  965.         If bVal = TRUE Then
  966.             sVal = "1"
  967.         Else
  968.             sVal = "0"
  969.         End If
  970.         strResult = ""
  971.         For iLoop = 1 To 8
  972.             If Mid$(sBit, iLoop, 1) = "1" Then
  973.                 strResult = strResult + sVal
  974.             Else
  975.                 strResult = strResult + Mid$(sNum, iLoop, 1)
  976.             End If
  977.         Next iLoop
  978.         iResult = GetIntegerFromBinary%(strResult)
  979.     Else
  980.         iResult = iNum
  981.     End If
  982.  
  983.     SetBit256% = iResult
  984. End Function ' SetBit256%
  985.  
  986. ' /////////////////////////////////////////////////////////////////////////////
  987. ' Split and join strings
  988. ' https://www.qb64.org/forum/index.php?topic=1073.0
  989. '
  990. ' FROM luke, QB64 Developer
  991. ' Date: February 15, 2019, 04:11:07 AM »
  992. '
  993. ' Given a string of words separated by spaces (or any other character),
  994. ' splits it into an array of the words. I've no doubt many people have
  995. ' written a version of this over the years and no doubt there's a million
  996. ' ways to do it, but I thought I'd put mine here so we have at least one
  997. ' version. There's also a join function that does the opposite
  998. ' array -> single string.
  999. '
  1000. ' Code is hopefully reasonably self explanatory with comments and a little demo.
  1001. ' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
  1002.  
  1003. 'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
  1004. 'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
  1005. '
  1006. 'delimiter$ must be one character long.
  1007. 'result$() must have been REDIMmed previously.
  1008.  
  1009. Sub split (in$, delimiter$, result$())
  1010.     ReDim result$(-1)
  1011.     start = 1
  1012.     Do
  1013.         While Mid$(in$, start, 1) = delimiter$
  1014.             start = start + 1
  1015.             If start > Len(in$) Then Exit Sub
  1016.         Wend
  1017.         finish = InStr(start, in$, delimiter$)
  1018.         If finish = 0 Then finish = Len(in$) + 1
  1019.         ReDim _Preserve result$(0 To UBound(result$) + 1)
  1020.         result$(UBound(result$)) = Mid$(in$, start, finish - start)
  1021.         start = finish + 1
  1022.     Loop While start <= Len(in$)
  1023. End Sub ' split
  1024.  
  1025. ' /////////////////////////////////////////////////////////////////////////////
  1026.  
  1027. Sub SplitTest
  1028.  
  1029.     Dim in$
  1030.     Dim delim$
  1031.     ReDim arrTest$(0)
  1032.     Dim iLoop%
  1033.  
  1034.     delim$ = Chr$(10)
  1035.     in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
  1036.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  1037.     Print "delim$ = " + Chr$(34) + delimeter$ + Chr$(34)
  1038.     split in$, delim$, arrTest$()
  1039.  
  1040.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  1041.         Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
  1042.     Next iLoop%
  1043.     Print
  1044.     Print "Split test finished."
  1045. End Sub ' SplitTest
  1046.  
  1047. ' /////////////////////////////////////////////////////////////////////////////
  1048.  
  1049. Sub WaitForEnter
  1050.     Dim in$
  1051.     Input "Press <ENTER> to continue", in$
  1052. End Sub ' WaitForEnter
  1053.  
  1054. ' /////////////////////////////////////////////////////////////////////////////
  1055. ' WaitForKey "Press <ESC> to continue", 27, 0
  1056. ' WaitForKey "Press <ENTER> to begin;", 13, 0
  1057. ' waitforkey "", 65, 5
  1058.  
  1059. Sub WaitForKey (prompt$, KeyCode&, DelaySeconds%)
  1060.     ' SHOW PROMPT (IF SPECIFIED)
  1061.     If Len(prompt$) > 0 Then
  1062.         If Right$(prompt$, 1) <> ";" Then
  1063.             Print prompt$
  1064.         Else
  1065.             Print Right$(prompt$, Len(prompt$) - 1);
  1066.         End If
  1067.     End If
  1068.  
  1069.     ' WAIT FOR KEY
  1070.     Do: Loop Until _KeyDown(KeyCode&) ' leave loop when specified key pressed
  1071.  
  1072.     ' PAUSE AFTER (IF SPECIFIED)
  1073.     If DelaySeconds% < 1 Then
  1074.         _KeyClear: '_DELAY 1
  1075.     Else
  1076.         _KeyClear: _Delay DelaySeconds%
  1077.     End If
  1078. End Sub ' WaitForKey
  1079.  
  1080. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1081. ' END GENERAL PURPOSE FUNCTIONS
  1082. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1083.  
  1084. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1085. ' BEGIN COLOR FUNCTIONS
  1086. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1087.  
  1088. ' NOTE: these are mostly negative numbers
  1089. '       and have to be forced to positive
  1090. '       when stored in the dictionary
  1091. '       (only cEmpty& should be negative)
  1092.  
  1093. Function cRed& ()
  1094.     cRed& = _RGB32(255, 0, 0)
  1095.  
  1096. Function cOrangeRed& ()
  1097.     cOrangeRed& = _RGB32(255, 69, 0)
  1098. End Function ' cOrangeRed&
  1099.  
  1100. Function cDarkOrange& ()
  1101.     cDarkOrange& = _RGB32(255, 140, 0)
  1102. End Function ' cDarkOrange&
  1103.  
  1104. Function cOrange& ()
  1105.     cOrange& = _RGB32(255, 165, 0)
  1106. End Function ' cOrange&
  1107.  
  1108. Function cGold& ()
  1109.     cGold& = _RGB32(255, 215, 0)
  1110. End Function ' cGold&
  1111.  
  1112. Function cYellow& ()
  1113.     cYellow& = _RGB32(255, 255, 0)
  1114. End Function ' cYellow&
  1115.  
  1116. Function cChartreuse& ()
  1117.     cChartreuse& = _RGB32(127, 255, 0)
  1118. End Function ' cChartreuse&
  1119.  
  1120. Function cLime& ()
  1121.     cLime& = _RGB32(0, 255, 0)
  1122. End Function ' cLime&
  1123.  
  1124. Function cMediumSpringGreen& ()
  1125.     cMediumSpringGreen& = _RGB32(0, 250, 154)
  1126. End Function ' cMediumSpringGreen&
  1127.  
  1128. Function cCyan& ()
  1129.     cCyan& = _RGB32(0, 255, 255)
  1130. End Function ' cCyan&
  1131.  
  1132. Function cDeepSkyBlue& ()
  1133.     cDeepSkyBlue& = _RGB32(0, 191, 255)
  1134. End Function ' cDeepSkyBlue&
  1135.  
  1136. Function cDodgerBlue& ()
  1137.     cDodgerBlue& = _RGB32(30, 144, 255)
  1138. End Function ' cDodgerBlue&
  1139.  
  1140. Function cSeaBlue& ()
  1141.     cSeaBlue& = _RGB32(0, 64, 255)
  1142. End Function ' cSeaBlue&
  1143.  
  1144. Function cBlue& ()
  1145.     cBlue& = _RGB32(0, 0, 255)
  1146. End Function ' cBlue&
  1147.  
  1148. Function cBluePurple& ()
  1149.     cBluePurple& = _RGB32(64, 0, 255)
  1150. End Function ' cBluePurple&
  1151.  
  1152. Function cDeepPurple& ()
  1153.     cDeepPurple& = _RGB32(96, 0, 255)
  1154. End Function ' cDeepPurple&
  1155.  
  1156. Function cPurple& ()
  1157.     cPurple& = _RGB32(128, 0, 255)
  1158. End Function ' cPurple&
  1159.  
  1160. Function cPurpleRed& ()
  1161.     cPurpleRed& = _RGB32(128, 0, 192)
  1162. End Function ' cPurpleRed&
  1163.  
  1164. Function cDarkRed& ()
  1165.     cDarkRed& = _RGB32(160, 0, 64)
  1166. End Function ' cDarkRed&
  1167.  
  1168. Function cBrickRed& ()
  1169.     cBrickRed& = _RGB32(192, 0, 32)
  1170. End Function ' cBrickRed&
  1171.  
  1172. Function cDarkGreen& ()
  1173.     cDarkGreen& = _RGB32(0, 100, 0)
  1174. End Function ' cDarkGreen&
  1175.  
  1176. Function cGreen& ()
  1177.     cGreen& = _RGB32(0, 128, 0)
  1178. End Function ' cGreen&
  1179.  
  1180. Function cOliveDrab& ()
  1181.     cOliveDrab& = _RGB32(107, 142, 35)
  1182. End Function ' cOliveDrab&
  1183.  
  1184. Function cLightPink& ()
  1185.     cLightPink& = _RGB32(255, 182, 193)
  1186. End Function ' cLightPink&
  1187.  
  1188. Function cHotPink& ()
  1189.     cHotPink& = _RGB32(255, 105, 180)
  1190. End Function ' cHotPink&
  1191.  
  1192. Function cDeepPink& ()
  1193.     cDeepPink& = _RGB32(255, 20, 147)
  1194. End Function ' cDeepPink&
  1195.  
  1196. Function cMagenta& ()
  1197.     cMagenta& = _RGB32(255, 0, 255)
  1198. End Function ' cMagenta&
  1199.  
  1200. Function cBlack& ()
  1201.     cBlack& = _RGB32(0, 0, 0)
  1202. End Function ' cBlack&
  1203.  
  1204. Function cDimGray& ()
  1205.     cDimGray& = _RGB32(105, 105, 105)
  1206. End Function ' cDimGray&
  1207.  
  1208. Function cGray& ()
  1209.     cGray& = _RGB32(128, 128, 128)
  1210. End Function ' cGray&
  1211.  
  1212. Function cDarkGray& ()
  1213.     cDarkGray& = _RGB32(169, 169, 169)
  1214. End Function ' cDarkGray&
  1215.  
  1216. Function cSilver& ()
  1217.     cSilver& = _RGB32(192, 192, 192)
  1218. End Function ' cSilver&
  1219.  
  1220. Function cLightGray& ()
  1221.     cLightGray& = _RGB32(211, 211, 211)
  1222. End Function ' cLightGray&
  1223.  
  1224. Function cGainsboro& ()
  1225.     cGainsboro& = _RGB32(220, 220, 220)
  1226. End Function ' cGainsboro&
  1227.  
  1228. Function cWhiteSmoke& ()
  1229.     cWhiteSmoke& = _RGB32(245, 245, 245)
  1230. End Function ' cWhiteSmoke&
  1231.  
  1232. Function cWhite& ()
  1233.     cWhite& = _RGB32(255, 255, 255)
  1234. End Function ' cWhite&
  1235.  
  1236. Function cDarkBrown& ()
  1237.     cDarkBrown& = _RGB32(128, 64, 0)
  1238. End Function ' cDarkBrown&
  1239.  
  1240. Function cLightBrown& ()
  1241.     cLightBrown& = _RGB32(196, 96, 0)
  1242. End Function ' cLightBrown&
  1243.  
  1244. Function cKhaki& ()
  1245.     cKhaki& = _RGB32(240, 230, 140)
  1246. End Function ' cKhaki&
  1247.  
  1248. Function cEmpty& ()
  1249.     cEmpty& = -1
  1250. End Function ' cEmpty&
  1251.  
  1252. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1253. ' END COLOR FUNCTIONS
  1254. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1255.