Author Topic: WIP: Isometric Demo re-revisited v3.02, more shape functions  (Read 3368 times)

0 Members and 1 Guest are viewing this topic.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
WIP: Isometric Demo re-revisited v3.02, more shape functions
« on: December 31, 2021, 04:01:18 pm »
One last tweak to the holiday theme for the year, @bplus!
The code to place the tree lights is the biggest kludge, but it mostly works.
Maybe someone can create a Christmas Tree Construction Set out of this if they get bored.

Under the hood we have some new functions to get circle data and line data in a 2D array
(see GetLineData and GetCircleData subs) which come in handy if you need coordinates for those shapes.

Enjoy and Happy Holidays.

Code: QB64: [Select]
  1. ' ################################################################################################################################################################
  2. ' #TOP
  3.  
  4. ' Isomatric mapping demo re-revisited
  5. ' Version 3.02 by madscijr
  6.  
  7. ' Based on Isometric Mapping Demo
  8. ' by SMcNeill, bplus, and others at
  9. ' https://www.qb64.org/forum/index.php?topic=1903.30
  10.  
  11. ' This crude version uses a 3-dimensional array (32x32x32)
  12. ' to store cubes of different colors,
  13. ' and draws them to the screen in 2.5D "isometric".
  14.  
  15. ' ################################################################################################################################################################
  16. ' #REFERENCE
  17.  
  18. ' =============================================================================
  19. ' SOME USEFUL STUFF FOR REFERENCE:
  20.  
  21. ' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes
  22. ' ---------------------   ------------------   ----------------------------   --------------------------   -------------
  23. ' _BIT                    `                    -1                             0                            1/8
  24. ' _BIT * n                `n                   -128                           127                          n/8
  25. ' _UNSIGNED _BIT          ~`                   0                              1                            1/8
  26. ' _BYTE                   %%                   -128                           127                          1
  27. ' _UNSIGNED _BYTE         ~%%                  0                              255                          1
  28. ' INTEGER                 %                    -32,768                        32,767                       2
  29. ' _UNSIGNED INTEGER       ~%                   0                              65,535                       2
  30. ' LONG                    &                    -2,147,483,648                 2,147,483,647                4
  31. ' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4
  32. ' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8
  33. ' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8
  34. ' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4
  35. ' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8
  36. ' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)
  37. ' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN
  38. ' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN
  39. ' _MEM                    none                 combined memory variable type  N/A                          Use LEN
  40.  
  41. ' div: int1% = num1% \ den1%
  42. ' mod: rem1% = num1% MOD den1%
  43.  
  44. ' ################################################################################################################################################################
  45. ' #CONSTANTS = GLOBAL CONSTANTS
  46.  
  47. ' boolean constants:
  48. Const FALSE = 0
  49. Const TRUE = Not FALSE
  50.  
  51. ' KeyDownConstants:
  52. Const c_iKeyDown_Esc = 27
  53. Const c_iKeyDown_F1 = 15104
  54. Const c_iKeyDown_F2 = 15360
  55. Const c_iKeyDown_F3 = 15616
  56. Const c_iKeyDown_F4 = 15872
  57. Const c_iKeyDown_F5 = 16128
  58. Const c_iKeyDown_F6 = 16384
  59. Const c_iKeyDown_F7 = 16640
  60. Const c_iKeyDown_F8 = 16896
  61. Const c_iKeyDown_F9 = 17152
  62. Const c_iKeyDown_F10 = 17408
  63. Const c_iKeyDown_Tilde = 96
  64. Const c_iKeyDown_1 = 49
  65. Const c_iKeyDown_2 = 50
  66. Const c_iKeyDown_3 = 51
  67. Const c_iKeyDown_4 = 52
  68. Const c_iKeyDown_5 = 53
  69. Const c_iKeyDown_6 = 54
  70. Const c_iKeyDown_7 = 55
  71. Const c_iKeyDown_8 = 56
  72. Const c_iKeyDown_9 = 57
  73. Const c_iKeyDown_0 = 48
  74. Const c_iKeyDown_Minus = 45
  75. Const c_iKeyDown_EqualPlus = 61
  76. Const c_iKeyDown_BkSp = 8
  77. Const c_iKeyDown_Ins = 20992
  78. Const c_iKeyDown_Home = 18176
  79. Const c_iKeyDown_PgUp = 18688
  80. Const c_iKeyDown_Del = 21248
  81. Const c_iKeyDown_End = 20224
  82. Const c_iKeyDown_PgDn = 20736
  83. Const c_iKeyDown_KEYPAD_7_Home = 18176
  84. Const c_iKeyDown_KEYPAD_8_Up = 18432
  85. Const c_iKeyDown_KEYPAD_9_PgUp = 18688
  86. Const c_iKeyDown_KEYPAD_4_Left = 19200
  87. Const c_iKeyDown_KEYPAD_6_Right = 19712
  88. Const c_iKeyDown_KEYPAD_1_End = 20224
  89. Const c_iKeyDown_KEYPAD_2_Down = 20480
  90. Const c_iKeyDown_KEYPAD_3_PgDn = 20736
  91. Const c_iKeyDown_KEYPAD_0_Ins = 20992
  92. Const c_iKeyDown_KEYPAD_Period_Del = 21248
  93. Const c_iKeyDown_Tab = 9
  94. Const c_iKeyDown_Q = 113
  95. Const c_iKeyDown_W = 119
  96. Const c_iKeyDown_E = 101
  97. Const c_iKeyDown_R = 114
  98. Const c_iKeyDown_T = 116
  99. Const c_iKeyDown_Y = 121
  100. Const c_iKeyDown_U = 117
  101. Const c_iKeyDown_Pipe = 105
  102. Const c_iKeyDown_O = 111
  103. Const c_iKeyDown_P = 112
  104. Const c_iKeyDown_BracketLeft = 91
  105. Const c_iKeyDown_BracketRight = 93
  106. Const c_iKeyDown_Backslash = 92
  107. Const c_iKeyDown_A = 97
  108. Const c_iKeyDown_S = 115
  109. Const c_iKeyDown_D = 100
  110. Const c_iKeyDown_F = 102
  111. Const c_iKeyDown_G = 103
  112. Const c_iKeyDown_H = 104
  113. Const c_iKeyDown_J = 106
  114. Const c_iKeyDown_K = 107
  115. Const c_iKeyDown_L = 108
  116. Const c_iKeyDown_SemiColon = 59
  117. Const c_iKeyDown_Apostrophe = 39
  118. Const c_iKeyDown_Enter = 13
  119. Const c_iKeyDown_Z = 22
  120. Const c_iKeyDown_X = 120
  121. Const c_iKeyDown_C = 99
  122. Const c_iKeyDown_V = 118
  123. Const c_iKeyDown_B = 98
  124. Const c_iKeyDown_N = 110
  125. Const c_iKeyDown_M = 109
  126. Const c_iKeyDown_Comma = 44
  127. Const c_iKeyDown_Period = 46
  128. Const c_iKeyDown_Slash = 47
  129. Const c_iKeyDown_Up = 18432
  130. Const c_iKeyDown_Left = 19200
  131. Const c_iKeyDown_Down = 20480
  132. Const c_iKeyDown_Right = 19712
  133. Const c_iKeyDown_Spacebar = 32
  134.  
  135. ' Layers:
  136. Const cTerrainType = 1
  137. Const cObjectsType = 2
  138. Const cPlayersType = 3
  139.  
  140. ' Tiles (for MapTileType.Typ)
  141. Const c_iTile_Empty = 0
  142. Const c_iTile_Floor = 1
  143. Const c_iTile_Wall = 2
  144. Const c_iTile_Water = 3
  145. Const c_iTile_Window = 4
  146. Const c_iTile_Player1 = 5
  147. Const c_iTile_Player2 = 6
  148. Const c_iTile_Player3 = 7
  149. Const c_iTile_Player4 = 8
  150. Const c_iTile_Blinking = 9
  151. Const c_iTile_Snow = 10
  152. Const c_iTile_Slope45 = 11
  153. Const c_iTile_InvSlope45 = 12
  154.  
  155. ' 2.5D movement:
  156. Const c_iDir_Down = 1
  157. Const c_iDir_Up = 2
  158. Const c_iDir_Left = 3
  159. Const c_iDir_Right = 4
  160. Const c_iDir_Back = 5
  161. Const c_iDir_Forward = 6
  162. Const c_iDir_Min = 1
  163. Const c_iDir_Max = 6
  164.  
  165. ' 2.5D screen:
  166. Const cGridOffsetX = 300
  167. Const cGridOffsetY = 50
  168. Const cGridOffsetZ = 0
  169. Const cScreenOffsetX = 500
  170. Const cScreenOffsetY = 300
  171. Const cScreenOffsetZ = 0
  172.  
  173. ' 3D coordinates:
  174. Const cPlaneXY = 1
  175. Const cPlaneYZ = 2
  176. Const cPlaneZX = 3
  177.  
  178. ' xmas object types
  179. Const cXmasStar = 1
  180. Const cXmasSnow = 2
  181. Const cXmasOrnament = 3
  182. Const cXmasLight = 4
  183.  
  184. ' ################################################################################################################################################################
  185. ' #UDT #TYPES = USER DEFINED TYPES
  186.  
  187. Type MapTileType
  188.     Typ As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc.
  189.     'Vis As Integer ' TRUE = visible, FALSE = don't render
  190.     'Lit As Long ' light offset
  191.     Color1 As _Unsigned Long ' main color
  192.     Color2 As _Unsigned Long ' secondary color if needed
  193.     Color3 As _Unsigned Long ' third color if needed
  194.     Alpha1 As Integer ' transparency of tile Color1
  195.     Alpha2 As Integer ' transparency of tile Color2
  196.     Alpha3 As Integer ' transparency of tile Color3
  197.     AlphaOverride As Integer ' can be used to override alpha (255 treated as opaque)
  198.    
  199.     origx As Integer ' used for shear rotation
  200.     origy As Integer ' used for shear rotation
  201.     origz As Integer ' used for shear rotation (added for 3D)
  202.     zone as integer ' used for shear rotation, which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
  203. End Type ' MapTileType
  204.  
  205. Type MapUndoType
  206.     x As Integer
  207.     y As Integer
  208.     z As Integer
  209.     Typ As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc.
  210.     Color1 As _Unsigned Long ' main color
  211.     Alpha1 As Integer ' transparency of tile Color1
  212. End Type ' MapUndoType
  213.  
  214. Type RecordType
  215.     Command As String ' "draw"
  216.     intParam1 As Integer ' x
  217.     intParam2 As Integer ' y
  218.     intParam3 As Integer ' z
  219.     intParam4 As Integer ' tile #
  220.     ulngParam1 As _Unsigned Long ' color1
  221. End Type ' RecordType
  222.  
  223. ' UDT TO HOLD THE INFO FOR A PLAYER
  224. Type PlayerType
  225.     IsEnabled As Integer ' TRUE or FALSE
  226.     x As Integer ' player x position
  227.     y As Integer ' player y position
  228.     z As Integer ' player z position
  229.     Direction As Integer ' direction player is moving: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward; not used: c_iDir_Down, c_iDir_Up
  230.     View As Integer ' player's viewing orientation (direction screen is being looked at from), can be: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  231.     Tile1 As Long ' later we will instead use directional animation sequences
  232.  
  233.     Color1 As _Unsigned Long ' main color
  234.     'Color2 As _Unsigned Long ' secondary color if needed
  235.     'Color3 As _Unsigned Long ' third color if needed
  236.  
  237.     Alpha1 As Integer ' transparency of player Color1
  238.     'Alpha2 As Integer ' transparency of player Color2
  239.     'Alpha3 As Integer ' transparency of player Color3
  240.  
  241.     ColorScheme1 As Long ' for cycling colors
  242.     ColorSchemeSpeed1 As Long
  243.     ColorSchemeCount1 As Long
  244.  
  245.     'ColorScheme2 As Long ' for cycling colors
  246.     'ColorSchemeSpeed2 As Long
  247.     'ColorSchemeCount2 As Long
  248.  
  249.     'ColorScheme3 As Long ' for cycling colors
  250.     'ColorSchemeSpeed3 As Long
  251.     'ColorSchemeCount3 As Long
  252.  
  253.     AlphaOverride As Integer ' can be used to override alpha (0 treated as opaque)
  254.  
  255.     IsMoving As Integer ' TRUE/FALSE
  256.     IsMoved As Integer ' TRUE/FALSE
  257.  
  258.     GridSize As Integer
  259.     MapSize As Integer
  260.  
  261.     'hx AS Integer ' home base x position
  262.     'hy AS Integer ' home base y position
  263.     'ex AS Integer ' exit x position
  264.     'ey AS Integer ' exit y position
  265.     'wins AS Integer ' count # of wins
  266.     'points AS Long ' count points (more points for harder)
  267.     'difficulty AS Integer ' 1-5, from 1 (easiest, maze width 5) to 5 (hardest, maze width 1). Each win awards {difficulty} # of points.
  268.     'speed AS Integer ' the higher the faster
  269.     'delay AS Integer ' counter, player can move based on speed
  270.     'bit AS Integer ' bit value for masking player in map
  271.     'rows AS Integer ' # of rows in player's maze
  272.     'cols AS Integer ' # of columns in player's maze
  273. End Type ' PlayerType
  274.  
  275. ' For snowflakes, lights, Christmas tree star:
  276. ' TODO: generalize this for more complex objects
  277. Type XmasObjectType
  278.     Typ As Integer ' can be: cXmasStar, cXmasSnow, cXmasOrnament, cXmasLight
  279.     IsEnabled As Integer ' TRUE or FALSE
  280.    
  281.     x As Integer ' object x position
  282.     y As Integer ' object y position
  283.     z As Integer ' object z position
  284.     Direction As Integer ' direction object is moving/pointing: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  285.    
  286.     ' tiles + colors
  287.     Tile1 As Long ' tile to draw it with
  288.     Color1 As _Unsigned Long ' main color
  289.     Alpha1 As Integer ' transparency of Color1
  290.     Color2 As _Unsigned Long ' secondary color if needed
  291.     Alpha2 As Integer ' transparency of Color2
  292.     Color3 As _Unsigned Long ' third color if needed
  293.     Alpha3 As Integer ' transparency of Color3
  294.    
  295.     ' dimensions
  296.     xSize As Integer
  297.     ySize As Integer
  298.     zSize As Integer
  299.    
  300.     ' for regulating movement speeds
  301.     xCount As Integer
  302.     xMax As Integer
  303.     xMin As Integer
  304.     yCount As Integer
  305.     yMax As Integer
  306.     yMin As Integer
  307.     zCount As Integer
  308.     zMax As Integer
  309.     zMin As Integer
  310. End Type ' XmasObjectType
  311.  
  312. ' KEY MAPPING v1:
  313. Type DirKeyMapType
  314.     KeyBack As Long
  315.     KeyForward As Long
  316.     KeyLeft As Long
  317.     KeyRight As Long
  318.     KeyUp As Long
  319.     KeyDown As Long
  320. End Type ' DirKeyMapType
  321.  
  322. ' SPLIT SCREEN OFFSETS:
  323. Type SplitScreenType
  324.     ' WHERE TO SHOW THE SPLIT SCREENS
  325.     GridOffsetX As Integer
  326.     GridOffsetY As Integer
  327.     GridOffsetZ As Integer
  328.     ScreenOffsetX As Integer
  329.     ScreenOffsetY As Integer
  330.     ScreenOffsetZ As Integer
  331.  
  332.     ' WHERE TO DRAW THE PLAYER'S MINI MAPS
  333.     MiniMapFirstPersonX As Integer
  334.     MiniMapFirstPersonY As Integer
  335.     MiniMapTopDownX As Integer
  336.     MiniMapTopDownY As Integer
  337.     MiniMapFrontBackX As Integer
  338.     MiniMapFrontBackY As Integer
  339.     MiniMapRightLeftX As Integer
  340.     MiniMapRightLeftY As Integer
  341.  
  342.     ' WHERE TO LOCATE(Y,X) THE PLAYER'S MINI MAP TEXT LABELS
  343.     ' TODO: later this will probably be bitmap text
  344.     MiniMapFirstPersonTextX As Integer
  345.     MiniMapFirstPersonTextY As Integer
  346.     MiniMapTopDownTextX As Integer
  347.     MiniMapTopDownTextY As Integer
  348.     MiniMapFrontBackTextX As Integer
  349.     MiniMapFrontBackTextY As Integer
  350.     MiniMapRightLeftTextX As Integer
  351.     MiniMapRightLeftTextY As Integer
  352. End Type ' SplitScreenType
  353.  
  354. ' For ShearRotate4:
  355. Type RotationType
  356.     origx As Integer
  357.     origy As Integer
  358.     origz As Integer ' added for 3D
  359.     'c As Integer
  360.     zone as integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
  361.    
  362.     Typ As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc.
  363.     Color1 As _Unsigned Long ' main color
  364.     'Color2 As _Unsigned Long ' secondary color if needed
  365.     'Color3 As _Unsigned Long ' third color if needed
  366.     Alpha1 As Integer ' transparency of tile Color1
  367.     'Alpha2 As Integer ' transparency of tile Color2
  368.     'Alpha3 As Integer ' transparency of tile Color3
  369.     'AlphaOverride As Integer ' can be used to override alpha (255 treated as opaque)
  370. End Type ' RotationType
  371.  
  372. Type ColorTextType
  373.     s as string
  374.     fg As _Unsigned Long ' foreground color
  375.     bg As _Unsigned Long ' background color
  376. End Type ' ColorTextType
  377.  
  378. Type xyByteType
  379.     x as _byte
  380.     y as _byte
  381. End Type ' xyByteType
  382.  
  383. Type xyzByteType
  384.     x as _byte
  385.     y as _byte
  386.     z as _byte
  387. End Type ' xyzByteType
  388.  
  389. Type xyIntegerType
  390.     x as integer
  391.     y as integer
  392. End Type ' xyPointType
  393.  
  394. Type xyzIntegerType
  395.     x as integer
  396.     y as integer
  397.     z as integer
  398. End Type ' xyzPointType
  399.  
  400. ' ################################################################################################################################################################
  401. ' #VARS = GLOBAL VARIABLES
  402.  
  403. Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
  404. Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
  405. Dim Shared m_SaveFileName$: m_SaveFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "txt"
  406.  
  407. Dim Shared m_iGridSize As Integer: m_iGridSize = 6 ' BEFORE, < 10 wass causing problems with PAINT, but new method doesn't use PAINT, so nyah!
  408. Dim Shared m_iGridSizeMin As Integer: m_iGridSizeMin = 1
  409. Dim Shared m_iGridSizeMax As Integer: m_iGridSizeMax = 128
  410.  
  411. Dim Shared m_iMapMinX As Integer: m_iMapMinX = 0
  412. Dim Shared m_iMapMaxX As Integer: m_iMapMaxX = 64
  413. Dim Shared m_iMapMidX As Integer: m_iMapMidX = (m_iMapMaxX - m_iMapMinX) \ 2
  414. Dim Shared m_iMapMinY As Integer: m_iMapMinY = 0
  415. Dim Shared m_iMapMaxY As Integer: m_iMapMaxY = 64
  416. Dim Shared m_iMapMidY As Integer: m_iMapMidY = (m_iMapMaxY - m_iMapMinY) \ 2
  417. Dim Shared m_iMapMinZ As Integer: m_iMapMinZ = 0
  418. Dim Shared m_iMapMaxZ As Integer: m_iMapMaxZ = 64
  419. Dim Shared m_iMapMidZ As Integer: m_iMapMidZ = (m_iMapMaxZ - m_iMapMinZ) \ 2
  420.  
  421. Dim Shared m_iPlayerMin As Integer: m_iPlayerMin = 1
  422. Dim Shared m_iPlayerMax As Integer: m_iPlayerMax = 4
  423. Dim Shared m_iPlayerCount As Integer: m_iPlayerCount = 0
  424. Dim Shared m_iObjectCount As Integer: m_iObjectCount = 0 ' <- TO BE USED WHEN WE HAVE OBJECTS
  425.  
  426. Dim Shared m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  427. Dim Shared m_arrRender0(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  428. Dim Shared m_arrRender1(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  429. Dim Shared m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  430. Dim Shared m_arrPlayer(m_iPlayerMin To m_iPlayerMax) As PlayerType
  431. Dim Shared m_arrXmas(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As Integer
  432.  
  433. ' PLACE TEXT INSTRUCTIONS ON SCREEN
  434. Dim Shared m_iInstrStartRow As Integer : m_iInstrStartRow = 3
  435. Dim Shared m_iInstrStartCol As Integer : m_iInstrStartCol = 2
  436. Dim Shared m_iPaletteTextRow As Integer : m_iPaletteTextRow = 17
  437. Dim Shared m_iPaletteTextCol As Integer : m_iPaletteTextCol = 10
  438.  
  439. ' PLACE MINI MAPS ON SCREEN
  440. Dim Shared m_iMiniMapStartRow As Integer : m_iMiniMapStartRow = 800
  441. Dim Shared m_iMiniMapStartCol As Integer : m_iMiniMapStartCol = 300
  442. Dim Shared m_iMiniMapSize As Integer : m_iMiniMapSize = 150
  443.  
  444. ' PLACE MINI MAP TEXT ON SCREEN (150 pixels = 19 text characters)
  445. Dim Shared m_iMiniMapTextStartRow As Integer : m_iMiniMapTextStartRow = 60
  446. Dim Shared m_iMiniMapTextStartCol As Integer : m_iMiniMapTextStartCol = 39
  447. Dim Shared m_iMiniMapTextSize As Integer : m_iMiniMapTextSize = 19
  448.  
  449. ' TODO: ADD UNLIMITED UNDO, FOR NOW ONE LEVEL IS BETTER THAN NONE!
  450. Dim Shared m_MapTileUndo As MapUndoType
  451.  
  452. ' This array is used to hold user's drawing actions,
  453. ' to save drawings and for playback, and later for Undo/Redo.
  454. ' How big will the recording get?
  455. ' Max # tiles in (32x32x32) world = 32,768
  456. ' Max # tiles for 16 (32x32x32) worlds = 524,288
  457. ' Max # tiles for 256 (32x32x32) worlds = 8,388,608
  458. ReDim Shared m_arrRecord(-1) As RecordType
  459.  
  460. ' For each player, map the 6 directional keys differently for each of the 6 directional orientations!
  461. Dim Shared m_arrDirKeyMap(m_iPlayerMin To m_iPlayerMax, c_iDir_Min To c_iDir_Max) As DirKeyMapType
  462.  
  463. ' Store offsets for splitscreen
  464. Dim Shared m_arrSplitScreen(m_iPlayerMin To m_iPlayerMax) As SplitScreenType
  465.  
  466. ' Store colors in an array
  467. Dim Shared m_arrColors(0 To 25) As Long
  468.  
  469. ' ENABLE / DISABLE DEBUG CONSOLE
  470. Dim Shared m_bTesting As Integer : m_bTesting = TRUE
  471.  
  472. ' ENABLE / DISABLE DEBUG GRID
  473. Dim Shared m_bDebugGrid As Integer : m_bDebugGrid = FALSE
  474.  
  475. ' TODO: REPLACE THIS HACK WAY OF TRACKING KEY UP/DOWN
  476. Dim Shared m_bButton_LeftCtrl As Integer: m_bButton_LeftCtrl = FALSE
  477. Dim Shared m_bButton_RightCtrl As Integer: m_bButton_RightCtrl = FALSE
  478. Dim Shared m_bButton_Y As Integer: m_bButton_Y = FALSE
  479. Dim Shared m_bButton_Z As Integer: m_bButton_Z = FALSE
  480.  
  481. ReDim m_arrGreenTreeColors(-1) As _Unsigned Long
  482.  
  483. ' =============================================================================
  484. ' LOCAL VARIABLES
  485. Dim in$
  486.  
  487. ' ****************************************************************************************************************************************************************
  488. ' ACTIVATE DEBUGGING WINDOW
  489. IF m_bTesting = TRUE THEN
  490.     $Console
  491.     _Delay 4
  492.     _Console On
  493.     _Echo "Started " + m_ProgramName$
  494.     _Echo "Debugging on..."
  495. ' ****************************************************************************************************************************************************************
  496.  
  497. ' =============================================================================
  498. ' START THE MAIN ROUTINE
  499. main
  500.  
  501. ' =============================================================================
  502. ' FINISH
  503. Print m_ProgramName$ + " finished."
  504. Input "Press <ENTER> to continue", in$
  505.  
  506. ' ****************************************************************************************************************************************************************
  507. ' DEACTIVATE DEBUGGING WINDOW
  508. IF m_bTesting = TRUE THEN
  509. ' ****************************************************************************************************************************************************************
  510.  
  511. System ' return control to the operating system
  512.  
  513. ' /////////////////////////////////////////////////////////////////////////////
  514.  
  515. Sub main
  516.     Dim RoutineName As String: RoutineName = "main"
  517.     Dim in$
  518.     Dim result$
  519.  
  520.     Screen 0
  521.  
  522.     Do
  523.         Cls
  524.         Print m_ProgramName$
  525.         Print
  526.         Print "Isomatric Mapping Demo Re-visited"
  527.         Print "v3.02, by Softintheheadware (Dec, 2021)"
  528.         Print
  529.         'PRINT "CONTROLS: PRESS <ESC> TO RETURN TO MENU"
  530.         'PRINT "PLAYER  LEFT       RIGHT       UP        DOWN       "
  531.         'PRINT "1       CRSR LEFT  CRSR RIGHT  CRSR UP   CRSR DOWN  "
  532.         'PRINT "2       KEYPAD 4   KEYPAD 6    KEYPAD 8  KEYPAD 2   "
  533.         'PRINT "3       A          S           W         Z          "
  534.         'PRINT "4       J          K           I         M          "
  535.         'PRINT
  536.  
  537.         Print "1. A little holiday message + primitive drawing in 2.5D woohoo!"
  538.         Print "2. PlotLine2DTest$"
  539.         Print "3. GetLineDataTest$"
  540.         Print "4. GetCircleDataTest$"
  541.         'Print "?. BoxDrawTest1$"
  542.         Print
  543.         Print "What to do? ('q' to exit)"
  544.        
  545.         Input in$: in$ = LCase$(Left$(in$, 1))
  546.  
  547.         If in$ = "1" Then
  548.             result$ = IsometricDraw1$
  549.         ElseIf in$ = "2" Then
  550.             result$ = PlotLine2DTest$
  551.         ElseIf in$ = "3" Then
  552.             result$ = GetLineDataTest$
  553.         ElseIf in$ = "4" Then
  554.             result$ = GetCircleDataTest$
  555.         ElseIf in$ = "?" Then
  556.             'result$ = BoxDrawTest1$
  557.         End If
  558.  
  559.         If Len(result$) > 0 Then
  560.             Print result$
  561.         End If
  562.  
  563.     Loop Until in$ = "q"
  564. End Sub ' main
  565.  
  566. ' /////////////////////////////////////////////////////////////////////////////
  567.  
  568. Function IsometricDemo1$
  569.     IsometricDemo1$ = "(TBD)"
  570. End Function ' IsometricDemo1
  571.  
  572. ' /////////////////////////////////////////////////////////////////////////////
  573.  
  574. Function IsometricDemo2$
  575.     IsometricDemo2$ = "(TBD)"
  576. End Function ' IsometricDemo2
  577.  
  578. ' /////////////////////////////////////////////////////////////////////////////
  579.  
  580. Function IsometricDemo3$
  581.     IsometricDemo3$ = "(TBD)"
  582. End Function ' IsometricDemo3
  583.  
  584. ' /////////////////////////////////////////////////////////////////////////////
  585. ' Test all the values 0-255 for style
  586. ' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
  587.  
  588. Function BoxDrawTest1$
  589.     Dim in$
  590.     Dim iSize%
  591.     Dim iDrawX%
  592.     Dim iDrawY%
  593.     Dim iFromX%
  594.     Dim iFromY%
  595.     Dim iToX%
  596.     Dim iToY%
  597.     Dim iNextColor~&
  598.     Dim iLoop As Integer
  599.     Dim iSpace%
  600.     Dim sError As String: sError = ""
  601.  
  602.     iSize% = 48 ' {n}x{n} pixels square
  603.     iDrawX% = 10
  604.     iDrawY% = 10
  605.     iNextColor~& = cWhite
  606.     iSpace% = 8
  607.     Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
  608.     For iLoop = 0 To 255
  609.         DrawStyledOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, iLoop
  610.         'DrawOutlineBox iDrawX%+1, iDrawY%+1, iSize%-2, iNextColor~&, iLoop
  611.  
  612.         iDrawX% = iDrawX% + iSize% + iSpace%
  613.         If iDrawX% > (1280 - (iSize% * 2)) Then
  614.             iDrawX% = 10
  615.             iDrawY% = iDrawY% + iSize% + iSpace%
  616.  
  617.             If iDrawY% > (1024 - (iSize% * 2)) Then
  618.                 sError = "Ran out of Y space."
  619.                 Exit For
  620.             End If
  621.         End If
  622.     Next iLoop
  623.  
  624.     If Len(sError) = 0 Then
  625.         For iLoop = 1 To (iSize% \ 2)
  626.             DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, iLoop
  627.             iDrawX% = iDrawX% + iSize% + iSpace%
  628.             If iDrawX% > (1280 - (iSize% * 2)) Then
  629.                 iDrawX% = 10
  630.                 iDrawY% = iDrawY% + iSize% + iSpace%
  631.                 If iDrawY% > (1024 - (iSize% * 2)) Then
  632.                     sError = "Ran out of Y space."
  633.                     Exit For
  634.                 End If
  635.             End If
  636.         Next iLoop
  637.     End If
  638.  
  639.     Locate 58, 1
  640.     If Len(sError) > 0 Then
  641.         Print sError
  642.     End If
  643.     Input "PRESS <ENTER> TO CONTINUE"; in$
  644.  
  645.     _KeyClear
  646.     Screen 0
  647.  
  648.     BoxDrawTest1$ = ""
  649. End Function ' BoxDrawTest1$
  650.  
  651. ' /////////////////////////////////////////////////////////////////////////////
  652. ' Dependencies: GetCircleRadiusGraph
  653.  
  654. SUB PlotSolidSphere (arrMap() As MapTileType, CX AS INTEGER, CY AS INTEGER, CZ AS INTEGER, R AS INTEGER, iTile As Integer, iColor As _Unsigned Long)
  655.     ReDim arrCircle(-1) As _Byte
  656.     Dim Radius as integer
  657.     Dim iOffset as integer
  658.     Dim iLoopZ as integer
  659.     Dim iNextRadius as integer
  660.     Dim iNextZ as integer
  661.    
  662.     Radius = ABS(R)
  663.     IF Radius = 0 THEN
  664.         EXIT SUB
  665.     END IF
  666.    
  667.     GetCircleRadiusGraph Radius, arrCircle()
  668.     if ubound(arrCircle) > -1 then
  669.         iNextZ = (CZ - Radius) - 1
  670.         for iLoopZ = lbound(arrCircle) to ubound(arrCircle)
  671.             iNextZ = iNextZ + 1
  672.             iNextRadius = arrCircle(iLoopZ)
  673.             if iNextRadius > 0 then
  674.                 if iNextZ >= lbound(arrMap, 3) then
  675.                     ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  676.                     ' CircleFill2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
  677.                     CircleFill2 arrMap(), cPlaneXY, CX, CY, iNextZ, iNextRadius, iTile, iColor
  678.                 end if
  679.             end if
  680.         next iLoopZ
  681.     end if
  682. END SUB ' PlotSolidSphere
  683.  
  684. ' /////////////////////////////////////////////////////////////////////////////
  685. ' Computes a line from x1%,y1% to x2%,y2%
  686. ' and returns a 2-dimensional array MyArray
  687. ' containing the coordinates for each point in the order plotted,
  688. ' in the format
  689. ' MyArray( {point #}, {1=x coordinate, 2=ycoordinate} ) as _byte
  690.  
  691. ' Example:
  692. ' ReDim MyArray(-1, -1) As _Byte
  693. ' GetLineData 1,1,4,6, MyArray()
  694.  
  695. ' computes the points:
  696. ' (X, Y)
  697. ' (1, 1)
  698. ' (2, 2)
  699. ' (2, 3)
  700. ' (3, 4)
  701. ' (3, 5)
  702. ' (4, 6)
  703.  
  704. ' and returns the points in the array:
  705. ' MyArray(1, 1) = 1 ' point #1 x coordinate
  706. ' MyArray(1, 2) = 1 ' point #1 y coordinate
  707. ' MyArray(2, 1) = 2 ' point #2 x coordinate
  708. ' MyArray(2, 2) = 2 ' point #2 y coordinate
  709. ' MyArray(3, 1) = 2 ' point #3 x coordinate
  710. ' MyArray(3, 2) = 3 ' point #3 y coordinate
  711. ' MyArray(4, 1) = 3 ' point #4 x coordinate
  712. ' MyArray(4, 2) = 4 ' point #4 y coordinate
  713. ' MyArray(5, 1) = 3 ' point #5 x coordinate
  714. ' MyArray(5, 2) = 5 ' point #5 y coordinate
  715. ' MyArray(6, 1) = 4 ' point #6 x coordinate
  716. ' MyArray(6, 2) = 6 ' point #6 x coordinate
  717.  
  718. ' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
  719. ' From: http://www.thedubber.altervista.org/qbsrc.htm
  720.  
  721. ' Usage:
  722. ' ReDim MyArray(-1, -1) As _Byte
  723. ' x1%=1: y1%=1: x2%=4 : y2%=6
  724. ' GetLineData x1%, y1%, x2%, y2%, MyArray()
  725. ' for iLoop% = lbound(MyArray, 1) to ubound(MyArray, 1)
  726. '     pointX% = MyArray(iLoop%, 1)
  727. '     pointY% = MyArray(iLoop%, 2)
  728. '     print "point #" + _Trim$(Str$(iLoop%)) + ": x=" + _Trim$(Str$(pointX%)) + ", y=" + _Trim$(Str$(pointY%))
  729. ' next iLoop%
  730.  
  731. Sub GetLineData (x1a%, y1a%, x2a%, y2a%, MyArray() As _Byte)
  732.     Dim iLoop%
  733.     Dim steep%: steep% = 0
  734.     Dim ev%: ev% = 0
  735.     Dim sx%
  736.     Dim sy%
  737.     Dim dx%
  738.     Dim dy%
  739.    
  740.     ' GET PARAMETERS
  741.     Dim x1% : x1% = x1a%
  742.     Dim y1% : y1% = y1a%
  743.     Dim x2% : x2% = x2a%
  744.     Dim y2% : y2% = y2a%
  745.    
  746.     ' FOR LINE ARRAY
  747.     dim iMinX%
  748.     dim iMaxX%
  749.     dim iMinY%
  750.     dim iMaxY%
  751.     'ReDim arrLine(-1, -1) As _Byte
  752.    
  753.     ' INBETWEEN ARRAY
  754.     ReDim arrPoints(-1) As _Byte
  755.    
  756.     ' FOR RETURN ARRAY
  757.     ReDim MyArray(-1, -1) As _Byte
  758.    
  759.    
  760.    
  761.    
  762.     ' CLEANUP INPUT
  763.     x1% = abs(x1%)
  764.     y1% = abs(y1%)
  765.     x2% = abs(x2%)
  766.     y2% = abs(y2%)
  767.    
  768.     ' SETUP RETURN ARRAY
  769.     if x1% > x2% then
  770.         iMinX% = x2%
  771.         iMaxX% = x1%
  772.     else
  773.         iMinX% = x1%
  774.         iMaxX% = x2%
  775.     end if
  776.     if y1% > y2% then
  777.         iMinY% = y2%
  778.         iMaxY% = y1%
  779.     else
  780.         iMinY% = y1%
  781.         iMaxY% = y2%
  782.     end if
  783.    
  784.     if iMinX% > 0 then iMinX% = 1
  785.     if iMinY% > 0 then iMinY% = 1
  786.    
  787.     ReDim arrLine(iMinX% to iMaxX%, iMinY% to iMaxY%) As _Byte
  788.     for sy% = iMinY% to iMaxY%
  789.         For sx% = iMinX% to iMaxX%
  790.             arrLine(sx%, sy%) = 0
  791.         Next sx%
  792.     next sy%
  793.    
  794.     ' DRAW THE LINE
  795.     If (x2% - x1%) > 0 Then
  796.         sx% = 1
  797.     Else
  798.         sx% = -1
  799.     End If
  800.  
  801.     dx% = Abs(x2% - x1%)
  802.     If (y2% - y1%) > 0 Then
  803.         sy% = 1
  804.     Else
  805.         sy% = -1
  806.     End If
  807.  
  808.     dy% = Abs(y2% - y1%)
  809.     If (dy% > dx%) Then
  810.         steep% = 1
  811.         Swap x1%, y1%
  812.         Swap dx%, dy%
  813.         Swap sx%, sy%
  814.     End If
  815.  
  816.     ev% = 2 * dy% - dx%
  817.     For iLoop% = 0 To dx% - 1
  818.         If steep% = 1 Then
  819.             ''''PSET (y1%, x1%), c%:
  820.             '''LOCATE y1%, x1%
  821.             '''PRINT c$;
  822.             ''PlotPoint y1%, x1%, c$, arrLine()
  823.             'arrLine(y1%, x1%) = 1
  824.             REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  825.             arrPoints(UBOUND(arrPoints)) = y1%
  826.             REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  827.             arrPoints(UBOUND(arrPoints)) = x1%
  828.         Else
  829.             ''''PSET (x1%, y1%), c%
  830.             '''LOCATE x1%, y1%
  831.             '''PRINT c$;
  832.             ''PlotPoint x1%, y1%, c$, arrLine()
  833.             'arrLine(x1%, y1%) = 1
  834.             REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  835.             arrPoints(UBOUND(arrPoints)) = x1%
  836.             REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  837.             arrPoints(UBOUND(arrPoints)) = y1%
  838.         End If
  839.  
  840.         While ev% >= 0
  841.             y1% = y1% + sy%
  842.             ev% = ev% - 2 * dx%
  843.         Wend
  844.         x1% = x1% + sx%
  845.         ev% = ev% + 2 * dy%
  846.     Next iLoop%
  847.     ''''PSET (x2%, y2%), c%
  848.     '''LOCATE x2%, y2%
  849.     '''PRINT c$;
  850.     ''PlotPoint x2%, y2%, c$, arrLine()
  851.     'arrLine(x2%, y2%) = 1
  852.     REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  853.     arrPoints(UBOUND(arrPoints)) = x2%
  854.     REDIM _PRESERVE arrPoints(1 TO UBOUND(arrPoints) + 1)
  855.     arrPoints(UBOUND(arrPoints)) = y2%
  856.    
  857.     ' BUILD OUTPUT
  858.     iMaxY% = ((UBOUND(arrPoints) - LBOUND(arrPoints))+1) / 2
  859.     REDIM MyArray(1 To iMaxY%, 1 To 2) AS _Byte
  860.     iMaxY% = 0
  861.     for iLoop% = LBOUND(arrPoints) to UBOUND(arrPoints) step 2
  862.         iMaxY% = iMaxY% + 1
  863.         MyArray(iMaxY%, 1) = arrPoints(iLoop%)
  864.         MyArray(iMaxY%, 2) = arrPoints(iLoop% + 1)
  865.     next iLoop%
  866. End Sub ' GetLineData
  867.  
  868. ' /////////////////////////////////////////////////////////////////////////////
  869.  
  870. function GetLineDataTest$
  871.     dim x1%
  872.     dim y1%
  873.     dim x2%
  874.     dim y2%
  875.     dim in$
  876.     ReDim MyArray(-1, -1) As _Byte
  877.    
  878.     do
  879.         cls
  880.         print "Test of Sub GetLineData (x1%, y1%, x2%, y2%, MyArray() As _Byte)"
  881.         input "ENTER x1,y1,x2,y2 TO PLOT A LINE OR 0 TO EXIT? ";x1%,y1%,x2%,y2%
  882.         if x1%=0 then exit do
  883.        
  884.         GetLineData x1%, y1%, x2%, y2%, MyArray()
  885.        
  886.         ' show array
  887.         Print "              (x, y)"
  888.         for y1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  889.             Print "MyArray(" + right$(" " + cstr$(y1%), 2) + ") = (" + cstr$(MyArray(y1%, 1)) + ", " + cstr$(MyArray(y1%, 2)) + ")"
  890.         next y1%
  891.        
  892.         ' pause
  893.         print
  894.         input "PRESS <ENTER> TO CONTINUE";in$
  895.        
  896.     loop
  897.    
  898. end function ' GetLineDataTest$
  899.  
  900. ' /////////////////////////////////////////////////////////////////////////////
  901. ' Computes a circle of radius R
  902. ' and returns a 2-dimensional array MyArray
  903. ' containing the coordinates for each point in the order plotted,
  904. ' in the format
  905. ' MyArray( {point #}, {1=x coordinate, 2=ycoordinate} ) as _byte
  906.  
  907. ' Based on:
  908. ' Fast circle drawing in pure Atari BASIC#
  909. ' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
  910.  
  911. ' Usage:
  912. ' ReDim arrCircle(-1, -1) As _Byte
  913. ' radius%=3
  914. ' GetCircleData radius%, arrCircle()
  915. ' for iLoop% = lbound(arrCircle, 1) to ubound(arrCircle, 1)
  916. '     pointX% = arrCircle(iLoop%, 1)
  917. '     pointY% = arrCircle(iLoop%, 2)
  918. '     print "point #" + _Trim$(Str$(iLoop%)) + ": x=" + _Trim$(Str$(pointX%)) + ", y=" + _Trim$(Str$(pointY%))
  919. ' next iLoop%
  920. Sub GetCircleData (R As Integer, MyArray() As _Byte)
  921.     Dim A As Integer
  922.     Dim B As Integer
  923.     Dim C As Integer
  924.     DIM Radius AS INTEGER
  925.    
  926.     ' FOR RETURN ARRAY
  927.     dim iMin%
  928.     dim iMax%
  929.     dim iMid%
  930.     ReDim MyArray(-1, -1) As _Byte
  931.    
  932.     ' INBETWEEN ARRAY
  933.     dim iX as integer
  934.     dim iY as integer
  935.     dim iCount as integer
  936.     ReDim arrPoints(-1) As _Byte
  937.    
  938.     ' CHECK IF VALUE != 0
  939.     Radius = ABS(R)
  940.     If Radius > 0 Then
  941.         ' SETUP RETURN ARRAY
  942.         iMin% = 0
  943.         iMid% = Radius
  944.         iMax% = (Radius * 2)
  945.         ReDim MyArray(iMin% to iMax%, iMin% to iMax%) As _Byte
  946.         for iY = lbound(MyArray, 1) to ubound (MyArray, 1)
  947.             for iX = lbound(MyArray, 2) to ubound (MyArray, 2)
  948.                 MyArray(iX, iY) = 0
  949.             next iX
  950.         next iY
  951.        
  952.         ' PLOT CIRCLE
  953.         B = Radius
  954.         C = 0
  955.         A = Radius - 1
  956.         Do
  957.             ' quadrant #1
  958.             MyArray(Radius + C, Radius - B) = 1 ' 2
  959.             MyArray(Radius + B, Radius - C) = 2 ' 6
  960.            
  961.             ' quadrant #2
  962.             MyArray(Radius + B, Radius + C) = 3 ' 5
  963.             MyArray(Radius + C, Radius + B) = 4 ' 1
  964.            
  965.             ' quadrant #3
  966.             MyArray(Radius - C, Radius + B) = 5 ' 4
  967.             MyArray(Radius - B, Radius + C) = 6 ' 8
  968.            
  969.             ' quadrant #4
  970.             MyArray(Radius - B, Radius - C) = 7 ' 7
  971.             MyArray(Radius - C, Radius - B) = 8 ' 3
  972.            
  973.             C = C + 1
  974.             A = A + 1 - C - C
  975.             If A < 0 Then ' IF A>=0 THEN 190
  976.                 B = B - 1
  977.                 A = A + B + B
  978.             End If
  979.             If B < C Then Exit Do ' 190 IF B>=C THEN 60
  980.         Loop
  981.        
  982.         ' NOW GET POINTS IN ORDER
  983.         iCount = -1
  984.        
  985.         ' quadrant #1
  986.         for iY = iMin% to iMid%
  987.             for iX = iMid% to iMax%
  988.                 if MyArray(iX, iY) > 0 then
  989.                     iCount = iCount + 2
  990.                     ReDim _PRESERVE arrPoints(1 To iCount+1)
  991.                     arrPoints(iCount) = iX
  992.                     arrPoints(iCount+1) = iY
  993.                 end if
  994.             next iX
  995.         next iY
  996.        
  997.         ' quadrant #2
  998.         for iY = (iMid%+1) to iMax%
  999.             for iX = iMax% to iMid% step -1
  1000.                 if MyArray(iX, iY) > 0 then
  1001.                     iCount = iCount + 2
  1002.                     ReDim _PRESERVE arrPoints(1 To iCount+1)
  1003.                     arrPoints(iCount) = iX
  1004.                     arrPoints(iCount+1) = iY
  1005.                 end if
  1006.             next iX
  1007.         next iY
  1008.            
  1009.         ' quadrant #3
  1010.         for iY = iMax% to (iMid%+1) step -1
  1011.             for iX = (iMid%-1) to iMin% step -1
  1012.                 if MyArray(iX, iY) > 0 then
  1013.                     iCount = iCount + 2
  1014.                     ReDim _PRESERVE arrPoints(1 To iCount+1)
  1015.                     arrPoints(iCount) = iX
  1016.                     arrPoints(iCount+1) = iY
  1017.                 end if
  1018.             next iX
  1019.         next iY
  1020.        
  1021.         ' quadrant #4
  1022.         for iY = iMid% to iMin% step -1
  1023.             for iX = iMin% to (iMid%-1)
  1024.                 if MyArray(iX, iY) > 0 then
  1025.                     iCount = iCount + 2
  1026.                     ReDim _PRESERVE arrPoints(1 To iCount+1)
  1027.                     arrPoints(iCount) = iX
  1028.                     arrPoints(iCount+1) = iY
  1029.                 end if
  1030.             next iX
  1031.         next iY
  1032.  
  1033.         '' *****************************************************************************
  1034.         '' DEBUG
  1035.         'dim sLine as string
  1036.         'dim in$
  1037.         '
  1038.         '' number columns at top
  1039.         'sLine = "  "
  1040.         'for iX = lbound(MyArray, 1) to ubound(MyArray, 1)
  1041.         '    sLine = sLine + left$(right$(" " + cstr$(iX), 2), 1)
  1042.         'next iX
  1043.         'print sLine
  1044.         'sLine = "  "
  1045.         'for iX = lbound(MyArray, 1) to ubound(MyArray, 1)
  1046.         '    sLine = sLine + right$(cstr$(iX), 1)
  1047.         'next iX
  1048.         'print sLine
  1049.         '
  1050.         'for iY = iMin% to iMax%
  1051.         '    
  1052.         '    sLine = right$(" " + cstr$(iY), 2) ' number rows on left
  1053.         '    
  1054.         '    for iX = iMin% to iMax%
  1055.         '        
  1056.         '        if MyArray(iX, iY) > 0 then
  1057.         '            sLine = sLine + "#"
  1058.         '        else
  1059.         '            sLine = sLine + " "
  1060.         '        end if
  1061.         '    next iX
  1062.         '    
  1063.         '    sLine = sLine + cstr$(iY) ' number rows on right
  1064.         '    print sLine
  1065.         '    
  1066.         'next iY
  1067.         '
  1068.         '' number columns on bottom
  1069.         'sLine = "  "
  1070.         'for iX = lbound(MyArray, 1) to ubound(MyArray, 1)
  1071.         '    sLine = sLine + right$(cstr$(iX), 1)
  1072.         'next iX
  1073.         'print sLine
  1074.         'sLine = "  "
  1075.         'for iX = lbound(MyArray, 1) to ubound(MyArray, 1)
  1076.         '    sLine = sLine + left$(right$(" " + cstr$(iX), 2), 1)
  1077.         'next iX
  1078.         'print sLine
  1079.         '
  1080.         '' pause
  1081.         'input "PRESS <ENTER> TO CONTINUE";in$
  1082.         '' *****************************************************************************
  1083.        
  1084.         ' BUILD OUTPUT
  1085.         iMax% = ((UBOUND(arrPoints) - LBOUND(arrPoints))+1) / 2
  1086.         REDIM MyArray(1 To iMax%, 1 To 2) AS _Byte
  1087.         iCount = 0
  1088.         for iLoop% = LBOUND(arrPoints) to UBOUND(arrPoints) step 2
  1089.             iCount = iCount + 1
  1090.             MyArray(iCount, 1) = arrPoints(iLoop%)
  1091.             MyArray(iCount, 2) = arrPoints(iLoop% + 1)
  1092.         next iLoop%
  1093.        
  1094.     End If
  1095. End Sub ' GetCircleData
  1096.  
  1097. ' /////////////////////////////////////////////////////////////////////////////
  1098.  
  1099. function GetCircleDataTest$
  1100.     dim R as Integer
  1101.     dim in$
  1102.     ReDim MyArray(-1, -1) As _Byte
  1103.    
  1104.     do
  1105.         cls
  1106.         print "Test of Sub GetCircleData (R, MyArray() As _Byte)"
  1107.         input "ENTER radius R TO PLOT A CIRCLE OR 0 TO EXIT? ";R
  1108.         if R=0 then exit do
  1109.        
  1110.         GetCircleData R, MyArray()
  1111.        
  1112.         ' show array
  1113.         Print "              (x, y)"
  1114.         for y1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1115.             Print "MyArray(" + right$(" " + cstr$(y1%), 2) + ") = (" + cstr$(MyArray(y1%, 1)) + ", " + cstr$(MyArray(y1%, 2)) + ")"
  1116.         next y1%
  1117.        
  1118.         ' pause
  1119.         print
  1120.         input "PRESS <ENTER> TO CONTINUE";in$
  1121.        
  1122.     loop
  1123.    
  1124. end function ' GetCircleDataTest$
  1125.  
  1126. ' /////////////////////////////////////////////////////////////////////////////
  1127. ' Based on "BRESNHAM.BAS" by Kurt Kuzba. (4/16/96)
  1128. ' From: http://www.thedubber.altervista.org/qbsrc.htm
  1129.  
  1130. Sub PlotLine2D (x1a%, y1a%, x2a%, y2a%, MyArray() As _Byte)
  1131.     Dim iLoop%
  1132.     Dim steep%: steep% = 0
  1133.     Dim ev%: ev% = 0
  1134.     Dim sx%
  1135.     Dim sy%
  1136.     Dim dx%
  1137.     Dim dy%
  1138.    
  1139.     ' GET PARAMETERS
  1140.     Dim x1% : x1% = x1a%
  1141.     Dim y1% : y1% = y1a%
  1142.     Dim x2% : x2% = x2a%
  1143.     Dim y2% : y2% = y2a%
  1144.    
  1145.     ' FOR RETURN ARRAY
  1146.     dim iMinX%
  1147.     dim iMaxX%
  1148.     dim iMinY%
  1149.     dim iMaxY%
  1150.     ReDim MyArray(-1, -1) As _Byte
  1151.    
  1152.     ' CLEANUP INPUT
  1153.     x1% = abs(x1%)
  1154.     y1% = abs(y1%)
  1155.     x2% = abs(x2%)
  1156.     y2% = abs(y2%)
  1157.    
  1158.     ' SETUP RETURN ARRAY
  1159.     if x1% > x2% then
  1160.         iMinX% = x2%
  1161.         iMaxX% = x1%
  1162.     else
  1163.         iMinX% = x1%
  1164.         iMaxX% = x2%
  1165.     end if
  1166.     if y1% > y2% then
  1167.         iMinY% = y2%
  1168.         iMaxY% = y1%
  1169.     else
  1170.         iMinY% = y1%
  1171.         iMaxY% = y2%
  1172.     end if
  1173.    
  1174.     if iMinX% > 0 then iMinX% = 1
  1175.     if iMinY% > 0 then iMinY% = 1
  1176.    
  1177.     ReDim MyArray(iMinX% to iMaxX%, iMinY% to iMaxY%) As _Byte
  1178.     for sy% = iMinY% to iMaxY%
  1179.         For sx% = iMinX% to iMaxX%
  1180.             MyArray(sx%, sy%) = 0
  1181.         Next sx%
  1182.     next sy%
  1183.    
  1184.     ' DRAW THE LINE
  1185.     If (x2% - x1%) > 0 Then
  1186.         sx% = 1
  1187.     Else
  1188.         sx% = -1
  1189.     End If
  1190.  
  1191.     dx% = Abs(x2% - x1%)
  1192.     If (y2% - y1%) > 0 Then
  1193.         sy% = 1
  1194.     Else
  1195.         sy% = -1
  1196.     End If
  1197.  
  1198.     dy% = Abs(y2% - y1%)
  1199.     If (dy% > dx%) Then
  1200.         steep% = 1
  1201.         Swap x1%, y1%
  1202.         Swap dx%, dy%
  1203.         Swap sx%, sy%
  1204.     End If
  1205.  
  1206.     ev% = 2 * dy% - dx%
  1207.     For iLoop% = 0 To dx% - 1
  1208.         If steep% = 1 Then
  1209.             '''PSET (y1%, x1%), c%:
  1210.             ''LOCATE y1%, x1%
  1211.             ''PRINT c$;
  1212.             'PlotPoint y1%, x1%, c$, MyArray()
  1213.             MyArray(y1%, x1%) = 1
  1214.         Else
  1215.             '''PSET (x1%, y1%), c%
  1216.             ''LOCATE x1%, y1%
  1217.             ''PRINT c$;
  1218.             'PlotPoint x1%, y1%, c$, MyArray()
  1219.             MyArray(x1%, y1%) = 1
  1220.         End If
  1221.  
  1222.         While ev% >= 0
  1223.             y1% = y1% + sy%
  1224.             ev% = ev% - 2 * dx%
  1225.         Wend
  1226.         x1% = x1% + sx%
  1227.         ev% = ev% + 2 * dy%
  1228.     Next iLoop%
  1229.     '''PSET (x2%, y2%), c%
  1230.     ''LOCATE x2%, y2%
  1231.     ''PRINT c$;
  1232.     'PlotPoint x2%, y2%, c$, MyArray()
  1233.     MyArray(x2%, y2%) = 1
  1234.    
  1235. End Sub ' PlotLine2D
  1236.  
  1237. ' /////////////////////////////////////////////////////////////////////////////
  1238.  
  1239. function PlotLine2DTest$
  1240.     dim x1%
  1241.     dim y1%
  1242.     dim x2%
  1243.     dim y2%
  1244.     dim sLine as string
  1245.     dim in$
  1246.     ReDim MyArray(-1, -1) As _Byte
  1247.    
  1248.     do
  1249.         cls
  1250.         input "ENTER x1,y1,x2,y2 TO PLOT A LINE OR 0 TO EXIT? ";x1%,y1%,x2%,y2%
  1251.         if x1%=0 then exit do
  1252.        
  1253.         PlotLine2D x1%, y1%, x2%, y2%, MyArray()
  1254.        
  1255.         ' number columns at top
  1256.         sLine = "  "
  1257.         for x1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1258.             sLine = sLine + left$(right$(" " + cstr$(x1%), 2), 1)
  1259.         next x1%
  1260.         print sLine
  1261.         sLine = "  "
  1262.         for x1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1263.             sLine = sLine + right$(cstr$(x1%), 1)
  1264.         next x1%
  1265.         print sLine
  1266.        
  1267.         ' show array
  1268.         for y1% = lbound(MyArray, 2) to ubound(MyArray, 2)
  1269.             sLine = right$(" " + cstr$(y1%), 2) ' number rows on left
  1270.             for x1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1271.                 if MyArray(x1%, y1%)=0 then
  1272.                     sLine = sLine + " "
  1273.                 else
  1274.                     sLine = sLine + "#"
  1275.                 end if
  1276.             next x1%
  1277.             sLine = sLine + cstr$(y1%) ' number rows on right
  1278.             print sLine
  1279.         next y1%
  1280.        
  1281.         ' number columns on bottom
  1282.         sLine = "  "
  1283.         for x1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1284.             sLine = sLine + right$(cstr$(x1%), 1)
  1285.         next x1%
  1286.         print sLine
  1287.         sLine = "  "
  1288.         for x1% = lbound(MyArray, 1) to ubound(MyArray, 1)
  1289.             sLine = sLine + left$(right$(" " + cstr$(x1%), 2), 1)
  1290.         next x1%
  1291.         print sLine
  1292.        
  1293.         ' pause
  1294.         print
  1295.         input "PRESS <ENTER> TO CONTINUE";in$
  1296.        
  1297.     loop
  1298.    
  1299. end function ' PlotLine2DTest$
  1300.  
  1301.  
  1302.  
  1303.  
  1304.  
  1305.  
  1306.  
  1307.  
  1308.  
  1309.  
  1310.  
  1311.  
  1312.  
  1313.  
  1314. ' /////////////////////////////////////////////////////////////////////////////
  1315. ' Used by PlotSolidSphere
  1316. ' Dependencies: CircleFill2D
  1317.  
  1318. SUB GetCircleRadiusGraph(R AS INTEGER, MyArray() As _Byte)
  1319.     ReDim arrCircle(-1, -1) As _Byte
  1320.     DIM Radius AS INTEGER
  1321.     Dim iLoopX as INTEGER
  1322.     Dim iLoopY as INTEGER
  1323.     Dim iCount as INTEGER
  1324.    
  1325.     Radius = ABS(R)
  1326.     CircleFill2D Radius, arrCircle()
  1327.    
  1328.     if ubound(arrCircle, 1) > 0 then
  1329.         ReDim MyArray(1 to ubound(arrCircle, 2)) As _Byte
  1330.         For iLoopY = 1 to ubound(arrCircle, 2) ' Radius
  1331.             iCount = 0
  1332.             For iLoopX = 1 to ubound(arrCircle, 1)/2 ' Radius
  1333.                 if arrCircle(iLoopX, iLoopY) = 1 then
  1334.                     iCount = iCount + 1
  1335.                 end if
  1336.             Next iLoopX
  1337.             MyArray(iLoopY) = iCount
  1338.         Next iLoopY
  1339.     else
  1340.         ReDim MyArray(-1) As _Byte
  1341.     end if
  1342. END SUB ' GetCircleRadiusGraph
  1343.  
  1344. ' /////////////////////////////////////////////////////////////////////////////
  1345. ' Used by GetCircleRadiusGraph
  1346.  
  1347. SUB CircleFill2D (R AS INTEGER, MyArray() As _Byte)
  1348.     DIM Radius AS INTEGER
  1349.     Dim RadiusError AS INTEGER
  1350.     DIM X AS INTEGER
  1351.     Dim Y AS INTEGER
  1352.     Dim iLoopX as INTEGER
  1353.     Dim iLoopY as INTEGER
  1354.     Dim CX AS INTEGER
  1355.     Dim CY AS INTEGER
  1356.    
  1357.     Radius = ABS(R)
  1358.     RadiusError = -Radius
  1359.     X = Radius
  1360.     Y = 0
  1361.    
  1362.     IF Radius = 0 THEN
  1363.         ReDim MyArray(-1, -1) As _Byte
  1364.         'PSET (CX, CY), C
  1365.         'PlotPoint CX, CY, S, MyArray()
  1366.         EXIT SUB
  1367.     END IF
  1368.    
  1369.     'ReDim MyArray(1 to Radius, 1 to Radius) As _Byte
  1370.     ReDim MyArray(1 to (Radius*2)+1, 1 to (Radius*2)+1) As _Byte
  1371.     For iLoopY = 1 to ubound(MyArray, 2)
  1372.         For iLoopX = 1 to ubound(MyArray, 1)
  1373.             MyArray(iLoopX, iLoopY) = 0
  1374.         Next iLoopX
  1375.     Next iLoopY
  1376.    
  1377.     CX = Radius + 1 '/ 2
  1378.     CY = Radius + 1'/ 2
  1379.    
  1380.     ' Draw the middle span here so we don't draw it twice in the main loop,
  1381.     ' which would be a problem with blending turned on.
  1382.     'LINE (CX - X, CY)-(CX + X, CY), C, BF
  1383.     FOR iLoopX = CX - X TO CX + X
  1384.         MyArray(iLoopX, CY) = 1
  1385.     NEXT iLoopX
  1386.    
  1387.     WHILE X > Y
  1388.         RadiusError = RadiusError + Y * 2 + 1
  1389.         IF RadiusError >= 0 THEN
  1390.             IF X <> Y + 1 THEN
  1391.                 'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  1392.                 iLoopY = CY - X
  1393.                 FOR iLoopX = CX - Y TO CX + Y
  1394.                     MyArray(iLoopX, iLoopY) = 1
  1395.                 NEXT iLoopX
  1396.                
  1397.                 'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  1398.                 iLoopY = CY + X
  1399.                 FOR iLoopX = CX - Y TO CX + Y
  1400.                     MyArray(iLoopX, iLoopY) = 1
  1401.                 NEXT iLoopX
  1402.             END IF
  1403.             X = X - 1
  1404.             RadiusError = RadiusError - X * 2
  1405.         END IF
  1406.         Y = Y + 1
  1407.         'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  1408.         iLoopY = CY - Y
  1409.         FOR iLoopX = CX - X TO CX + X
  1410.             MyArray(iLoopX, iLoopY) = 1
  1411.         NEXT iLoopX
  1412.        
  1413.         'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  1414.         iLoopY = CY + Y
  1415.         FOR iLoopX = CX - X TO CX + X
  1416.             MyArray(iLoopX, iLoopY) = 1
  1417.         NEXT iLoopX
  1418.     WEND
  1419. END SUB ' CircleFill2D
  1420.  
  1421.  
  1422.  
  1423.  
  1424.  
  1425.  
  1426.  
  1427.  
  1428.  
  1429.  
  1430.  
  1431.  
  1432.  
  1433.  
  1434.  
  1435. ' /////////////////////////////////////////////////////////////////////////////
  1436. ' receives x,y,z coordinates of the back, bottom, left corner
  1437. ' and width, length, height for the size
  1438. ' where
  1439. ' X1 is the x dimension, the size of which is W1 width
  1440. ' Y1 is the y dimension, the size of which is L1 length
  1441. ' Z1 is the z dimension, the size of which is H1 height
  1442. ' and draws a tile iTile in the color iColor
  1443. ' using PlotTile
  1444.  
  1445. ' usage:
  1446. ' PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
  1447.  
  1448. ' TODO: add parameter to specify array to plot to
  1449.  
  1450. Sub PlotCuboid (X1 As Integer, W1 As Integer, Y1 As Integer, L1 As Integer, Z1 As Integer, H1 As Integer, iTile As Integer, iColor As _Unsigned Long)
  1451.     Dim iX As Integer
  1452.     Dim X2 As Integer
  1453.     Dim iY As Integer
  1454.     Dim Y2 As Integer
  1455.     Dim iZ As Integer
  1456.     Dim Z2 As Integer
  1457.    
  1458.     if W1 > 0 then
  1459.         if L1 > 0 then
  1460.             if H1 > 0 then
  1461.                 X2 = (X1 + W1) - 1
  1462.                 Y2 = (Y1 + L1) - 1
  1463.                 Z2 = (Z1 + H1) - 1
  1464.                 For iX = X1 To X2
  1465.                     For iY = Y1 To Y2
  1466.                         For iZ = Z1 To Z2
  1467.                             PlotTile iX, iY, iZ, iTile, iColor
  1468.                         Next iZ
  1469.                     Next iY
  1470.                 Next iX
  1471.             end if
  1472.         end if
  1473.     end if
  1474. End Sub ' PlotCuboid
  1475.  
  1476. ' /////////////////////////////////////////////////////////////////////////////
  1477. ' Fast circle drawing in pure Atari BASIC#
  1478. ' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
  1479.  
  1480. ' * Magazine: Moj Mikro, 1989/3
  1481. ' * Author : Zlatko Bleha
  1482. ' * Page : 27 - 31
  1483. ' * Atari BASIC listing on disk (tokenized): M8903282.BAS
  1484. ' * Atari BASIC listing (listed): M8903282.LST
  1485.  
  1486. ' Next example is demonstration of implementing mentioned circle algorithm
  1487. ' in pure Atari BASIC. This program shows how much faster it is compared to
  1488. ' classic program using sine and cosine functions from Atari BASIC
  1489. ' (shown in last example).
  1490.  
  1491. ' Basic Listing M8903282.LST#
  1492. '1 REM *******************************
  1493. '2 REM PROGRAM  : FAST CIRCLE DRAWING
  1494. '3 REM AUTHOR   : ZLATKO BLEHA
  1495. '4 REM PUBLISHER: MOJ MIKRO MAGAZINE
  1496. '5 REM ISSUE NO.: 1989, NO.3, PAGE 29
  1497. '6 REM *******************************
  1498. '7 REM
  1499. '10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
  1500. '20 PRINT "ENTER X, Y AND R"
  1501. '30 INPUT X,Y,R
  1502. '40 IF R=0 THEN PLOT X,Y:END
  1503. '50 B=R:C=0:A=R-1
  1504. '60 PLOT X+C,Y+B
  1505. '70 PLOT X+C,Y-B
  1506. '80 PLOT X-C,Y-B
  1507. '90 PLOT X-C,Y+B
  1508. '100 PLOT X+B,Y+C
  1509. '110 PLOT X+B,Y-C
  1510. '120 PLOT X-B,Y-C
  1511. '130 PLOT X-B,Y+C
  1512. '140 C=C+1
  1513. '150 A=A+1-C-C
  1514. '160 IF A>=0 THEN 190
  1515. '170 B=B-1
  1516. '180 A=A+B+B
  1517. '190 IF B>=C THEN 60
  1518.  
  1519. ' Use some valid values for coordinates and radius, for example:
  1520. ' X=40, Y=40, R=30
  1521. ' X=130, Y=90, R=60
  1522. ' Slow circle drawing in Atari BASIC#
  1523. ' * Magazine: Moj Mikro, 1989/3
  1524. ' * Author : Zlatko Bleha
  1525. ' * Page : 27 - 31
  1526. ' * Atari BASIC listing on disk (tokenized): M8903281.BAS
  1527. ' * Atari BASIC listing (listed): M8903281.LST
  1528.  
  1529. ' This is classic example for drawing circles from Atari BASIC
  1530. ' using sine and cosine functions. Unfortunatelly, this is very slow
  1531. ' way of doing it and not recommended.
  1532. ' Just use routine shown above and everybody will be happy
  1533.  
  1534. ' Basic Listing M8903281.LST#
  1535. '1 REM *******************************
  1536. '2 REM PROGRAM  : SLOW CIRCLE DRAWING
  1537. '3 REM AUTHOR   : ZLATKO BLEHA
  1538. '4 REM PUBLISHER: MOJ MIKRO MAGAZINE
  1539. '5 REM ISSUE NO.: 1989, NO.3, PAGE 29
  1540. '6 REM *******************************
  1541. '7 REM
  1542. '10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
  1543. '20 FOR A=0 TO 6.28 STEP 0.02
  1544. '30 X=SIN(A)*50+150
  1545. '40 Y=COS(A)*50+80
  1546. '50 PLOT X,Y
  1547. '60 NEXT A
  1548.  
  1549. ' Conclusion#
  1550. ' Returning back to first program with the fastest way of drawing circles...
  1551. ' There is one more thing to note. In case you want to use PLOT subroutine,
  1552. ' which is part of the main circle routine, then read following explanation.
  1553. ' PLOT routine is written so it can be used easily from Atari BASIC program
  1554. ' independently from main circle routine, by using like this:
  1555. ' A=USR(30179,POK,X,Y)
  1556. '
  1557. ' POK   1 (drawing a pixel), 0 (erasing a pixel)
  1558. ' X     X coordinate of the pixel
  1559. ' Y     Y coordinate of the pixel
  1560. '
  1561. ' The routine alone is not any faster than normal PLOT command
  1562. ' from Atari BASIC, because USR command takes approximately 75%
  1563. ' of whole execution. But, used as part of the main circle routine
  1564. ' it does not matter anymore, because it is integrated in one larger
  1565. ' entity. There the execution is very fast, with no overhead.
  1566. ' PLOT routine is here for you to examine anyway.
  1567. ' You never know if you will maybe need it in the future.
  1568.  
  1569. ' More on plotting circles:
  1570. '     Drawing a circle in BASIC - fast
  1571. '     https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
  1572.  
  1573. ' -----------------------------------------------------------------------------
  1574. ' Modified to work with 3 dimensional array
  1575. ' -----------------------------------------------------------------------------
  1576. ' Dependencies:
  1577. ' Needs the following constants defined: cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1578.  
  1579. ' Receives:
  1580. ' iAxis   = which plane to draw it on, where cPlaneXY=X,Y cPlaneYZ=Y,Z cPlaneZX=X,Z
  1581. ' X,Y,Z   = center point of circle
  1582. ' R       = radius
  1583. ' iTile   = tile to plot with using PlotTile
  1584. ' iColor  = color to make the tile
  1585.  
  1586. ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1587. ' PlotCircle iAxis, startX, startY, startZ, radius, iTile, iColor
  1588.  
  1589. ' TODO: add parameter to specify array to plot to
  1590.  
  1591. Sub PlotCircle (iAxis As Integer, X As Integer, Y As Integer, Z As Integer, R As Integer, iTile As Integer, iColor As _Unsigned Long)
  1592.     Dim A As Integer
  1593.     Dim B As Integer
  1594.     Dim C As Integer
  1595.  
  1596.     If R > 0 Then
  1597.         B = R
  1598.         C = 0
  1599.         A = R - 1
  1600.         Do
  1601.             Select Case iAxis
  1602.                 Case cPlaneXY:
  1603.                     ' X, Y
  1604.                     PlotTile X + C, Y + B, Z, iTile, iColor
  1605.                     PlotTile X + C, Y - B, Z, iTile, iColor
  1606.                     PlotTile X - C, Y - B, Z, iTile, iColor
  1607.                     PlotTile X - C, Y + B, Z, iTile, iColor
  1608.                     PlotTile X + B, Y + C, Z, iTile, iColor
  1609.                     PlotTile X + B, Y - C, Z, iTile, iColor
  1610.                     PlotTile X - B, Y - C, Z, iTile, iColor
  1611.                     PlotTile X - B, Y + C, Z, iTile, iColor
  1612.                    
  1613.                 Case cPlaneYZ:
  1614.                     ' Y, Z
  1615.                     PlotTile X, Y + B, Z + C, iTile, iColor
  1616.                     PlotTile X, Y - B, Z + C, iTile, iColor
  1617.                     PlotTile X, Y - B, Z - C, iTile, iColor
  1618.                     PlotTile X, Y + B, Z - C, iTile, iColor
  1619.                     PlotTile X, Y + C, Z + B, iTile, iColor
  1620.                     PlotTile X, Y - C, Z + B, iTile, iColor
  1621.                     PlotTile X, Y - C, Z - B, iTile, iColor
  1622.                     PlotTile X, Y + C, Z - B, iTile, iColor
  1623.                    
  1624.                 Case cPlaneZX:
  1625.                     ' X, Z
  1626.                     PlotTile X + C, Y, Z + B, iTile, iColor
  1627.                     PlotTile X + C, Y, Z - B, iTile, iColor
  1628.                     PlotTile X - C, Y, Z - B, iTile, iColor
  1629.                     PlotTile X - C, Y, Z + B, iTile, iColor
  1630.                     PlotTile X + B, Y, Z + C, iTile, iColor
  1631.                     PlotTile X + B, Y, Z - C, iTile, iColor
  1632.                     PlotTile X - B, Y, Z - C, iTile, iColor
  1633.                     PlotTile X - B, Y, Z + C, iTile, iColor
  1634.                    
  1635.                 Case Else:
  1636.                     ' DO NOTHING
  1637.             End Select
  1638.             C = C + 1
  1639.             A = A + 1 - C - C
  1640.             If A < 0 Then ' IF A>=0 THEN 190
  1641.                 B = B - 1
  1642.                 A = A + B + B
  1643.             End If
  1644.             If B < C Then Exit Do ' 190 IF B>=C THEN 60
  1645.         Loop
  1646.     End If
  1647. End Sub ' PlotCircle
  1648.  
  1649. ' /////////////////////////////////////////////////////////////////////////////
  1650. ' Temporary variable version
  1651. ' later we will update PlotCircle and all will use that
  1652. ' for now bSaveToRecording is disabled
  1653. ' later we will use a global variable for that
  1654.  
  1655. ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1656. ' PlotCircle2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
  1657.  
  1658. Sub PlotCircle2 (arrMap() As MapTileType, iAxis As Integer, X As Integer, Y As Integer, Z As Integer, R As Integer, iTile As Integer, iColor As _Unsigned Long)
  1659.     Dim A As Integer
  1660.     Dim B As Integer
  1661.     Dim C As Integer
  1662.  
  1663.     If R > 0 Then
  1664.         B = R
  1665.         C = 0
  1666.         A = R - 1
  1667.         Do
  1668.             Select Case iAxis
  1669.                 Case cPlaneXY:
  1670.                     ' X, Y
  1671.                     PlotTile2 arrMap(), X + C, Y + B, Z, iTile, iColor
  1672.                     PlotTile2 arrMap(), X + C, Y - B, Z, iTile, iColor
  1673.                     PlotTile2 arrMap(), X - C, Y - B, Z, iTile, iColor
  1674.                     PlotTile2 arrMap(), X - C, Y + B, Z, iTile, iColor
  1675.                     PlotTile2 arrMap(), X + B, Y + C, Z, iTile, iColor
  1676.                     PlotTile2 arrMap(), X + B, Y - C, Z, iTile, iColor
  1677.                     PlotTile2 arrMap(), X - B, Y - C, Z, iTile, iColor
  1678.                     PlotTile2 arrMap(), X - B, Y + C, Z, iTile, iColor
  1679.                    
  1680.                 Case cPlaneYZ:
  1681.                     ' Y, Z
  1682.                     PlotTile2 arrMap(), X, Y + B, Z + C, iTile, iColor
  1683.                     PlotTile2 arrMap(), X, Y - B, Z + C, iTile, iColor
  1684.                     PlotTile2 arrMap(), X, Y - B, Z - C, iTile, iColor
  1685.                     PlotTile2 arrMap(), X, Y + B, Z - C, iTile, iColor
  1686.                     PlotTile2 arrMap(), X, Y + C, Z + B, iTile, iColor
  1687.                     PlotTile2 arrMap(), X, Y - C, Z + B, iTile, iColor
  1688.                     PlotTile2 arrMap(), X, Y - C, Z - B, iTile, iColor
  1689.                     PlotTile2 arrMap(), X, Y + C, Z - B, iTile, iColor
  1690.                    
  1691.                 Case cPlaneZX:
  1692.                     ' X, Z
  1693.                     PlotTile2 arrMap(), X + C, Y, Z + B, iTile, iColor
  1694.                     PlotTile2 arrMap(), X + C, Y, Z - B, iTile, iColor
  1695.                     PlotTile2 arrMap(), X - C, Y, Z - B, iTile, iColor
  1696.                     PlotTile2 arrMap(), X - C, Y, Z + B, iTile, iColor
  1697.                     PlotTile2 arrMap(), X + B, Y, Z + C, iTile, iColor
  1698.                     PlotTile2 arrMap(), X + B, Y, Z - C, iTile, iColor
  1699.                     PlotTile2 arrMap(), X - B, Y, Z - C, iTile, iColor
  1700.                     PlotTile2 arrMap(), X - B, Y, Z + C, iTile, iColor
  1701.                    
  1702.                 Case Else:
  1703.                     ' DO NOTHING
  1704.             End Select
  1705.             C = C + 1
  1706.             A = A + 1 - C - C
  1707.             If A < 0 Then ' IF A>=0 THEN 190
  1708.                 B = B - 1
  1709.                 A = A + B + B
  1710.             End If
  1711.             If B < C Then Exit Do ' 190 IF B>=C THEN 60
  1712.         Loop
  1713.     End If
  1714. End Sub ' PlotCircle2
  1715.  
  1716. ' /////////////////////////////////////////////////////////////////////////////
  1717. ' Re: Is this fast enough as general circle fill?
  1718. ' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
  1719.  
  1720. ' From: SMcNeill
  1721. ' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
  1722. '
  1723. ' Sometimes, computers do things that are completely counter-intuitive to us, and
  1724. ' we find ourselves having to step back as programmers and simply say, "WOW!!"  
  1725. ' Here's a perfect example of that:
  1726. ' Here we look at two different circle fill routines -- one, which I'd assume to
  1727. ' be faster, which precalculates the offset needed to find the endpoints for each
  1728. ' line which composes a circle, and another, which is the same old CircleFill
  1729. ' program which I've shared countless times over the years with people on various
  1730. ' QB64 forums.
  1731. '
  1732. ' When all is said and done though, CircleFill is STILL even faster than
  1733. ' CircleFillFast, which pregenerates those end-points for us!
  1734.  
  1735. ' -----------------------------------------------------------------------------
  1736. ' Modified to work with 3 dimensional array
  1737. ' -----------------------------------------------------------------------------
  1738. ' Dependencies:
  1739. ' Needs the following constants defined: cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1740.  
  1741. ' Receives:
  1742. ' iAxis   = which plane to draw it on, where 1=X,Y 2=Y,Z 3=X,Z
  1743. ' X,Y,Z   = center point of circle
  1744. ' R       = radius
  1745. ' iTile   = tile to plot with using PlotTile
  1746. ' iColor  = color to make the tile
  1747.  
  1748. ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1749. ' CircleFill iAxis, startX, startY, startZ, radius, iTile, iColor
  1750.  
  1751. ' TODO: add parameter to specify array to plot to
  1752.  
  1753. SUB CircleFill (iAxis As Integer, CX AS INTEGER, CY AS INTEGER, CZ AS INTEGER, R AS INTEGER, iTile As Integer, iColor As _Unsigned Long)
  1754.     DIM Radius AS INTEGER
  1755.     Dim RadiusError AS INTEGER
  1756.     DIM X AS INTEGER
  1757.     Dim Y AS INTEGER
  1758.     Dim iLoopX as INTEGER
  1759.     Dim iLoopY as INTEGER
  1760.     Dim iLoopZ as INTEGER
  1761.    
  1762.     Radius = ABS(R)
  1763.     RadiusError = -Radius
  1764.     X = Radius
  1765.     Y = 0
  1766.    
  1767.     'TODO: SHOULDN'T WE JUST PLOT A DOT IF RADIUS IS 1 RATHER THAN 0 ?
  1768.     IF Radius = 0 THEN
  1769.         ''PSET (CX, CY), C
  1770.         'PlotPoint CX, CY, S, MyArray()
  1771.         PlotTile CX, CY, CZ, iTile, iColor
  1772.         EXIT SUB
  1773.     END IF
  1774.    
  1775.     Select Case iAxis
  1776.         Case cPlaneXY:
  1777.             ' X, Y
  1778.             ' (just add Z)
  1779.            
  1780.             ' Draw the middle span here so we don't draw it twice in the main loop,
  1781.             ' which would be a problem with blending turned on.
  1782.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  1783.             FOR iLoopX = CX - X TO CX + X
  1784.                 'PlotPoint iLoopX, CY, S, MyArray()
  1785.                 PlotTile iLoopX, CY, CZ, iTile, iColor
  1786.             NEXT iLoopX
  1787.            
  1788.             WHILE X > Y
  1789.                 RadiusError = RadiusError + Y * 2 + 1
  1790.                 IF RadiusError >= 0 THEN
  1791.                     IF X <> Y + 1 THEN
  1792.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  1793.                         iLoopY = CY - X
  1794.                         FOR iLoopX = CX - Y TO CX + Y
  1795.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1796.                             PlotTile iLoopX, iLoopY, CZ, iTile, iColor
  1797.                         NEXT iLoopX
  1798.                        
  1799.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  1800.                         iLoopY = CY + X
  1801.                         FOR iLoopX = CX - Y TO CX + Y
  1802.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1803.                             PlotTile iLoopX, iLoopY, CZ, iTile, iColor
  1804.                         NEXT iLoopX
  1805.                     END IF
  1806.                     X = X - 1
  1807.                     RadiusError = RadiusError - X * 2
  1808.                 END IF
  1809.                 Y = Y + 1
  1810.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  1811.                 iLoopY = CY - Y
  1812.                 FOR iLoopX = CX - X TO CX + X
  1813.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1814.                     PlotTile iLoopX, iLoopY, CZ, iTile, iColor
  1815.                 NEXT iLoopX
  1816.                
  1817.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  1818.                 iLoopY = CY + Y
  1819.                 FOR iLoopX = CX - X TO CX + X
  1820.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1821.                     PlotTile iLoopX, iLoopY, CZ, iTile, iColor
  1822.                 NEXT iLoopX
  1823.             WEND
  1824.            
  1825.         Case cPlaneYZ:
  1826.             ' Y, Z
  1827.             ' (x becomes z)
  1828.            
  1829.             ' Draw the middle span here so we don't draw it twice in the main loop,
  1830.             ' which would be a problem with blending turned on.
  1831.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  1832.             FOR iLoopZ = CZ - X TO CZ + X
  1833.                 'PlotPoint iLoopX, CY, S, MyArray()
  1834.                 PlotTile CX, CY, iLoopZ, iTile, iColor
  1835.             NEXT iLoopZ
  1836.            
  1837.             WHILE X > Y
  1838.                 RadiusError = RadiusError + Y * 2 + 1
  1839.                 IF RadiusError >= 0 THEN
  1840.                     IF X <> Y + 1 THEN
  1841.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  1842.                         iLoopY = CY - X
  1843.                         FOR iLoopZ = CZ - Y TO CZ + Y
  1844.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1845.                             PlotTile CX, iLoopY, iLoopZ, iTile, iColor
  1846.                         NEXT iLoopZ
  1847.                        
  1848.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  1849.                         iLoopY = CY + X
  1850.                         FOR iLoopZ = CZ - Y TO CZ + Y
  1851.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1852.                             PlotTile CX, iLoopY, iLoopZ, iTile, iColor
  1853.                         NEXT iLoopZ
  1854.                     END IF
  1855.                     X = X - 1
  1856.                     RadiusError = RadiusError - X * 2
  1857.                 END IF
  1858.                 Y = Y + 1
  1859.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  1860.                 iLoopY = CY - Y
  1861.                 FOR iLoopZ = CZ - X TO CZ + X
  1862.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1863.                     PlotTile CX, iLoopY, iLoopZ, iTile, iColor
  1864.                 NEXT iLoopZ
  1865.                
  1866.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  1867.                 iLoopY = CY + Y
  1868.                 FOR iLoopZ = CZ - X TO CZ + X
  1869.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1870.                     PlotTile CX, iLoopY, iLoopZ, iTile, iColor
  1871.                 NEXT iLoopZ
  1872.             WEND
  1873.            
  1874.         Case cPlaneZX:
  1875.             ' X, Z
  1876.             ' (x stays x, y becomes z)
  1877.            
  1878.             ' Draw the middle span here so we don't draw it twice in the main loop,
  1879.             ' which would be a problem with blending turned on.
  1880.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  1881.             FOR iLoopX = CX - X TO CX + X
  1882.                 'PlotPoint iLoopX, CY, S, MyArray()
  1883.                 PlotTile iLoopX, CY, CZ, iTile, iColor
  1884.             NEXT iLoopX
  1885.            
  1886.             WHILE X > Y
  1887.                 RadiusError = RadiusError + Y * 2 + 1
  1888.                 IF RadiusError >= 0 THEN
  1889.                     IF X <> Y + 1 THEN
  1890.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  1891.                         iLoopZ = CZ - X
  1892.                         FOR iLoopX = CX - Y TO CX + Y
  1893.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1894.                             PlotTile iLoopX, CY, iLoopZ, iTile, iColor
  1895.                         NEXT iLoopX
  1896.                        
  1897.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  1898.                         iLoopZ = CZ + X
  1899.                         FOR iLoopX = CX - Y TO CX + Y
  1900.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1901.                             PlotTile iLoopX, CY, iLoopZ, iTile, iColor
  1902.                         NEXT iLoopX
  1903.                     END IF
  1904.                     X = X - 1
  1905.                     RadiusError = RadiusError - X * 2
  1906.                 END IF
  1907.                 Y = Y + 1
  1908.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  1909.                 iLoopZ = CZ - Y
  1910.                 FOR iLoopX = CX - X TO CX + X
  1911.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1912.                     PlotTile iLoopX, CY, iLoopZ, iTile, iColor
  1913.                 NEXT iLoopX
  1914.                
  1915.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  1916.                 iLoopZ = CZ + Y
  1917.                 FOR iLoopX = CX - X TO CX + X
  1918.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1919.                     PlotTile iLoopX, CY, iLoopZ, iTile, iColor
  1920.                 NEXT iLoopX
  1921.             WEND            
  1922.            
  1923.         Case Else:
  1924.             ' DO NOTHING
  1925.     End Select
  1926.    
  1927. END SUB ' CircleFill
  1928.  
  1929. ' /////////////////////////////////////////////////////////////////////////////
  1930. ' Temporary variable version
  1931. ' later we will update CircleFill and all will use that
  1932. ' for now bSaveToRecording is disabled
  1933. ' later we will use a global variable for that
  1934.  
  1935. ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  1936. ' CircleFill2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
  1937.  
  1938. SUB CircleFill2 (arrMap() As MapTileType, iAxis As Integer, CX AS INTEGER, CY AS INTEGER, CZ AS INTEGER, R AS INTEGER, iTile As Integer, iColor As _Unsigned Long)
  1939.     DIM Radius AS INTEGER
  1940.     Dim RadiusError AS INTEGER
  1941.     DIM X AS INTEGER
  1942.     Dim Y AS INTEGER
  1943.     Dim iLoopX as INTEGER
  1944.     Dim iLoopY as INTEGER
  1945.     Dim iLoopZ as INTEGER
  1946.    
  1947.     Radius = ABS(R)
  1948.     RadiusError = -Radius
  1949.     X = Radius
  1950.     Y = 0
  1951.    
  1952.     'TODO: SHOULDN'T WE JUST PLOT A DOT IF RADIUS IS 1 RATHER THAN 0 ?
  1953.     IF Radius = 0 THEN
  1954.         ''PSET (CX, CY), C
  1955.         'PlotPoint CX, CY, S, MyArray()
  1956.         PlotTile2 arrMap(), CX, CY, CZ, iTile, iColor
  1957.         EXIT SUB
  1958.     END IF
  1959.    
  1960.     Select Case iAxis
  1961.         Case cPlaneXY:
  1962.             ' X, Y
  1963.             ' (just add Z)
  1964.            
  1965.             ' Draw the middle span here so we don't draw it twice in the main loop,
  1966.             ' which would be a problem with blending turned on.
  1967.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  1968.             FOR iLoopX = CX - X TO CX + X
  1969.                 'PlotPoint iLoopX, CY, S, MyArray()
  1970.                 PlotTile2 arrMap(), iLoopX, CY, CZ, iTile, iColor
  1971.             NEXT iLoopX
  1972.            
  1973.             WHILE X > Y
  1974.                 RadiusError = RadiusError + Y * 2 + 1
  1975.                 IF RadiusError >= 0 THEN
  1976.                     IF X <> Y + 1 THEN
  1977.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  1978.                         iLoopY = CY - X
  1979.                         FOR iLoopX = CX - Y TO CX + Y
  1980.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1981.                             PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
  1982.                         NEXT iLoopX
  1983.                        
  1984.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  1985.                         iLoopY = CY + X
  1986.                         FOR iLoopX = CX - Y TO CX + Y
  1987.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  1988.                             PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
  1989.                         NEXT iLoopX
  1990.                     END IF
  1991.                     X = X - 1
  1992.                     RadiusError = RadiusError - X * 2
  1993.                 END IF
  1994.                 Y = Y + 1
  1995.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  1996.                 iLoopY = CY - Y
  1997.                 FOR iLoopX = CX - X TO CX + X
  1998.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  1999.                     PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
  2000.                 NEXT iLoopX
  2001.                
  2002.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  2003.                 iLoopY = CY + Y
  2004.                 FOR iLoopX = CX - X TO CX + X
  2005.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  2006.                     PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
  2007.                 NEXT iLoopX
  2008.             WEND
  2009.            
  2010.         Case cPlaneYZ:
  2011.             ' Y, Z
  2012.             ' (x becomes z)
  2013.            
  2014.             ' Draw the middle span here so we don't draw it twice in the main loop,
  2015.             ' which would be a problem with blending turned on.
  2016.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  2017.             FOR iLoopZ = CZ - X TO CZ + X
  2018.                 'PlotPoint iLoopX, CY, S, MyArray()
  2019.                 PlotTile2 arrMap(), CX, CY, iLoopZ, iTile, iColor
  2020.             NEXT iLoopZ
  2021.            
  2022.             WHILE X > Y
  2023.                 RadiusError = RadiusError + Y * 2 + 1
  2024.                 IF RadiusError >= 0 THEN
  2025.                     IF X <> Y + 1 THEN
  2026.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  2027.                         iLoopY = CY - X
  2028.                         FOR iLoopZ = CZ - Y TO CZ + Y
  2029.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  2030.                             PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
  2031.                         NEXT iLoopZ
  2032.                        
  2033.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  2034.                         iLoopY = CY + X
  2035.                         FOR iLoopZ = CZ - Y TO CZ + Y
  2036.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  2037.                             PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
  2038.                         NEXT iLoopZ
  2039.                     END IF
  2040.                     X = X - 1
  2041.                     RadiusError = RadiusError - X * 2
  2042.                 END IF
  2043.                 Y = Y + 1
  2044.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  2045.                 iLoopY = CY - Y
  2046.                 FOR iLoopZ = CZ - X TO CZ + X
  2047.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  2048.                     PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
  2049.                 NEXT iLoopZ
  2050.                
  2051.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  2052.                 iLoopY = CY + Y
  2053.                 FOR iLoopZ = CZ - X TO CZ + X
  2054.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  2055.                     PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
  2056.                 NEXT iLoopZ
  2057.             WEND
  2058.            
  2059.         Case cPlaneZX:
  2060.             ' X, Z
  2061.             ' (x stays x, y becomes z)
  2062.            
  2063.             ' Draw the middle span here so we don't draw it twice in the main loop,
  2064.             ' which would be a problem with blending turned on.
  2065.             'LINE (CX - X, CY)-(CX + X, CY), C, BF
  2066.             FOR iLoopX = CX - X TO CX + X
  2067.                 'PlotPoint iLoopX, CY, S, MyArray()
  2068.                 PlotTile2 arrMap(), iLoopX, CY, CZ, iTile, iColor
  2069.             NEXT iLoopX
  2070.            
  2071.             WHILE X > Y
  2072.                 RadiusError = RadiusError + Y * 2 + 1
  2073.                 IF RadiusError >= 0 THEN
  2074.                     IF X <> Y + 1 THEN
  2075.                         'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  2076.                         iLoopZ = CZ - X
  2077.                         FOR iLoopX = CX - Y TO CX + Y
  2078.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  2079.                             PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
  2080.                         NEXT iLoopX
  2081.                        
  2082.                         'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  2083.                         iLoopZ = CZ + X
  2084.                         FOR iLoopX = CX - Y TO CX + Y
  2085.                             'PlotPoint iLoopX, iLoopY, S, MyArray()
  2086.                             PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
  2087.                         NEXT iLoopX
  2088.                     END IF
  2089.                     X = X - 1
  2090.                     RadiusError = RadiusError - X * 2
  2091.                 END IF
  2092.                 Y = Y + 1
  2093.                 'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  2094.                 iLoopZ = CZ - Y
  2095.                 FOR iLoopX = CX - X TO CX + X
  2096.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  2097.                     PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
  2098.                 NEXT iLoopX
  2099.                
  2100.                 'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  2101.                 iLoopZ = CZ + Y
  2102.                 FOR iLoopX = CX - X TO CX + X
  2103.                     'PlotPoint iLoopX, iLoopY, S, MyArray()
  2104.                     PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
  2105.                 NEXT iLoopX
  2106.             WEND            
  2107.            
  2108.         Case Else:
  2109.             ' DO NOTHING
  2110.     End Select
  2111.    
  2112. END SUB ' CircleFill2
  2113.  
  2114. ' /////////////////////////////////////////////////////////////////////////////
  2115. ' Returns a semicircle represented in a _Byte array
  2116.  
  2117. ' R       = radius
  2118. ' Q       = which quarter of the circle to return
  2119. '           where 1=top right, 2=bottom right, 3=bottom left, 4=top left
  2120. '           like this:
  2121.             ' .......4444111.......
  2122.             ' .....44.......11.....
  2123.             ' ....4...........1....
  2124.             ' ...4.............1...
  2125.             ' ..4...............1..
  2126.             ' .4.................1.
  2127.             ' .4.................1.
  2128.             ' 4...................1
  2129.             ' 4...................1
  2130.             ' 4...................1
  2131.             ' 3...................1
  2132.             ' 3...................2
  2133.             ' 3...................2
  2134.             ' 3...................2
  2135.             ' .3.................2.
  2136.             ' .3.................2.
  2137.             ' ..3...............2..
  2138.             ' ...3.............2...
  2139.             ' ....3...........2....
  2140.             ' .....33.......22.....
  2141.             ' .......3333222.......
  2142. ' S       = char to draw
  2143. ' MyArray = 2D *dynamic* array to plot semicircle in, (0 To R, 0 To R) of _Byte
  2144.  
  2145. ' Usage:
  2146. ' ReDim MyArray(-1, -1) As _Byte
  2147. ' GetSemicircle R, Q, MyArray()
  2148.  
  2149. Sub GetSemicircle (R As Integer, Q As Integer, MyArray() As _Byte)
  2150.     Dim RoutineName As String : RoutineName = "GetSemicircle"
  2151.     Dim A As Integer
  2152.     Dim B As Integer
  2153.     Dim C As Integer
  2154.     Dim DY As Integer
  2155.     Dim DX As Integer
  2156.    
  2157.     ' Resize array
  2158.     ReDim MyArray(0 To R, 0 To R) As _Byte
  2159.    
  2160.     ' Clear array
  2161.     FOR DX = 0 TO R
  2162.         FOR DY = 0 TO R
  2163.             MyArray(X,Y) = 0
  2164.         NEXT DY
  2165.     NEXT DX
  2166.    
  2167.     If R > 0 Then
  2168.         ' Plot semicircle to array
  2169.         B = R
  2170.         C = 0
  2171.         A = R - 1
  2172.         Do
  2173.             ' PORTIONS OF CIRCLE:
  2174.             ' .......3333222.......
  2175.             ' .....33.......22.....
  2176.             ' ....3...........2....
  2177.             ' ...7.............6...
  2178.             ' ..7...............6..
  2179.             ' .7.................6.
  2180.             ' .7.................6.
  2181.             ' 7...................6
  2182.             ' 7...................6
  2183.             ' 7...................6
  2184.             ' 8...................6
  2185.             ' 8...................5
  2186.             ' 8...................5
  2187.             ' 8...................5
  2188.             ' .8.................5.
  2189.             ' .8.................5.
  2190.             ' ..8...............5..
  2191.             ' ...8.............5...
  2192.             ' ....4...........1....
  2193.             ' .....44.......11.....
  2194.             ' .......4444111.......
  2195.            
  2196.             ' JUST PLOT SELECTED QUADRANT:
  2197.             Select Case Q
  2198.                 Case 1:
  2199.                     ' quadrant #1
  2200.                     MyArray(C, R - B) = 1 ' 2
  2201.                     MyArray(B, R - C) = 1 ' 6
  2202.                 Case 2:
  2203.                     ' quadrant #2
  2204.                     MyArray(B, C) = 1 ' 5
  2205.                     MyArray(C, B) = 1 ' 1
  2206.                 Case 3:
  2207.                     ' quadrant #3
  2208.                     MyArray(R - C, B) = 1 ' 4
  2209.                     MyArray(R - B, C) = 1 ' 8
  2210.                 Case 4:
  2211.                     ' quadrant #4
  2212.                     MyArray(R - B, R - C) = 1 ' 7
  2213.                     MyArray(R - C, R - B) = 1 ' 3
  2214.                 Case Else:
  2215.                     ' (DO NOTHING)
  2216.             End Select
  2217.            
  2218.             '' PLOT CIRCLE:
  2219.             '' quadrant #1
  2220.             'PlotPoint R + C, R - B, S2, arrTemp() ' 2
  2221.             'PlotPoint R + B, R - C, S2, arrTemp() ' 6
  2222.             '
  2223.             '' quadrant #2
  2224.             'PlotPoint R + B, R + C, S2, arrTemp() ' 5
  2225.             'PlotPoint R + C, R + B, S2, arrTemp() ' 1
  2226.             '
  2227.             '' quadrant #3
  2228.             'PlotPoint R - C, R + B, S2, arrTemp() ' 4
  2229.             'PlotPoint R - B, R + C, S2, arrTemp() ' 8
  2230.             '
  2231.             '' quadrant #4
  2232.             'PlotPoint R - B, R - C, S2, arrTemp() ' 7
  2233.             'PlotPoint R - C, R - B, S2, arrTemp() ' 3
  2234.            
  2235.             C = C + 1
  2236.             A = A + 1 - C - C
  2237.             If A < 0 Then
  2238.                 B = B - 1
  2239.                 A = A + B + B
  2240.             End If
  2241.             If B < C Then Exit Do
  2242.         Loop
  2243.     End If
  2244. End Sub ' GetSemicircle
  2245.  
  2246. ' /////////////////////////////////////////////////////////////////////////////
  2247. ' ShearRotate v4
  2248.  
  2249. ' *****************************************************************************
  2250. ' UNDER CONSTRUCTION
  2251. ' Tried to get this working for 3D and positive indexed array,
  2252. ' and no runtime or compile errors,
  2253. ' but doesn't seem to be working (the screen goes black when we render it!)
  2254. ' *****************************************************************************
  2255.  
  2256. ' -----------------------------------------------------------------------------
  2257. ' CHANGES
  2258. ' -----------------------------------------------------------------------------
  2259. ' * Modified to work with 3 dimensional array (iterates through z axis)
  2260. ' * Modified to work with non-polar array (converts coordinates to polar coordinates)
  2261.  
  2262. ' -----------------------------------------------------------------------------
  2263. ' NOTES
  2264. ' -----------------------------------------------------------------------------
  2265. ' Tries to fix the problem of 2 points resolving to the same coordinate
  2266. ' (one overwrites the other, which becomes "lost")
  2267. ' using a different approach, by just looking at the problem angles:
  2268. ' 30, 60, 120, 150, 210, 240, 300, 330 degrees
  2269.  
  2270. ' (which can be cClockwise or cCounterClockwise)
  2271. ' together with which quarter of the screen the point is in,
  2272.  
  2273. ' Note: cClockwise and cCounterClockwise constants must be declared globally.
  2274.  
  2275. ' Returns # points missing (that could not be corrected) in iMissing parameter.
  2276.  
  2277. ' -----------------------------------------------------------------------------
  2278. ' Dependencies
  2279. ' -----------------------------------------------------------------------------
  2280. ' Needs the following constants defined:
  2281. ' cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  2282. ' cCounterClockwise = -1, cClockwise = 1
  2283.  
  2284. ' Receives:
  2285. ' OldArray() = original 3d array (x,y,z) of MapTileType to be rotated,
  2286. '              * must contain an odd # of elements, so there is a center axis to rotate around
  2287. ' NewArray() = rotated  3d array (x,y,z) of MapTileType to be returned
  2288. '              * must be the same array size/type as OldArray
  2289. '              * must be declared as a dynamic array with ReDim
  2290. ' angle1     = angle to rotate OldArray to, can be 0-360
  2291. ' iDirection = direction of rotation, can be cClockwise or cCounterClockwise
  2292. ' iAxis      = which plane to draw it on, where cPlaneXY=X,Y cPlaneYZ=Y,Z cPlaneZX=X,Z
  2293. '              * currently only cPlaneXY is supported
  2294. ' iMissing   = return value, # of points which were "lost in rotation"
  2295.  
  2296. ' -----------------------------------------------------------------------------
  2297. ' TODO:
  2298. ' * get it working
  2299. ' * maybe add option to only rotate one slice
  2300. '   (e.g. if we're rotating x/y, specify a single z)
  2301.  
  2302. ' -----------------------------------------------------------------------------
  2303. ' USAGE:
  2304. ' ShearRotate4 OldArray(), NewRotatedArray(), angleToRotateTo, cClockwise, cPlaneXY, iMissingTileCount
  2305.  
  2306. Sub ShearRotate4 ( _
  2307.     OldArray() As MapTileType, _
  2308.     NewArray() As MapTileType, _
  2309.     angle1 As Integer, _
  2310.     iDirection As Integer, _
  2311.     iAxis As Integer, _
  2312.     iMissing As Integer)
  2313.    
  2314.     Const Pi = 4 * Atn(1)
  2315.    
  2316.     Dim angle As Integer
  2317.     Dim TwoPi As Double: TwoPi = 8 * Atn(1)
  2318.     Dim RtoD As Double: RtoD = 180 / Pi ' radians * RtoD = degrees
  2319.     Dim DtoR As Double: DtoR = Pi / 180 ' degrees * DtoR = radians
  2320.     Dim x As Integer
  2321.     Dim y As Integer
  2322.     Dim z As Integer ' added for 3D
  2323.     Dim nangle As Integer
  2324.     Dim nx As Integer
  2325.     Dim ny As Integer
  2326.     Dim nz As Integer ' added for 3D
  2327.     Dim flipper As Integer
  2328.     Dim rotr As Double
  2329.     Dim shear1 As Double
  2330.     Dim shear2 As Double
  2331.     Dim clr As RotationType ' Integer
  2332.     Dim y1 As _Byte
  2333.     Dim xy1 As _Byte
  2334.     Dim fy As _Byte
  2335.     Dim fx As _Byte
  2336.     Dim in$
  2337.     Dim sLine As String
  2338.     ReDim arrLost(-1) As RotationType
  2339.     Dim iLoop As Integer
  2340.     Dim bFound As Integer
  2341.     Dim iScreenZone As Integer
  2342.     Dim iMidX As Integer
  2343.     Dim iMidY As Integer
  2344.     Dim iMidZ As Integer ' added for 3D
  2345.    
  2346.     Dim iPolarMinX As Integer
  2347.     Dim iPolarMaxX As Integer
  2348.     Dim iPolarMidX As Integer
  2349.     Dim iPolarMinY As Integer
  2350.     Dim iPolarMaxY As Integer
  2351.     Dim iPolarMidY As Integer
  2352.     Dim iPolarMinZ As Integer
  2353.     Dim iPolarMaxZ As Integer
  2354.     Dim iPolarMidZ As Integer
  2355.     Dim iDiffPolarX As Integer ' used to convert array coordinates to polar coordinates
  2356.     Dim iDiffPolarY As Integer
  2357.     Dim iDiffPolarZ As Integer
  2358.    
  2359.     ' -----------------------------------------------------------------------------
  2360.     ' initialize new with empty
  2361.     ReDim NewArray( _
  2362.         LBound(OldArray, 1) To UBound(OldArray, 1), _
  2363.         LBound(OldArray, 2) To UBound(OldArray, 2), _
  2364.         LBound(OldArray, 3) To UBound(OldArray, 3) _
  2365.         ) As MapTileType
  2366.        
  2367.     For x = LBound(NewArray, 1) To UBound(NewArray, 1)
  2368.         For y = LBound(NewArray, 2) To UBound(NewArray, 2)
  2369.             For z = LBound(NewArray, 3) To UBound(NewArray, 3)
  2370.                 NewArray(x, y, z).origx = x
  2371.                 NewArray(x, y, z).origy = y
  2372.                 NewArray(x, y, z).origz = z
  2373.                 NewArray(x, y, z).Typ = c_iTile_Empty
  2374.                 NewArray(x, y, z).Color1 = cEmpty
  2375.             Next z
  2376.         Next y
  2377.     Next x
  2378.    
  2379.     ' -----------------------------------------------------------------------------
  2380.     ' angle is reversed
  2381.     angle = 360 - angle1
  2382.    
  2383.     ' Shearing each element 3 times in one shot
  2384.     nangle = angle
  2385.    
  2386.     ' this pre-processing portion basically rotates by 90 to get
  2387.     ' between -45 and 45 degrees, where the 3-shear routine works correctly...
  2388.     If angle > 45 And angle < 225 Then
  2389.         If angle < 135 Then
  2390.             nangle = angle - 90
  2391.         Else
  2392.             nangle = angle - 180
  2393.         End If
  2394.     End If
  2395.     If angle > 135 And angle < 315 Then
  2396.         If angle < 225 Then
  2397.             nangle = angle - 180
  2398.         Else
  2399.             nangle = angle - 270
  2400.         End If
  2401.     End If
  2402.     If nangle < 0 Then
  2403.         nangle = nangle + 360
  2404.     End If
  2405.     If nangle > 359 Then
  2406.         nangle = nangle - 360
  2407.     End If
  2408.    
  2409.     rotr = nangle * DtoR
  2410.     shear1 = Tan(rotr / 2) ' correct way
  2411.     shear2 = Sin(rotr)
  2412.    
  2413.     ' *** NOTE: this had a bug where the values 135, 224, and 314
  2414.     ' ***       all resolve to -45 degrees.
  2415.     ' ***       Fixed by changing < to <=
  2416.    
  2417.     'if angle >  45 and angle < 134 then
  2418.     If angle > 45 And angle <= 134 Then
  2419.         flipper = 1
  2420.     ElseIf angle > 134 And angle <= 224 Then
  2421.         flipper = 2
  2422.     ElseIf angle > 224 And angle <= 314 Then
  2423.         ' *** NOTE: this had a bug where this flipper was wrong
  2424.         '           Fixed by adding case 7
  2425.         'flipper = 3
  2426.         flipper = 7
  2427.     Else
  2428.         flipper = 0
  2429.     End If
  2430.    
  2431.     ' -----------------------------------------------------------------------------
  2432.     ' find midpoints
  2433.     iMidX = (UBound(OldArray, 1) - LBound(OldArray, 1)) / 2
  2434.     iMidY = (UBound(OldArray, 2) - LBound(OldArray, 2)) / 2
  2435.     iMidZ = (UBound(OldArray, 3) - LBound(OldArray, 3)) / 2
  2436.    
  2437.     ' -----------------------------------------------------------------------------
  2438.     ' determine polar coordinates
  2439.     ' since our arrays use positive coordinates
  2440.     ' e.g. convert 1 To 15 to -7 To 7
  2441.     iDiffPolarX = 0 - iMidX
  2442.     iPolarMinX = LBound(OldArray, 1) + iDiffPolarX
  2443.     iPolarMaxX = UBound(OldArray, 1) + iDiffPolarX
  2444.     iPolarMidX = 0
  2445.    
  2446.     iDiffPolarY = 0 - iMidY
  2447.     iPolarMinY = LBound(OldArray, 2) + iDiffPolarY
  2448.     iPolarMaxY = UBound(OldArray, 2) + iDiffPolarY
  2449.     iPolarMidY = 0
  2450.    
  2451.     iDiffPolarZ = 0 - iMidZ
  2452.     iPolarMinZ = LBound(OldArray, 3) + iDiffPolarZ
  2453.     iPolarMaxZ = UBound(OldArray, 3) + iDiffPolarZ
  2454.     iPolarMidZ = 0
  2455.    
  2456.     ' -----------------------------------------------------------------------------
  2457.     ' THIS PART DEPENDS ON WHICH AXIS WE'RE ROTATING ON
  2458.    
  2459.     Select Case iAxis
  2460.         Case cPlaneXY:
  2461.             ' X, Y
  2462.            
  2463.             ' Here is where it needs some optimizing possibly... kinda slow...
  2464.            
  2465.             For z = iPolarMinZ To iPolarMaxZ
  2466.                 'For y = LBound(NewArray, 2) To UBound(NewArray, 2)
  2467.                 For y = iPolarMinY To iPolarMaxY
  2468.                     'For x = LBound(NewArray, 1) To UBound(NewArray, 1)
  2469.                     For x = iPolarMinX To iPolarMaxX
  2470.                        
  2471.                         ' find which part of screen the current point is in
  2472.                         if y > iPolarMidY then
  2473.                             ' bottom half of screen
  2474.                             if x > iPolarMidX then
  2475.                                 ' right half of screen
  2476.                                 iScreenZone = 2
  2477.                             else
  2478.                                 ' left half of screen
  2479.                                 iScreenZone = 3
  2480.                             end if
  2481.                         else
  2482.                             ' top half of screen
  2483.                             if x > iPolarMidX then
  2484.                                 ' right half of screen
  2485.                                 iScreenZone = 1
  2486.                             else
  2487.                                 ' left half of screen
  2488.                                 iScreenZone = 4
  2489.                             end if
  2490.                         end if
  2491.                        
  2492.                         ' calculate directions
  2493.                         Select Case flipper
  2494.                             Case 1:
  2495.                                 nx = -y
  2496.                                 ny = x
  2497.                             Case 2:
  2498.                                 nx = -x
  2499.                                 ny = -y
  2500.                             Case 3:
  2501.                                 nx = -y
  2502.                                 ny = -x
  2503.                             Case 4:
  2504.                                 nx = -x
  2505.                                 ny = y
  2506.                             Case 5:
  2507.                                 nx = x
  2508.                                 ny = -y
  2509.                             Case 6:
  2510.                                 nx = y
  2511.                                 ny = x
  2512.                             Case 7:
  2513.                                 nx = y
  2514.                                 ny = -x
  2515.                             Case Else:
  2516.                                 nx = x
  2517.                                 ny = y
  2518.                         End Select
  2519.                        
  2520.                         clr.Typ = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Typ
  2521.                         clr.Color1 = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Color1
  2522.                         clr.Alpha1 = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Alpha1
  2523.                        
  2524.                         y1 = y * shear1
  2525.                         xy1 = x + y1
  2526.                         fy = (y - xy1 * shear2)
  2527.                         fx = xy1 + fy * shear1
  2528.                        
  2529.                         If fx >= iPolarMinX And fx <= iPolarMaxX Then
  2530.                             If fy >= iPolarMinY And fy <= iPolarMaxY Then
  2531.                                 ' only draw here if this spot is empty
  2532.                                 if NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Typ = c_iTile_Empty then
  2533.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Typ = clr.Typ
  2534.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Color1 = clr.Color1
  2535.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Alpha1 = clr.Alpha1
  2536.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origx = fx
  2537.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origy = fy
  2538.                                     NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origz = z ' added for 3D
  2539.                                 else
  2540.                                     ' don't draw, but save it to a list to handle later
  2541.                                     ReDim _Preserve arrLost(0 To UBound(arrLost) + 1) As RotationType
  2542.                                     arrLost(UBound(arrLost)).Typ = clr.Typ
  2543.                                     arrLost(UBound(arrLost)).Color1 = clr.Color1
  2544.                                     arrLost(UBound(arrLost)).Alpha1 = clr.Alpha1
  2545.                                     arrLost(UBound(arrLost)).origx = fx
  2546.                                     arrLost(UBound(arrLost)).origy = fy
  2547.                                     arrLost(UBound(arrLost)).origz = z ' added for 3D
  2548.                                    
  2549.                                     ' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
  2550.                                     arrLost(UBound(arrLost)).zone = iScreenZone
  2551.                                 end if
  2552.                             End If
  2553.                         End If
  2554.                     Next x
  2555.                 Next y
  2556.                
  2557.                 ' try to place any points that would have overwritten to a spot nearby
  2558.                 ' can nearby be determined by the direction of rotation  (iDirection)
  2559.                 ' together with which quarter of the screen the point is in (iScreenZone)
  2560.                 ' where we divide the screen up into 4 zones:
  2561.                
  2562.                 ' --------------------------------------
  2563.                 '|                   |                  |
  2564.                 '| zone 4            | zone 1           |
  2565.                 '|                   |                  |
  2566.                 '|--------------------------------------|
  2567.                 '|                   |                  |
  2568.                 '| zone 3            | zone 2           |
  2569.                 '|                   |                  |
  2570.                 '|                   |                  |
  2571.                 ' --------------------------------------
  2572.                
  2573.                 ' in zone   rotation direction   search direction (y,x)
  2574.                 ' -------   ------------------   ----------------------
  2575.                 ' 1         clockwise            down + right
  2576.                 ' 1         counter-clockwise    up   + left
  2577.                 ' 2         clockwise            down + left
  2578.                 ' 2         counter-clockwise    up   + right
  2579.                 ' 3         clockwise            up   + left
  2580.                 ' 3         counter-clockwise    down + right
  2581.                 ' 4         clockwise            up   + right
  2582.                 ' 4         counter-clockwise    down + left
  2583.                
  2584.                 if IsProblemAngle%(angle1) then
  2585.                     iMissing = 0
  2586.                     For iLoop = 0 To UBound(arrLost)
  2587.                         bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, x - iDiffPolarX, y - iDiffPolarY, z - iDiffPolarZ, NewArray())
  2588.                         if bFound = TRUE then
  2589.                             'DebugPrint "Plotted  missing point " + chr$(34) + chr$(arrLost(iLoop).Typ) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
  2590.                         else
  2591.                             iMissing = iMissing + 1
  2592.                             'DebugPrint "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).Typ) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
  2593.                         end if
  2594.                     Next iLoop
  2595.                 end if
  2596.             Next z
  2597.            
  2598.         Case cPlaneYZ:
  2599.             ' Y, Z
  2600.             ' (UNDER CONSTRUCTION)
  2601.         Case cPlaneZX:
  2602.             ' X, Z
  2603.             ' (UNDER CONSTRUCTION)
  2604.         Case Else:
  2605.             ' DO NOTHING
  2606.     End Select
  2607.    
  2608. End Sub ' ShearRotate4
  2609.  
  2610. ' /////////////////////////////////////////////////////////////////////////////
  2611. ' div: int1% = num1% \ den1%
  2612. ' mod: rem1% = num1% MOD den1%
  2613.  
  2614. function IsProblemAngle%(angle as integer)
  2615.     dim bResult as integer : bResult = FALSE
  2616.     Dim i%
  2617.     For i% = 0 To 360 Step 30
  2618.         If i% Mod 90 <> 0 Then
  2619.             if angle = i% then
  2620.                 bResult = TRUE
  2621.                 exit for
  2622.             end if
  2623.         End If
  2624.     Next i%
  2625.     IsProblemAngle% = bResult
  2626. end function ' IsProblemAngle%
  2627.  
  2628. ' /////////////////////////////////////////////////////////////////////////////
  2629. ' Looks for a new point
  2630. ' a little more accurately, using iDirection parameter
  2631. ' which can be cClockwise or cCounterClockwise.
  2632.  
  2633. ' Note: cClockwise and cCounterClockwise constants must be declared globally.
  2634.  
  2635. ' Receives
  2636. ' FindMe (RotationType) = contains
  2637. '                         .origx, .origy, .origz = the starting location to start looking from,
  2638. '                         .zone = which area of the screen the point is in
  2639. '                              (1=top right, 2=bottom right, 3=bottom left, 4=top left)
  2640. '                              to determine direction to look in
  2641. '                         .Typ = the value to write
  2642. ' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
  2643. ' destX (Integer) = if an empty spot is found, returns the x location here byref
  2644. ' destY (Integer) = if an empty spot is found, returns the y location here byref
  2645. ' destZ (Integer) = if an empty spot is found, returns the z location here byref
  2646. ' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
  2647.  
  2648. ' Returns
  2649. ' FALSE if no empty spot was found
  2650. ' TRUE if an empty spot was found, and x,y,z location returned byref in destX,destY,destZ parameters
  2651.  
  2652. 'bFound= FindEmptyShearRotationPoint4%(arrLost(iLoop)        , iDirection           , x - iDiffPolarX , y - iDiffPolarY , z - iDiffPolarZ, NewArray() )
  2653. Function FindEmptyShearRotationPoint4%(FindMe As RotationType, iDirection As Integer, destX as integer, destY as integer, destZ, NewArray() As MapTileType)
  2654.     Dim bResult as Integer : bResult = FALSE
  2655.     Dim x As Integer
  2656.     Dim y As Integer
  2657.     Dim z As Integer
  2658.     Dim dirX As Integer
  2659.     Dim dirY As Integer
  2660.     Dim bContinue As Integer
  2661.    
  2662.     ' Initialize
  2663.     destX = 0
  2664.     destY = 0
  2665.     destZ = 0 ' added for 3D
  2666.     bContinue = TRUE
  2667.    
  2668.     ' Choose search direction based on the quadrant of the screen
  2669.     ' and the direction of rotation:
  2670.    
  2671.     ' iScreenZone   iDirection           search direction (y,x)
  2672.     ' -----------   ------------------   ----------------------
  2673.     ' 1             cClockwise           down + right ( 1, 1)
  2674.     ' 1             cCounterClockwise    up   + left  (-1,-1)
  2675.     ' 2             cClockwise           down + left  ( 1,-1)
  2676.     ' 2             cCounterClockwise    up   + right (-1, 1)
  2677.     ' 3             cClockwise           up   + left  (-1,-1)
  2678.     ' 3             cCounterClockwise    down + right ( 1, 1)
  2679.     ' 4             cClockwise           up   + right (-1, 1)
  2680.     ' 4             cCounterClockwise    down + left  ( 1,-1)
  2681.    
  2682.     If     FindMe.zone = 1 And iDirection = cClockwise Then
  2683.         dirY = 1
  2684.         dirX = 1
  2685.     ElseIf FindMe.zone = 1 And iDirection = cCounterClockwise Then
  2686.         dirY = -1
  2687.         dirX = -1
  2688.     ElseIf FindMe.zone = 2 And iDirection = cClockwise Then
  2689.         dirY = 1
  2690.         dirX = -1
  2691.     ElseIf FindMe.zone = 2 And iDirection = cCounterClockwise Then
  2692.         dirY = -1
  2693.         dirX = 1
  2694.     ElseIf FindMe.zone = 3 And iDirection = cClockwise Then
  2695.         dirY = -1
  2696.         dirX = -1
  2697.     ElseIf FindMe.zone = 3 And iDirection = cCounterClockwise Then
  2698.         dirY = 1
  2699.         dirX = 1
  2700.     ElseIf FindMe.zone = 4 And iDirection = cClockwise Then
  2701.         dirY = -1
  2702.         dirX = 1
  2703.     ElseIf FindMe.zone = 4 And iDirection = cCounterClockwise Then
  2704.         dirY = 1
  2705.         dirX = -1
  2706.     Else
  2707.         bContinue = FALSE
  2708.     End If
  2709.    
  2710.     ' Quit if we're out of bounds
  2711.     If bContinue = TRUE Then
  2712.         bContinue = FALSE
  2713.         x = FindMe.origx
  2714.         y = FindMe.origy
  2715.         z = FindMe.origz
  2716.         if x >= LBound(NewArray, 1) then
  2717.             if x <= UBound(NewArray, 1) then
  2718.                 if y >= LBound(NewArray, 2) then
  2719.                     if y <= UBound(NewArray, 2) then
  2720.                         if z >= LBound(NewArray, 3) then ' added checking z for 3D
  2721.                             if z <= UBound(NewArray, 3) then  ' added checking z for 3D
  2722.                                 bContinue = TRUE
  2723.                             end if
  2724.                         end if
  2725.                     end if
  2726.                 end if
  2727.             end if
  2728.         end if
  2729.     End If
  2730.    
  2731.     ' look along y axis for an available adjacent point
  2732.     If bContinue = TRUE Then
  2733.         destX = x
  2734.         destY = y + dirY
  2735.         destZ = z
  2736.         if destX >= LBound(NewArray, 1) then
  2737.             if destX <= UBound(NewArray, 1) then
  2738.                 if destY >= LBound(NewArray, 2) then
  2739.                     if destY <= UBound(NewArray, 2) then
  2740.                         if NewArray(destX, destY, destZ).Typ = c_iTile_Empty then
  2741.                             NewArray(destX, destY, destZ).Typ = FindMe.Typ
  2742.                             NewArray(destX, destY, destZ).Color1 = FindMe.Color1
  2743.                             NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
  2744.                             bResult = TRUE
  2745.                             bContinue = FALSE
  2746.                         end if
  2747.                     end if
  2748.                 end if
  2749.             end if
  2750.         end if
  2751.     end if
  2752.    
  2753.     ' look along x axis for an available adjacent point
  2754.     If bContinue = TRUE Then
  2755.         destX = x + dirX
  2756.         destY = y
  2757.         destZ = z
  2758.         if destX >= LBound(NewArray, 1) then
  2759.             if destX <= UBound(NewArray, 1) then
  2760.                 if destY >= LBound(NewArray, 2) then
  2761.                     if destY <= UBound(NewArray, 2) then
  2762.                         if NewArray(x + dirX, y, destZ).Typ = c_iTile_Empty then
  2763.                             NewArray(destX, destY, destZ).Typ = FindMe.Typ
  2764.                             NewArray(destX, destY, destZ).Color1 = FindMe.Color1
  2765.                             NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
  2766.                             bResult = TRUE
  2767.                             bContinue = FALSE
  2768.                         end if
  2769.                     end if
  2770.                 end if
  2771.             end if
  2772.         end if
  2773.     end if
  2774.    
  2775.     ' look diagonally for an available adjacent point
  2776.     If bContinue = TRUE Then
  2777.         destX = x + dirX
  2778.         destY = y + dirY
  2779.         destZ = z
  2780.         if destX >= LBound(NewArray, 1) then
  2781.             if destX <= UBound(NewArray, 1) then
  2782.                 if destY >= LBound(NewArray, 2) then
  2783.                     if destY <= UBound(NewArray, 2) then
  2784.                         if NewArray(x + dirX, y + dirY, destZ).Typ = c_iTile_Empty then
  2785.                             NewArray(destX, destY, destZ).Typ = FindMe.Typ
  2786.                             NewArray(destX, destY, destZ).Color1 = FindMe.Color1
  2787.                             NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
  2788.                             bResult = TRUE
  2789.                             bContinue = FALSE
  2790.                         end if
  2791.                     end if
  2792.                 end if
  2793.             end if
  2794.         end if
  2795.     End If
  2796.    
  2797.     ' Return result
  2798.     FindEmptyShearRotationPoint4% = bResult
  2799. End Sub ' FindEmptyShearRotationPoint4%
  2800.  
  2801.  
  2802.  
  2803.  
  2804.  
  2805.  
  2806.  
  2807.  
  2808.  
  2809.  
  2810.  
  2811.  
  2812.  
  2813.  
  2814.  
  2815.  
  2816.  
  2817.  
  2818.  
  2819.  
  2820.  
  2821.  
  2822.  
  2823.  
  2824.  
  2825.  
  2826.  
  2827.  
  2828.  
  2829.  
  2830.  
  2831.  
  2832.  
  2833.  
  2834.  
  2835.  
  2836.  
  2837.  
  2838.  
  2839.  
  2840.  
  2841.  
  2842.  
  2843.  
  2844.  
  2845.  
  2846.  
  2847.  
  2848.  
  2849.  
  2850.  
  2851.  
  2852. ' /////////////////////////////////////////////////////////////////////////////
  2853. ' Lets you draw a scene in 2.5D and save it to a file. Woo hoo!
  2854.  
  2855. ' Version 1 only supports 2 tile types:
  2856. ' c_iTile_Empty
  2857. ' c_iTile_Wall
  2858.  
  2859. Function IsometricDraw1$
  2860.     ' -----------------------------------------------------------------------------
  2861.     ' BEGIN LOCAL VARS #local
  2862.     Dim RoutineName As String: RoutineName = "IsometricDraw1"
  2863.     Dim sResult As String: sResult = ""
  2864.     Dim sError As String: sError = ""
  2865.     Dim sNextErr As String: sNextErr = ""
  2866.     Dim sDebug As String
  2867.     Dim in$
  2868.    
  2869.     ' flags
  2870.     Dim bFound As Integer
  2871.     Dim bContinue As Integer
  2872.     Dim bFinished As Integer
  2873.     Dim bDone As Integer
  2874.    
  2875.     ' basic counters
  2876.     Dim iLoop1 As Integer
  2877.     Dim iLoop2 As Integer
  2878.     Dim iTotal% ' compute total available spaces
  2879.     Dim iCount% ' count # of spaces searched
  2880.     Dim iIndex As Long
  2881.     Dim iValue As Integer
  2882.    
  2883.     ' coordinates
  2884.     Dim iX%
  2885.     Dim iY%
  2886.     Dim iZ%
  2887.     Dim iNewX%
  2888.     Dim iNewY%
  2889.     Dim iNewZ%
  2890.     Dim iLoopX%
  2891.     Dim iLoopY%
  2892.     Dim iLoopZ%
  2893.     Dim iNextX As Integer
  2894.     Dim iNextY As Integer
  2895.     Dim iPosX1%
  2896.     Dim iPosX2%
  2897.     Dim iPosY1%
  2898.     Dim iPosY2%
  2899.     Dim iPosZ1%
  2900.     Dim iPosZ2%
  2901.     Dim iDirection%
  2902.    
  2903.     ' counters
  2904.     Dim iLevelCount%
  2905.     Dim iLevelSize%
  2906.    
  2907.     ' object size + drawing
  2908.     Dim iWidth As Integer
  2909.     Dim iLength As Integer
  2910.     Dim iHeight As Integer
  2911.     Dim iRadius As Integer
  2912.     Dim iSize%
  2913.     Dim iSizeX%
  2914.     Dim iSizeY%
  2915.     Dim iOffsetX%
  2916.     Dim iOffsetY%
  2917.     Dim iDrawX%
  2918.     Dim iDrawY%
  2919.    
  2920.     ' colors
  2921.     Dim iNextColor~&
  2922.     Dim iFirstColor~&
  2923.     Dim iMyColor~&
  2924.     Dim iColorScheme%
  2925.     Dim iDrawColor%
  2926.     Dim iCursorColor~&
  2927.    
  2928.     ' keyboard
  2929.     Dim bEnableRepeatingKeys As Integer
  2930.     Dim iLastKey As Integer ' USED WHEN REPEATING KEYS DISABLED
  2931.    
  2932.     ' player
  2933.     Dim iPlayerLoop As Integer
  2934.     Dim iDirLoop As Integer
  2935.     Dim bIgnoreTerrain As Integer ' If TRUE, player can move through walls, etc.
  2936.    
  2937.     ' undo
  2938.     Dim MapTileTempUndo As MapUndoType
  2939.    
  2940.     ' cuboid
  2941.     ReDim arrColor1(-1) As _Unsigned Long
  2942.    
  2943.     ' tree
  2944.     Dim iTreeX As Integer
  2945.     Dim iTreeY As Integer
  2946.     Dim iTreeTrunkZ As Integer
  2947.     Dim iTreeBottomZ As Integer
  2948.     Dim iTreeLightsMaxZ As Integer
  2949.     Dim iTreeTopZ As Integer
  2950.     Dim iBottomRadius As Integer
  2951.     Dim iTopRadius As Integer
  2952.     Dim iBaseRadius As Integer
  2953.     dim iDR As Integer
  2954.     dim iDDR As Integer
  2955.     Dim iBaseZ%
  2956.     ReDim arrSemicircle(-1, -1) As _Byte
  2957.     ReDim arrDistance(-1) As Integer
  2958.     ReDim iConeIndex As Integer
  2959.     Dim iConeRadius As Integer
  2960.     Dim sngConeRadius As Single
  2961.     Dim sngConeDec As Single
  2962.     ReDim arrCircle(-1, -1) As _Byte
  2963.     ReDim arrTreeCone(-1) As xyzIntegerType
  2964.     Dim iLastCircleZ As Integer
  2965.    
  2966.     ' snow, lights, star, ornaments
  2967.     Dim iXmasObjectCount As Integer : iXmasObjectCount = 1000
  2968.     ReDim arrXmas(0 to iXmasObjectCount) As XmasObjectType
  2969.     Dim iStarIndex As Integer : iStarIndex = 0
  2970.     Dim iSnowIndexFrom As Integer : iSnowIndexFrom = 1
  2971.     Dim iSnowIndexTo As Integer : iSnowIndexTo = 200
  2972.     Dim iOrnaIndexFrom As Integer : iOrnaIndexFrom = 201
  2973.     Dim iOrnaIndexTo As Integer : iOrnaIndexTo = 400
  2974.     Dim iLightIndexFrom As Integer : iLightIndexFrom = 401
  2975.     Dim iLightIndexTo As Integer : iLightIndexTo = 1000
  2976.    
  2977.     Dim iSnowFreq As Integer ' used to control how frequently a snowflake is spawned
  2978.     Dim iSnowFreqMax As Integer ' maximum value of iSnowFreq
  2979.     Dim iSnowCount As Integer ' # of active snowflakes
  2980.     Dim iSnowMax As Integer ' maximum # of snowflakes active at one time
  2981.     Dim bMakeSnow As Integer
  2982.     Dim iLightCounter As Integer
  2983.     Dim iLightMax As Integer
  2984.     Dim iOrnaCounter As Integer
  2985.     Dim iOrnaMax As Integer
  2986.     Dim iLastZ As Integer
  2987.     ReDim arrLine(-1, -1) As _Byte
  2988.    
  2989.     ' text
  2990.     ReDim arrMessage(-1) As ColorTextType
  2991.     Dim sMessage As String
  2992.     Dim iMsgColorCount As Integer
  2993.     Dim iMsgColorMax As Integer
  2994.    
  2995.     ' rotation
  2996.     Dim iAngleXY As Integer
  2997.     Dim iRotationCount As Integer
  2998.     Dim iRotationMax As Integer
  2999.     Dim iIncrementAngle As Integer
  3000.    
  3001.     '' USED FOR FIRST PERSON VIEW
  3002.     'Dim iDistance As Integer
  3003.     'Dim arrFPBrickSize(0 to 7) as Integer
  3004.    
  3005.     ' END LOCAL VARS @local
  3006.     ' -----------------------------------------------------------------------------
  3007.    
  3008.    
  3009.    
  3010.    
  3011.    
  3012.    
  3013.    
  3014.     ' =============================================================================
  3015.     ' GET OPTIONS
  3016.     m_iPlayerCount = 1
  3017.     'm_iPlayerCount = PromptForIntegerInRange%("How many players ({min}-{max} or blank to quit)?", 1, 4, 0)
  3018.     'IF m_iPlayerCount = 0 THEN Goto CleanupAndExit
  3019.     bEnableRepeatingKeys = FALSE
  3020.    
  3021.     ' INITIALIZE OTHER SHARED VARIABLES
  3022.     'TODO: store color sequences in a linked list or dictionary
  3023.     'GetGreenTreeColors m_arrGreenTreeColors
  3024.    
  3025.     ' =============================================================================
  3026.     ' INITIALIZE GRAPHIC SCREEN
  3027.     'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
  3028.     Screen _NewImage(1280, 1024, 32): _ScreenMove 0, 0
  3029.    
  3030.    
  3031. '    ' -----------------------------------------------------------------------------
  3032. '    ' INITIALIZE FIRST PERSON VIEW VARIABLES
  3033. '    iWidth = 16
  3034. '    for iDistance = 0 to 7
  3035. '        arrFPBrickSize(iDistance) = iWidth
  3036. '        iWidth = iWidth - 1
  3037. '    next iDistance
  3038. '    
  3039. '    arrFP_From(0) = -3
  3040. '    arrFP_From(1) = -3
  3041. '    arrFP_From(2) = -3
  3042. '    arrFP_From(3) = -3
  3043. '    arrFP_From(4) = -4
  3044. '    arrFP_From(5) = -4
  3045. '    arrFP_From(6) = -5
  3046. '    arrFP_From(7) = -6
  3047. '    
  3048. '    arrFP_To(0) = 4
  3049. '    arrFP_To(1) = 4
  3050. '    arrFP_To(2) = 4
  3051. '    arrFP_To(3) = 4
  3052. '    arrFP_To(4) = 5
  3053. '    arrFP_To(5) = 5
  3054. '    arrFP_To(6) = 6
  3055. '    arrFP_To(7) = 7
  3056.    
  3057.     ' -----------------------------------------------------------------------------
  3058.     ' BEGIN PLAYER 1 SCREEN PLACEMENT
  3059.     ' -----------------------------------------------------------------------------
  3060.     ' WINDOW PLACEMENT
  3061.     m_arrSplitScreen(1).GridOffsetX = 50
  3062.     m_arrSplitScreen(1).GridOffsetY = 50
  3063.     m_arrSplitScreen(1).GridOffsetZ = 0
  3064.     m_arrSplitScreen(1).ScreenOffsetX = 450
  3065.     m_arrSplitScreen(1).ScreenOffsetY = 200
  3066.     m_arrSplitScreen(1).ScreenOffsetZ = 0
  3067.    
  3068.     ' MINIMAP PLACEMENT
  3069.     m_arrSplitScreen(1).MiniMapFirstPersonX = m_iMiniMapStartCol + (0 * m_iMiniMapSize)
  3070.     m_arrSplitScreen(1).MiniMapFirstPersonY = m_iMiniMapStartRow
  3071.     m_arrSplitScreen(1).MiniMapTopDownX = m_iMiniMapStartCol + (1 * m_iMiniMapSize)
  3072.     m_arrSplitScreen(1).MiniMapTopDownY = m_iMiniMapStartRow
  3073.     m_arrSplitScreen(1).MiniMapFrontBackX = m_iMiniMapStartCol + (2 * m_iMiniMapSize)
  3074.     m_arrSplitScreen(1).MiniMapFrontBackY = m_iMiniMapStartRow
  3075.     m_arrSplitScreen(1).MiniMapRightLeftX = m_iMiniMapStartCol + (3 * m_iMiniMapSize)
  3076.     m_arrSplitScreen(1).MiniMapRightLeftY = m_iMiniMapStartRow
  3077.    
  3078.     ' MINIMAP TEXT PLACEMENT
  3079.     m_arrSplitScreen(1).MiniMapFirstPersonTextX = m_iMiniMapTextStartCol + (0 * m_iMiniMapTextSize)
  3080.     m_arrSplitScreen(1).MiniMapFirstPersonTextY = m_iMiniMapTextStartRow
  3081.     m_arrSplitScreen(1).MiniMapTopDownTextX = m_iMiniMapTextStartCol + (1 * m_iMiniMapTextSize)
  3082.     m_arrSplitScreen(1).MiniMapTopDownTextY = m_iMiniMapTextStartRow
  3083.     m_arrSplitScreen(1).MiniMapFrontBackTextX = m_iMiniMapTextStartCol + (2 * m_iMiniMapTextSize)
  3084.     m_arrSplitScreen(1).MiniMapFrontBackTextY = m_iMiniMapTextStartRow
  3085.     m_arrSplitScreen(1).MiniMapRightLeftTextX = m_iMiniMapTextStartCol + (3 * m_iMiniMapTextSize)
  3086.     m_arrSplitScreen(1).MiniMapRightLeftTextY = m_iMiniMapTextStartRow
  3087.     ' -----------------------------------------------------------------------------
  3088.     ' END PLAYER 1 SCREEN PLACEMENT
  3089.     ' -----------------------------------------------------------------------------
  3090.    
  3091.    
  3092.    
  3093.     ' -----------------------------------------------------------------------------
  3094.     ' BEGIN PLAYER 2 SCREEN PLACEMENT
  3095.     ' -----------------------------------------------------------------------------
  3096.     ' WINDOW PLACEMENT
  3097.     m_arrSplitScreen(2).GridOffsetX = 50
  3098.     m_arrSplitScreen(2).GridOffsetY = 50
  3099.     m_arrSplitScreen(2).GridOffsetZ = 0
  3100.     m_arrSplitScreen(2).ScreenOffsetX = 1000
  3101.     m_arrSplitScreen(2).ScreenOffsetY = 200
  3102.     m_arrSplitScreen(2).ScreenOffsetZ = 0
  3103.     'TODO: add minimap parameters for player 2
  3104.     ' -----------------------------------------------------------------------------
  3105.     ' END PLAYER 2 SCREEN PLACEMENT
  3106.     ' -----------------------------------------------------------------------------
  3107.    
  3108.     ' -----------------------------------------------------------------------------
  3109.     ' BEGIN PLAYER 3 SCREEN PLACEMENT
  3110.     ' -----------------------------------------------------------------------------
  3111.     ' WINDOW PLACEMENT
  3112.     m_arrSplitScreen(3).GridOffsetX = 50
  3113.     m_arrSplitScreen(3).GridOffsetY = 50
  3114.     m_arrSplitScreen(3).GridOffsetZ = 0
  3115.     m_arrSplitScreen(3).ScreenOffsetX = 450
  3116.     m_arrSplitScreen(3).ScreenOffsetY = 700
  3117.     m_arrSplitScreen(3).ScreenOffsetZ = 0
  3118.     'TODO: add minimap parameters for player 3
  3119.     ' -----------------------------------------------------------------------------
  3120.     ' END PLAYER 3 SCREEN PLACEMENT
  3121.     ' -----------------------------------------------------------------------------
  3122.    
  3123.     ' -----------------------------------------------------------------------------
  3124.     ' BEGIN PLAYER 4 SCREEN PLACEMENT
  3125.     ' -----------------------------------------------------------------------------
  3126.     ' WINDOW PLACEMENT
  3127.     m_arrSplitScreen(4).GridOffsetX = 50
  3128.     m_arrSplitScreen(4).GridOffsetY = 50
  3129.     m_arrSplitScreen(4).GridOffsetZ = 0
  3130.     m_arrSplitScreen(4).ScreenOffsetX = 1000
  3131.     m_arrSplitScreen(4).ScreenOffsetY = 700
  3132.     m_arrSplitScreen(4).ScreenOffsetZ = 0
  3133.     'TODO: add minimap parameters for player 4
  3134.     ' -----------------------------------------------------------------------------
  3135.     ' END PLAYER 4 SCREEN PLACEMENT
  3136.     ' -----------------------------------------------------------------------------
  3137.    
  3138.    
  3139.    
  3140.     ' -----------------------------------------------------------------------------
  3141.     ' INITIALIZE MAP TO EMPTY
  3142.     ClearIsometricMap
  3143.     ReDim m_arrRecord(-1) As RecordType
  3144.  
  3145.     ' -----------------------------------------------------------------------------
  3146.     ' INITIALIZE COLOR ARRAY
  3147.     m_arrColors(0) = cEmpty
  3148.     m_arrColors(1) = cBlack
  3149.     m_arrColors(2) = cDarkGray
  3150.     m_arrColors(3) = cDimGray
  3151.     m_arrColors(4) = cGray
  3152.     m_arrColors(5) = cLightGray
  3153.     m_arrColors(6) = cSilver
  3154.     m_arrColors(7) = cWhite
  3155.     m_arrColors(8) = cRed
  3156.     m_arrColors(9) = cOrangeRed
  3157.     m_arrColors(10) = cDarkOrange
  3158.     m_arrColors(11) = cOrange
  3159.     m_arrColors(12) = cGold
  3160.     m_arrColors(13) = cYellow
  3161.     m_arrColors(14) = cOliveDrab1
  3162.     m_arrColors(15) = cLime
  3163.     m_arrColors(16) = cMediumSpringGreen
  3164.     m_arrColors(17) = cCyan
  3165.     m_arrColors(18) = cDeepSkyBlue
  3166.     m_arrColors(19) = cDodgerBlue
  3167.     m_arrColors(20) = cSeaBlue
  3168.     m_arrColors(21) = cBlue
  3169.     m_arrColors(22) = cBluePurple
  3170.     m_arrColors(23) = cDeepPurple
  3171.     m_arrColors(24) = cPurple
  3172.     m_arrColors(25) = cPurpleRed
  3173.    
  3174.     ' -----------------------------------------------------------------------------
  3175.     ' INITIALIZE OTHER VARIABLES
  3176.     bIgnoreTerrain = TRUE
  3177.  
  3178.     ' -----------------------------------------------------------------------------
  3179.     ' BEGIN DRAW GROUND
  3180.     ' -----------------------------------------------------------------------------
  3181.     IF TRUE=TRUE THEN
  3182.         For iLoopZ% = m_iMapMinZ To m_iMapMinZ
  3183.             For iLoopX% = m_iMapMinX To m_iMapMaxX
  3184.                 For iLoopY% = m_iMapMinY To m_iMapMaxY
  3185.                     'PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cLightBrown
  3186.                     PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhiteSmoke
  3187.                 Next iLoopY%
  3188.             Next iLoopX%
  3189.         Next iLoopZ%
  3190.     END IF
  3191.     ' -----------------------------------------------------------------------------
  3192.     ' END DRAW GROUND
  3193.     ' -----------------------------------------------------------------------------
  3194.    
  3195.     ' -----------------------------------------------------------------------------
  3196.     ' BEGIN DRAW TILE FLOOR
  3197.     ' -----------------------------------------------------------------------------
  3198.     IF TRUE=FALSE THEN
  3199.         For iLoopZ% = m_iMapMinZ To m_iMapMinZ
  3200.             For iLoopX% = m_iMapMinX To m_iMapMaxX
  3201.                 For iLoopY% = m_iMapMinY To m_iMapMaxY
  3202.                     ' ALTERNATE TILE COLORS
  3203.                     If IsEven%(iLoopX%) = TRUE Then
  3204.                         If IsEven%(iLoopY%) = TRUE Then
  3205.                             PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
  3206.                         Else
  3207.                             PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
  3208.                         End If
  3209.                     Else
  3210.                         If IsEven%(iLoopY%) = TRUE Then
  3211.                             PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
  3212.                         Else
  3213.                             PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
  3214.                         End If
  3215.                     End If
  3216.                 Next iLoopY%
  3217.             Next iLoopX%
  3218.         Next iLoopZ%
  3219.     END IF
  3220.     ' -----------------------------------------------------------------------------
  3221.     ' END DRAW TILE FLOOR
  3222.     ' -----------------------------------------------------------------------------
  3223.    
  3224.     ' -----------------------------------------------------------------------------
  3225.     ' BEGIN DRAW A TALL HOLLOW PYRAMID
  3226.     ' -----------------------------------------------------------------------------
  3227.     If TRUE = FALSE Then
  3228.         iX% = 5
  3229.         iY% = 10
  3230.         iZ% = 1
  3231.         iLevelSize% = 4
  3232.  
  3233.         iPosX1% = iX%
  3234.         iPosX2% = iX% + 7
  3235.         iPosY1% = iY%
  3236.         iPosY2% = iY% + 7
  3237.  
  3238.         iNextColor~& = cRed
  3239.         iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
  3240.  
  3241.         'iNextColor~& = cWhite
  3242.         'iColorScheme% = 3 ' 3, 11 = grayscale, ascending
  3243.  
  3244.         iLevelCount% = 0
  3245.  
  3246.         bContinue = TRUE
  3247.         Do
  3248.             ' Draw front/back walls
  3249.             For iLoopX% = iPosX1% To iPosX2%
  3250.                 iLoopY% = iPosY1%
  3251.                 PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
  3252.  
  3253.                 iLoopY% = iPosY2%
  3254.                 PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
  3255.             Next iLoopX%
  3256.  
  3257.             ' Draw left/right walls
  3258.             For iLoopY% = iPosY1% To iPosY2%
  3259.                 iLoopX% = iPosX1%
  3260.                 PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
  3261.  
  3262.                 iLoopX% = iPosX2%
  3263.                 PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
  3264.             Next iLoopY%
  3265.  
  3266.             ' Add a door to middle of right wall
  3267.             iX% = iPosX1% + ((iPosX2% - iPosX1%) \ 2)
  3268.             PlotTile iX%, iPosY2%, iZ%, c_iTile_Empty, iNextColor~&
  3269.  
  3270.             ' Add a door to middle of front wall
  3271.             iY% = iPosY1% + ((iPosY2% - iPosY1%) \ 2)
  3272.             PlotTile iPosX2%, iY%, iZ%, c_iTile_Empty, iNextColor~&
  3273.  
  3274.             ' MOVE UP A LEVEL
  3275.             iLevelCount% = iLevelCount% + 1
  3276.             If iLevelCount% > iLevelSize% Then
  3277.                 iLevelCount% = 0
  3278.                 iPosX1% = iPosX1% + 1
  3279.                 iPosX2% = iPosX2% - 1
  3280.                 iPosY1% = iPosY1% + 1
  3281.                 iPosY2% = iPosY2% - 1
  3282.             End If
  3283.  
  3284.             ' QUIT AFTER WE REACH THE TOP
  3285.             If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
  3286.                 iZ% = iZ% + 1
  3287.                 DoCycleColor iColorScheme%, iNextColor~&
  3288.                 If iZ% > m_iMapMaxZ Then
  3289.                     bContinue = FALSE
  3290.                 End If
  3291.             Else
  3292.                 bContinue = FALSE
  3293.             End If
  3294.  
  3295.         Loop Until bContinue = FALSE
  3296.     End If
  3297.     ' -----------------------------------------------------------------------------
  3298.     ' END DRAW A TALL HOLLOW PYRAMID
  3299.     ' -----------------------------------------------------------------------------
  3300.    
  3301.     ' -----------------------------------------------------------------------------
  3302.     ' BEGIN DRAW A CUBOID
  3303.     ' -----------------------------------------------------------------------------
  3304.     IF TRUE = FALSE THEN
  3305.         'PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
  3306.         PlotCuboid 1, 5, 2, 4, 2, 3, c_iTile_Wall, cHotPink
  3307.     END IF
  3308.     ' -----------------------------------------------------------------------------
  3309.     ' END DRAW A CUBOID
  3310.     ' -----------------------------------------------------------------------------
  3311.    
  3312.     ' -----------------------------------------------------------------------------
  3313.     ' BEGIN DRAW SOME CIRCLES
  3314.     ' -----------------------------------------------------------------------------
  3315.     IF TRUE=FALSE THEN
  3316.         ' PlotCircle iAxis, startX, startY, startZ, radius, iTile, iColor
  3317.         PlotCircle cPlaneXY, 15, 15, 2, 7, c_iTile_Wall, cRed
  3318.         PlotCircle cPlaneYZ, 19, 20, 10, 6, c_iTile_Wall, cLime
  3319.         PlotCircle cPlaneZX, 23, 25, 20, 8, c_iTile_Wall, cBlue
  3320.     END IF
  3321.     ' -----------------------------------------------------------------------------
  3322.     ' END DRAW SOME CIRCLES
  3323.     ' -----------------------------------------------------------------------------
  3324.    
  3325.     ' -----------------------------------------------------------------------------
  3326.     ' BEGIN TEST SOME COLORS
  3327.     ' -----------------------------------------------------------------------------
  3328.     IF TRUE=FALSE THEN
  3329.         GetGreenTreeColors arrColor1()
  3330.         iX% = 2
  3331.         iY% = 2
  3332.         iZ% = 2
  3333.         iWidth = 2
  3334.         iLength = 2
  3335.         iHeight = 8
  3336.         for iLoop1 = lbound(arrColor1) to ubound(arrColor1)
  3337.             iMyColor~& = arrColor1(iLoop1)
  3338.             iY% = iY% + 2
  3339.             if (iY% > (m_iMapMaxY - 2) ) then
  3340.                 iY% = 2
  3341.                 iX% = iX% + 6
  3342.                 if (iX% > (m_iMapMaxX - 6) ) then
  3343.                     iX% = 6
  3344.                     iZ% = iZ% + 8
  3345.                     if (iZ% > (m_iMapMaxZ - 8) ) then
  3346.                         Exit For
  3347.                     end if
  3348.                 end if
  3349.             end if
  3350.             'PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
  3351.             PlotCuboid iX%, iWidth, iY%, iLength, iZ%, iHeight, c_iTile_Wall, iMyColor~&
  3352.         next iLoop1
  3353.     END IF
  3354.     ' -----------------------------------------------------------------------------
  3355.     ' END TEST SOME COLORS
  3356.     ' -----------------------------------------------------------------------------
  3357.    
  3358.    
  3359.    
  3360.    
  3361.    
  3362.    
  3363.    
  3364.    
  3365.    
  3366.    
  3367.    
  3368.    
  3369.    
  3370.    
  3371.     ' -----------------------------------------------------------------------------
  3372.     ' BEGIN DRAW TREE #TREE duh#twee!
  3373.     ' -----------------------------------------------------------------------------
  3374.     IF TRUE = TRUE THEN
  3375.        
  3376.         ' x/y location of tree
  3377.         iTreeX = 31
  3378.         iTreeY = 31
  3379.        
  3380.         ' DRAW TRUNK
  3381.         iRadius = 2
  3382.         iTreeTrunkZ = 1
  3383.         for iZ% = iTreeTrunkZ to iTreeTrunkZ + 3
  3384.             ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  3385.             CircleFill cPlaneXY, iTreeX, iTreeY, iZ%, iRadius, c_iTile_Wall, cLightBrown
  3386.         next iZ%
  3387.        
  3388.         ' SIZE THE TREE
  3389.         iBaseZ% = 4 ' initial z location
  3390.         iBottomRadius = 20 ' initial radius size
  3391.         iTopRadius = 5
  3392.         iLevelSize% = 6 ' how many blocks high each level is
  3393.         iDR = 3 ' how fast radius decreases with each level
  3394.         iTreeBottomZ = iBaseZ% + 1
  3395.         iBaseRadius = iBottomRadius
  3396.         'iConeRadius = iBottomRadius
  3397.         'sngConeRadius = val(cstr$(iConeRadius))
  3398.         'iConeDec = iLevelSize% / iDR
  3399.         sngConeDec = (iDR / iLevelSize%) / 2.25
  3400.        
  3401.         'ReDim arrTreeCone(1 To iBottomRadius * iBottomRadius * m_iMapMaxZ, 1 To 3) As Integer
  3402.         'DebugPrint "ReDim arrTreeCone(" + cstr$(lbound(arrTreeCone,1)) + " To " + cstr$(ubound(arrTreeCone, 1)) + ", " + cstr$(lbound(arrTreeCone,2)) + " To " + cstr$(ubound(arrTreeCone, 2)) + ") As Integer"
  3403.         iConeIndex = 0
  3404.        
  3405.         ' DRAW THE TREE
  3406.         iColorScheme% = 20
  3407.         iNextColor~& = cGreen
  3408.         bFinished = FALSE
  3409.         iLastCircleZ = 0
  3410.         Do
  3411.             ' GET NEXT COLOR
  3412.             DoCycleColor iColorScheme%, iNextColor~&
  3413.            
  3414.             ' -----------------------------------------------------------------------------
  3415.             ' BEGIN GET CURVE
  3416.             ReDim arrSemicircle(-1, -1) As _Byte
  3417.             ReDim arrDistance(-1) As Integer
  3418.             'GetSemicircle R, Q, arrSemicircle()
  3419.             GetSemicircle iBaseRadius, 3, arrSemicircle()
  3420.             iDrawY% = 0
  3421.             'For iLoopY% = ubound(arrSemiCircle,2) to lbound(arrSemiCircle,2) step -1
  3422.             For iLoopY% = ubound(arrSemiCircle,2) to (ubound(arrSemiCircle,2)/2) step -1
  3423.                 iDrawX% = 0
  3424.                 For iLoopX% = lbound(arrSemiCircle,1) to ubound(arrSemiCircle,1)
  3425.                     if arrSemiCircle(iLoopX%, iLoopY%) = 0 then
  3426.                         iDrawX% = iDrawX% + 1
  3427.                     else
  3428.                         Exit For
  3429.                     end if
  3430.                 Next iLoopX%
  3431.                 iDrawY% = iDrawY% + 1
  3432.                 ReDim _Preserve arrDistance(1 To iDrawY%) As Integer
  3433.                 arrDistance(iDrawY%) = iDrawX%
  3434.             Next iLoopY%
  3435.             ' END GET CURVE
  3436.             ' -----------------------------------------------------------------------------
  3437.            
  3438.            
  3439.             ' -----------------------------------------------------------------------------
  3440.             ' BEGIN PLOT A CONE IN THE CROSS SHAPE OF THE CURVE
  3441.             'iConeRadius = 0
  3442.             sngConeRadius = 0
  3443.             FOR iLoopZ% = 1 TO ubound(arrDistance)
  3444.                 iRadius = arrDistance(iLoopZ%)
  3445.                
  3446.                 if sngConeRadius=0 then
  3447.                     'iConeRadius = iRadius+1
  3448.                     iConeRadius = iRadius
  3449.                     sngConeRadius = val(cstr$(iConeRadius))
  3450.                 else
  3451.                     'iConeRadius = iConeRadius - iConeDec
  3452.                     sngConeRadius = sngConeRadius - sngConeDec
  3453.                     iConeRadius = val(cstr$(sngConeRadius))
  3454.                 end if
  3455.                
  3456.                 iZ% = iBaseZ% + iLoopZ%
  3457.                
  3458.                 if iZ% > m_iMapMaxZ then
  3459.                     bFinished = TRUE
  3460.                     exit do
  3461.                 end if
  3462.                
  3463. 'DebugPrint "CircleFill iRadius=" + cstr$(iRadius) + " at iZ%=" + cstr$(iZ%)
  3464.                 ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  3465.                 CircleFill cPlaneXY, iTreeX, iTreeY, iZ%, iRadius, c_iTile_Wall, iNextColor~&
  3466.  
  3467.                 ' remember the highest point
  3468.                 iTreeTopZ = iZ%
  3469.                
  3470.                 ' -----------------------------------------------------------------------------
  3471.                 ' BEGIN SAVE COORDINATES FOR LIGHTS + ORNAMENTS
  3472.                 ' NOTE: this doesn't work all that great! only so much time and so many brain cells!
  3473.                 if iConeRadius > 5 then
  3474.                     if iLastCircleZ <> iZ% then
  3475.                         GetCircleData iConeRadius, arrCircle()
  3476.                         iLastCircleZ = iZ%
  3477.                        
  3478.                         ' FOR SOME REASON WE'RE GETTING >1 CONCENTRIC CIRCLES PER Z, WHY???
  3479.                         for iLoop1 = lbound(arrCircle, 1) to ubound(arrCircle, 1)-1 ' (-1 because we leave out the last brick, it picks up next level, a sort of coil... one day we may code a proper coil, lol!
  3480.                             ' left edge = iTreeX - iConeRadius
  3481.                             ' back edge = iTreeY - iConeRadius
  3482.                             iX% = (iTreeX - iConeRadius) + arrCircle(iLoop1, 1)
  3483.                             iY% = (iTreeY - iConeRadius) + arrCircle(iLoop1, 2)
  3484.                             if iX% >= m_iMapMinX then
  3485.                                 if iX% <= m_iMapMaxX then
  3486.                                     if iY% >= m_iMapMinY then
  3487.                                         if iY% <= m_iMapMaxY then
  3488.                                                 ReDim _PRESERVE arrTreeCone(ubound(arrTreeCone)+1) As xyzIntegerType
  3489.                                                 arrTreeCone(ubound(arrTreeCone)).x = iX%
  3490.                                                 arrTreeCone(ubound(arrTreeCone)).y = iY%
  3491.                                                 arrTreeCone(ubound(arrTreeCone)).z = iZ%
  3492. 'PLOT A POINT TO SHOW THE COORDINATES BEING SAVED:
  3493. 'PlotTile iX%, iY%, iZ%, c_iTile_Wall, cRed
  3494.                                         end if
  3495.                                     end if
  3496.                                 end if
  3497.                             end if
  3498.                         next iLoop1
  3499.                     end if
  3500.                 end if
  3501.                 ' END SAVE COORDINATES FOR LIGHTS + ORNAMENTS
  3502.                 ' -----------------------------------------------------------------------------
  3503.                
  3504.             NEXT iLoopZ%
  3505.             ' END PLOT A CONE IN THE CROSS SHAPE OF THE CURVE
  3506.             ' -----------------------------------------------------------------------------
  3507.            
  3508.             ' GET NEXT HEIGHT
  3509.             iBaseZ% = iBaseZ% + iLevelSize%
  3510.             iBaseRadius = iBaseRadius - iDR
  3511.             if iBaseRadius < 5 then bFinished = TRUE
  3512.             bNeedCircle = TRUE
  3513.            
  3514.             ' QUIT?
  3515.             if bFinished = TRUE then exit do
  3516.         Loop
  3517.        
  3518.     END IF
  3519.     ' -----------------------------------------------------------------------------
  3520.     ' END DRAW TREE @TREE dis@twee!
  3521.     ' -----------------------------------------------------------------------------
  3522.    
  3523.    
  3524.    
  3525.     ' -----------------------------------------------------------------------------
  3526.     ' BEGIN DRAW FRAME AROUND ENTIRE SPACE (TOP)
  3527.     ' -----------------------------------------------------------------------------
  3528.     IF TRUE=FALSE THEN
  3529.         For iLoopX% = m_iMapMinX + 3 To m_iMapMaxX - 3
  3530.             PlotTile iLoopX%, m_iMapMaxY - 3, m_iMapMaxZ, c_iTile_Wall, cPurple
  3531.             PlotTile iLoopX%, m_iMapMinY + 3, m_iMapMaxZ, c_iTile_Wall, cCyan
  3532.         Next iLoopX%
  3533.         For iLoopY% = m_iMapMinY + 3 To m_iMapMaxY - 3
  3534.             PlotTile m_iMapMinX + 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cOrange
  3535.             PlotTile m_iMapMaxX - 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cLime
  3536.         Next iLoopY%
  3537.     END IF
  3538.     ' -----------------------------------------------------------------------------
  3539.     ' END DRAW FRAME AROUND ENTIRE SPACE (TOP)
  3540.     ' -----------------------------------------------------------------------------
  3541.  
  3542.     ' -----------------------------------------------------------------------------
  3543.     ' BEGIN DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
  3544.     ' -----------------------------------------------------------------------------
  3545.     IF TRUE=FALSE THEN
  3546.         For iLoopX% = m_iMapMinX + 2 To m_iMapMaxX - 2
  3547.             PlotTile iLoopX%, m_iMapMaxY - 2, m_iMapMidZ, c_iTile_Wall, cDodgerBlue
  3548.             PlotTile iLoopX%, m_iMapMinY + 2, m_iMapMidZ, c_iTile_Wall, cDeepPurple
  3549.         Next iLoopX%
  3550.         For iLoopY% = m_iMapMinY + 2 To m_iMapMaxY - 2
  3551.             PlotTile m_iMapMinX + 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cDarkRed
  3552.             PlotTile m_iMapMaxX - 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cGold
  3553.         Next iLoopY%
  3554.     END IF
  3555.     ' -----------------------------------------------------------------------------
  3556.     ' END DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
  3557.     ' -----------------------------------------------------------------------------
  3558.  
  3559.     ' -----------------------------------------------------------------------------
  3560.     ' BEGIN DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
  3561.     ' -----------------------------------------------------------------------------
  3562.     IF TRUE=FALSE THEN
  3563.         For iLoopX% = m_iMapMinX + 1 To m_iMapMaxX - 1
  3564.             PlotTile iLoopX%, m_iMapMaxY - 1, m_iMapMinZ + 1, c_iTile_Wall, cSeaBlue
  3565.             PlotTile iLoopX%, m_iMapMinY + 1, m_iMapMinZ + 1, c_iTile_Wall, cChartreuse
  3566.         Next iLoopX%
  3567.         For iLoopY% = m_iMapMinY + 1 To m_iMapMaxY - 1
  3568.             PlotTile m_iMapMinX + 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, cOrangeRed
  3569.             PlotTile m_iMapMaxX - 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, cDeepSkyBlue
  3570.         Next iLoopY%
  3571.     END IF
  3572.     ' -----------------------------------------------------------------------------
  3573.     ' END DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
  3574.     ' -----------------------------------------------------------------------------
  3575.    
  3576.    
  3577.    
  3578.    
  3579.    
  3580.    
  3581.    
  3582.    
  3583.    
  3584.     ' =============================================================================
  3585.     ' PLACE PLAYER(S) <- ONLY ONE FOR THIS DEMO
  3586.  
  3587.     For iPlayerLoop = 1 To m_iPlayerCount
  3588.  
  3589.         ' -----------------------------------------------------------------------------
  3590.         ' BEGIN Map the 6 directional keys
  3591.         ' -----------------------------------------------------------------------------
  3592.         '*** CURRENTLY THIS IS NOT USED ***
  3593.         'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
  3594.         'TODO: WHATEVER THE KEYS MAPPED ARE, SWAP THEM NON-HARDCODED
  3595.  
  3596.         ' differently for each of the 6 directional orientations!
  3597.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyBack = c_iKeyDown_Down
  3598.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyForward = c_iKeyDown_Up
  3599.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyLeft = c_iKeyDown_Left
  3600.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyRight = c_iKeyDown_Right
  3601.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyUp = c_iKeyDown_PgDn
  3602.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyDown = c_iKeyDown_PgUp
  3603.  
  3604.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyBack = c_iKeyDown_PgDn
  3605.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyForward = c_iKeyDown_PgUp
  3606.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyLeft = c_iKeyDown_Left
  3607.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyRight = c_iKeyDown_Right
  3608.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyUp = c_iKeyDown_Up
  3609.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyDown = c_iKeyDown_Down
  3610.  
  3611.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyBack = c_iKeyDown_Right
  3612.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyForward = c_iKeyDown_Left
  3613.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyLeft = c_iKeyDown_Down
  3614.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyRight = c_iKeyDown_Up
  3615.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyUp = c_iKeyDown_PgUp
  3616.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyDown = c_iKeyDown_PgDn
  3617.  
  3618.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyBack = c_iKeyDown_Left
  3619.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyForward = c_iKeyDown_Right
  3620.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyLeft = c_iKeyDown_Up
  3621.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyRight = c_iKeyDown_Down
  3622.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyUp = c_iKeyDown_PgUp
  3623.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyDown = c_iKeyDown_PgDn
  3624.  
  3625.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyBack = c_iKeyDown_Down
  3626.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyForward = c_iKeyDown_Up
  3627.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyLeft = c_iKeyDown_Right
  3628.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyRight = c_iKeyDown_Left
  3629.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyUp = c_iKeyDown_PgUp
  3630.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyDown = c_iKeyDown_PgDn
  3631.  
  3632.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyBack = c_iKeyDown_Up
  3633.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyForward = c_iKeyDown_Down
  3634.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyLeft = c_iKeyDown_Left
  3635.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyRight = c_iKeyDown_Right
  3636.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyUp = c_iKeyDown_PgUp
  3637.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyDown = c_iKeyDown_PgDn
  3638.         ' -----------------------------------------------------------------------------
  3639.         ' END Map the 6 directional keys
  3640.         ' -----------------------------------------------------------------------------
  3641.  
  3642.         ' FIND START POSITION
  3643.         iX% = RandomNumber(m_iMapMinX, m_iMapMaxX)
  3644.         iY% = RandomNumber(m_iMapMinY, m_iMapMaxY)
  3645.         iZ% = 1 ' RandomNumber(m_iMapMinZ, m_iMapMaxZ)
  3646.  
  3647.         ' MAKE SURE IT'S EMPTY
  3648.         If m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty Then
  3649.             bFound = TRUE
  3650.         Else
  3651.             ' IF NOT EMPTY THEN TRY TO FIND AN EMPTY SPOT
  3652.             iTotal% = ((m_iMapMaxX - m_iMapMinX) + 1) * ((m_iMapMaxY - m_iMapMinY) + 1) * ((m_iMapMaxZ - m_iMapMinZ) + 1)
  3653.             iCount% = 0
  3654.             bFound = FALSE
  3655.             Do
  3656.                 iX% = iX% + 1
  3657.                 If iX% > m_iMapMaxX Then
  3658.                     ' reset x and move to next y
  3659.                     iX% = m_iMapMinX
  3660.                     iY% = iY% + 1
  3661.                     If iY% > m_iMapMaxY Then
  3662.                         ' reset y and move to next z
  3663.                         iY% = m_iMapMinY
  3664.                         iZ% = iZ% + 1
  3665.                         If iZ% > m_iMapMaxZ Then
  3666.                             ' RESET Z AND SEE IF WE HAVE CHECKED EVERYTHING
  3667.                             iZ% = m_iMapMinZ
  3668.                             iCount% = iCount% + 1
  3669.                             If iCount% >= iTotal% Then
  3670.                                 ' NONE FOUND, EXIT
  3671.                                 Exit Do
  3672.                             End If
  3673.                         Else
  3674.                             iCount% = iCount% + 1
  3675.                         End If
  3676.                     Else
  3677.                         iCount% = iCount% + 1
  3678.                     End If
  3679.                 Else
  3680.                     iCount% = iCount% + 1
  3681.                 End If
  3682.                 If m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty Then
  3683.                     ' FOUND AN EMPTY SPACE, EXIT
  3684.                     bFound = TRUE
  3685.                     Exit Do
  3686.                 End If
  3687.             Loop
  3688.         End If
  3689.  
  3690.         If bFound = TRUE Then
  3691.             ' PICK A DIRECTION (SIMPLE FOR NOW, LEFT OR RIGHT)
  3692.             If iX% <= m_iMapMidX Then
  3693.                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  3694.             Else
  3695.                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  3696.             End If
  3697.  
  3698.             m_arrPlayer(iPlayerLoop).Tile1 = c_iTile_Player1
  3699.  
  3700.             ' SAVE COORDINATES TO PLAYER
  3701.             ' ****************************************************************************************************************************************************************
  3702.             ' for this demo we'll just use iX% instead of m_arrPlayer(iPlayerLoop).x, etc.
  3703.             ' to make it more readable
  3704.             ' ****************************************************************************************************************************************************************
  3705.             m_arrPlayer(iPlayerLoop).x = iX%
  3706.             m_arrPlayer(iPlayerLoop).y = iY%
  3707.             m_arrPlayer(iPlayerLoop).z = iZ%
  3708.             m_arrPlayer(iPlayerLoop).View = c_iDir_Forward
  3709.             m_arrPlayer(iPlayerLoop).Color1 = cRed
  3710.             m_arrPlayer(iPlayerLoop).Alpha1 = 255
  3711.             m_arrPlayer(iPlayerLoop).AlphaOverride = 255
  3712.             m_arrPlayer(iPlayerLoop).ColorScheme1 = 2
  3713.             m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 = 5 ' change color every 5 frames
  3714.             m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
  3715.  
  3716.             ' DISPLAY OPTIONS
  3717.             m_arrPlayer(iPlayerLoop).GridSize = 4
  3718.             m_arrPlayer(iPlayerLoop).MapSize = 2
  3719.  
  3720.             ' RESET MOVEMENT VARIABLES
  3721.             m_arrPlayer(iPlayerLoop).IsMoving = FALSE
  3722.             m_arrPlayer(iPlayerLoop).IsMoved = FALSE
  3723.  
  3724.             ' ********************************************************************************
  3725.             ' *** THIS IS NOW DONE AT THE RENDERING LEVEL FOR PLAYERS AND NON-TERRAIN OBJECTS
  3726.             ' ********************************************************************************
  3727.             '' DRAW PLAYER
  3728.             'm_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
  3729.             'm_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
  3730.             'm_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
  3731.  
  3732.         Else
  3733.             sError = "Could not find an empty space to start player."
  3734.             Exit For
  3735.         End If
  3736.  
  3737.     Next iPlayerLoop
  3738.  
  3739.     ' =============================================================================
  3740.     ' OTHER SETUP
  3741.     If Len(sError) = 0 Then
  3742.         ' RESET INPUT
  3743.         _KeyClear
  3744.         iLastKey = c_iKeyDown_Enter
  3745.     End If
  3746.  
  3747.     ' INIT UNDO INFO:
  3748.     m_MapTileUndo.x = iX%
  3749.     m_MapTileUndo.y = iY%
  3750.     m_MapTileUndo.z = iZ%
  3751.     m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
  3752.     m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
  3753.     m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
  3754.    
  3755.    
  3756.    
  3757.    
  3758.    
  3759.    
  3760.    
  3761.    
  3762.    
  3763.    
  3764.    
  3765.    
  3766.    
  3767.    
  3768.    
  3769.    
  3770.     ' =============================================================================
  3771.     ' BEGIN ANIMATION LOOP #1 #ani
  3772.     ' =============================================================================
  3773.     If Len(sError) = 0 Then
  3774.        
  3775.        
  3776.         ' -----------------------------------------------------------------------------
  3777.         ' BEGIN SETUP TEXT
  3778.         ' TODO: encapsulate this stuff better?
  3779.         sMessage = "Happy New Year 2022!"
  3780.         ReDim arrMessage(1 To len(sMessage)) As ColorTextType
  3781.         iMyColor~& = cYellow
  3782.         For iLoop1 = 1 to len(sMessage)
  3783.             DoCycleColor 1, iMyColor~&
  3784.             arrMessage(iLoop1).s = mid$(sMessage, iLoop1, 1)
  3785.             arrMessage(iLoop1).fg = iMyColor~&
  3786.             ' TODO: why doesn't background color work?
  3787.             'arrMessage(iLoop1).bg = cEmpty
  3788.         Next iLoop1
  3789.         iMsgColorCount = 5
  3790.         iMsgColorMax = 5 ' determines how frequently colors change
  3791.         ' END SETUP TEXT
  3792.         ' -----------------------------------------------------------------------------
  3793.        
  3794.         ' -----------------------------------------------------------------------------
  3795.         ' BEGIN SETUP STAR
  3796.         arrXmas(iStarIndex).Typ = cXmasStar
  3797.         arrXmas(iStarIndex).IsEnabled = TRUE
  3798.         arrXmas(iStarIndex).x = iTreeX
  3799.         arrXmas(iStarIndex).y = iTreeY
  3800.         arrXmas(iStarIndex).z = iTreeTopZ
  3801.         arrXmas(iStarIndex).Color1 = cYellow
  3802.         arrXmas(iStarIndex).Color2 = cYellow
  3803.         arrXmas(iStarIndex).Color3 = cYellow
  3804.         arrXmas(iStarIndex).xCount = 0 : arrXmas(iStarIndex).xMin = 1 : arrXmas(iStarIndex).xMax = 2 ' XY ring
  3805.         arrXmas(iStarIndex).yCount = 0 : arrXmas(iStarIndex).yMin = 1 : arrXmas(iStarIndex).yMax = 2 ' YZ ring
  3806.         arrXmas(iStarIndex).zCount = 0 : arrXmas(iStarIndex).zMin = 1 : arrXmas(iStarIndex).zMax = 2 ' ZX ring
  3807.         ' END SETUP STAR
  3808.         ' -----------------------------------------------------------------------------
  3809.        
  3810.         ' -----------------------------------------------------------------------------
  3811.         ' BEGIN SETUP SNOWFLAKES
  3812.         For iCount% = iSnowIndexFrom to iSnowIndexTo
  3813.             arrXmas(iCount%).Typ = cXmasSnow
  3814.             arrXmas(iCount%).IsEnabled = FALSE
  3815.             arrXmas(iCount%).xCount = 0
  3816.             arrXmas(iCount%).xMax = 5
  3817.             arrXmas(iCount%).yCount = 0
  3818.             arrXmas(iCount%).yMax = 5
  3819.             arrXmas(iCount%).zCount = 0
  3820.             arrXmas(iCount%).zMax = 5
  3821.         Next iCount%
  3822.         iSnowFreq = 50
  3823.         iSnowFreqMax = 200
  3824.         iSnowMax = 100
  3825.         iSnowCount = 0
  3826.         bMakeSnow = FALSE
  3827.         ' END SETUP SNOWFLAKES
  3828.         ' -----------------------------------------------------------------------------
  3829.        
  3830.         ' -----------------------------------------------------------------------------
  3831.         ' BEGIN PLACE ORNAMENTS #orn
  3832.         For iCount% = iOrnaIndexFrom to iOrnaIndexTo
  3833.             arrXmas(iCount%).Typ = cXmasOrnament
  3834.             arrXmas(iCount%).IsEnabled = FALSE
  3835.         Next iCount%
  3836.        
  3837.         ' END PLACE ORNAMENTS @orn
  3838.         ' -----------------------------------------------------------------------------
  3839.        
  3840.         ' -----------------------------------------------------------------------------
  3841.         ' BEGIN PLACE LIGHTS #lites
  3842.         For iCount% = iLightIndexFrom to iLightIndexTo
  3843.             arrXmas(iCount%).Typ = cXmasLight
  3844.             arrXmas(iCount%).IsEnabled = FALSE
  3845.         Next iCount%
  3846.        
  3847.         ' set up parameters
  3848.         iLightMax = 6 : iLightCounter = 0
  3849.         iNextColor~& = cPurple
  3850.        
  3851.         ' quit when we get past this point
  3852.         iTreeLightsMaxZ = iTreeTopZ - 10
  3853.        
  3854.         ' get light coordinates from precalculated arrTreeCone(iConeIndex).x, arrTreeCone(iConeIndex).y, arrTreeCone(iConeIndex).z
  3855.         iConeIndex = 0
  3856.         bFinished = FALSE
  3857.         do
  3858.             iConeIndex = iConeIndex + 1
  3859.             if iConeIndex > ubound(arrTreeCone) then exit do
  3860.            
  3861.             iLightCounter = iLightCounter + 1
  3862.            
  3863.             ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3864.             ' BEGIN PLACE A LIGHT
  3865.             if iLightCounter > iLightMax then
  3866.                 iLightCounter = 0
  3867.                
  3868.                 bFound = FALSE
  3869.                 For iCount% = iLightIndexFrom to iLightIndexTo
  3870.                     if arrXmas(iCount%).Typ = cXmasLight then
  3871.                         if arrXmas(iCount%).IsEnabled = FALSE then
  3872.                             bFound = TRUE
  3873.                            
  3874.                             ' enable light
  3875.                             arrXmas(iCount%).IsEnabled = TRUE
  3876.                            
  3877.                             ' get coordinates from precalculated
  3878.                             iX% = arrTreeCone(iConeIndex).x
  3879.                             iY% = arrTreeCone(iConeIndex).y
  3880.                             iZ% = arrTreeCone(iConeIndex).z
  3881.                            
  3882.                             '' stop 5 spaces before top
  3883.                             'if iZ% < iTreeTopZ then
  3884.                             '    bFinished = TRUE
  3885.                             '    exit for
  3886.                             'end if
  3887.                            
  3888.                             ' set coordinates
  3889.                             arrXmas(iCount%).x = iX%
  3890.                             arrXmas(iCount%).y = iY%
  3891.                             arrXmas(iCount%).z = iZ%
  3892.                            
  3893.                             ' chose graphic tile
  3894.                             arrXmas(iCount%).Tile1 = c_iTile_Wall
  3895.                            
  3896.                             ' increment color
  3897.                             DoCycleColor 1, iNextColor~&
  3898.                             arrXmas(iCount%).Color1 = iNextColor~&
  3899.                             arrXmas(iCount%).Alpha1 = 255
  3900.                            
  3901.                             ' timer for blinking
  3902.                             arrXmas(iCount%).xMin = RandomNumber% (1, 9)
  3903.                             arrXmas(iCount%).xCount = RandomNumber% (arrXmas(iCount%).xMin, 10)
  3904.                             arrXmas(iCount%).xMax = 10
  3905.                            
  3906.                             ' stop looking
  3907.                             exit for
  3908.                         end if
  3909.                     end if
  3910.                 Next iCount%
  3911.                
  3912.                 ' quit if no lights available
  3913.                 If bFound = FALSE Then
  3914.                     bFinished = TRUE
  3915.                     DebugPrint "ran out of lights at iConeIndex=" + cstr$(iConeIndex)
  3916.                 End If
  3917.                
  3918.             end if
  3919.             ' END PLACE A LIGHT
  3920.             ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3921.         loop while bFinished = FALSE
  3922.        
  3923.         ' END PLACE LIGHTS @lites
  3924.         ' -----------------------------------------------------------------------------
  3925.        
  3926.         ' -----------------------------------------------------------------------------
  3927.         ' ROTATION SETUP *** DOESN'T WORK YET! DISABLED! ***
  3928.         iIncrementAngle = 1 ' angle to increase/decrease when rotating, set to 0 to disable rotation
  3929.         iRotationMax = 5 ' rotates every # of frames
  3930.         iRotationCount = 0 '
  3931.         iAngleXY = 0
  3932.         ' -----------------------------------------------------------------------------
  3933.        
  3934.        
  3935.         ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3936.         ' BEGIN Animate until user presses <ESC>
  3937.         Do
  3938.            
  3939.             ' -----------------------------------------------------------------------------
  3940.             ' BEGIN MOVE XMAS OBJECTS #xmas
  3941.            
  3942.             For iCount% = lbound(arrXmas) to ubound(arrXmas)
  3943.                 ' IS OBJECT ACTIVE?
  3944.                 if arrXmas(iCount%).IsEnabled = TRUE then
  3945.                    
  3946.                     Select Case arrXmas(iCount%).Typ
  3947.                         Case cXmasSnow:
  3948.                             ' -----------------------------------------------------------------------------
  3949.                             ' BEGIN SNOWFLAKES #snow
  3950.                             ' maybe move along x axis
  3951.                             arrXmas(iCount%).xCount = arrXmas(iCount%).xCount + 1
  3952.                             if arrXmas(iCount%).xCount > arrXmas(iCount%).xMax then
  3953.                                 arrXmas(iCount%).xCount = arrXmas(iCount%).xMax
  3954.                                
  3955.                                 ' maybe move
  3956.                                 iNewX% = RandomNumber% (1, 255)
  3957.                                 if iNewX% < 32 then
  3958.                                     arrXmas(iCount%).xMax = 0
  3959.                                     if iNewX% < 16 then
  3960.                                         arrXmas(iCount%).x = arrXmas(iCount%).x - 1
  3961.                                         if arrXmas(iCount%).x < m_iMapMinX then
  3962.                                             arrXmas(iCount%).x = m_iMapMaxX
  3963.                                         end if
  3964.                                     else
  3965.                                         arrXmas(iCount%).x = arrXmas(iCount%).x + 1
  3966.                                         if arrXmas(iCount%).x > m_iMapMaxX then
  3967.                                             arrXmas(iCount%).x = m_iMapMinX
  3968.                                         end if
  3969.                                     end if
  3970.                                 end if
  3971.                             end if
  3972.                            
  3973.                             ' maybe move along y axis
  3974.                             arrXmas(iCount%).yCount = arrXmas(iCount%).yCount + 1
  3975.                             if arrXmas(iCount%).yCount > arrXmas(iCount%).yMax then
  3976.                                 arrXmas(iCount%).yCount = arrXmas(iCount%).yMax
  3977.                                
  3978.                                 ' maybe move
  3979.                                 iNewY% = RandomNumber% (1, 255)
  3980.                                 if iNewY% < 32 then
  3981.                                     arrXmas(iCount%).yMax = 0
  3982.                                     if iNewY% < 16 then
  3983.                                         arrXmas(iCount%).y = arrXmas(iCount%).y - 1
  3984.                                         if arrXmas(iCount%).y < m_iMapMinY then
  3985.                                             arrXmas(iCount%).y = m_iMapMaxY
  3986.                                         end if
  3987.                                     else
  3988.                                         arrXmas(iCount%).y = arrXmas(iCount%).y + 1
  3989.                                         if arrXmas(iCount%).y > m_iMapMaxY then
  3990.                                             arrXmas(iCount%).y = m_iMapMinY
  3991.                                         end if
  3992.                                     end if
  3993.                                 end if
  3994.                             end if
  3995.                            
  3996.                             ' fall to earth
  3997.                             arrXmas(iCount%).zCount = arrXmas(iCount%).zCount + 1
  3998.                             if arrXmas(iCount%).zCount > arrXmas(iCount%).zMax then
  3999.                                 arrXmas(iCount%).zMax = 0
  4000.                                 arrXmas(iCount%).z = arrXmas(iCount%).z - 1
  4001.                                 ' has snowflake hit bottom or landed on something?
  4002.                                 if arrXmas(iCount%).z = m_iMapMinZ + 1 or m_arrMap(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z - 1).Typ = c_iTile_Wall then
  4003.                                     ' stop moving, copy to the world
  4004.                                     arrXmas(iCount%).IsEnabled = FALSE
  4005.                                     m_arrMap(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Typ = arrXmas(iCount%).Tile1
  4006.                                     m_arrMap(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Color1 = arrXmas(iCount%).Color1
  4007.                                     m_arrMap(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Alpha1 = arrXmas(iCount%).Alpha1
  4008.                                     iSnowCount = iSnowCount - 1
  4009.                                 end if
  4010.                             end if
  4011.                             ' END SNOWFLAKES @snow
  4012.                             ' -----------------------------------------------------------------------------
  4013.                            
  4014.                         Case cXmasStar:
  4015.                             ' -----------------------------------------------------------------------------
  4016.                             ' BEGIN STAR #star
  4017.                            
  4018.                             ' Change color
  4019.                             'DoCycleColor 1, arrXmas(iStarIndex).Color1
  4020.                             'if arrXmas(iCount%).Color1 = cYellow then arrXmas(iCount%).Color1 = cGold else arrXmas(iCount%).Color1 = cYellow
  4021.                             'if arrXmas(iCount%).Color2 = cYellow then arrXmas(iCount%).Color2 = cGold else arrXmas(iCount%).Color2 = cYellow
  4022.                             'if arrXmas(iCount%).Color3 = cYellow then arrXmas(iCount%).Color3 = cGold else arrXmas(iCount%).Color3 = cYellow
  4023.                            
  4024.                             ' Change size
  4025.                             arrXmas(iCount%).xCount = arrXmas(iCount%).xCount + 1: if arrXmas(iCount%).xCount > arrXmas(iCount%).xMax then arrXmas(iCount%).xCount = arrXmas(iCount%).xMin
  4026.                             arrXmas(iCount%).yCount = arrXmas(iCount%).yCount + 1: if arrXmas(iCount%).yCount > arrXmas(iCount%).yMax then arrXmas(iCount%).yCount = arrXmas(iCount%).yMin
  4027.                             arrXmas(iCount%).zCount = arrXmas(iCount%).zCount + 1: if arrXmas(iCount%).zCount > arrXmas(iCount%).zMax then arrXmas(iCount%).zCount = arrXmas(iCount%).zMin
  4028.                            
  4029.                             ' END STAR @star
  4030.                             ' -----------------------------------------------------------------------------
  4031.                            
  4032.                         Case cXmasLight:
  4033.                             ' -----------------------------------------------------------------------------
  4034.                             ' BEGIN LIGHTS #lights
  4035.                             ' (UNDER CONSTRUCTION)
  4036.                             ' END LIGHTS #lights
  4037.                             ' -----------------------------------------------------------------------------
  4038.                            
  4039.                         Case cXmasOrnament:
  4040.                             ' -----------------------------------------------------------------------------
  4041.                             ' BEGIN LIGHTS #lights
  4042.                             ' (UNDER CONSTRUCTION)
  4043.                             ' END LIGHTS #lights
  4044.                             ' -----------------------------------------------------------------------------
  4045.                            
  4046.                         Case Else:
  4047.                             ' (DO NOTHING)
  4048.                     End Select
  4049.                 else ' .IsEnabled = FALSE
  4050.                     Select Case arrXmas(iCount%).Typ
  4051.                         Case cXmasSnow:
  4052.                             IF bMakeSnow = TRUE THEN
  4053.                                 If iSnowCount <= iSnowMax Then
  4054.                                     iSnowCount = iSnowCount + 1
  4055.                                     arrXmas(iCount%).IsEnabled = TRUE
  4056.                                     arrXmas(iCount%).x = RandomNumber%(m_iMapMinX, m_iMapMaxX)
  4057.                                     arrXmas(iCount%).y = RandomNumber%(m_iMapMinY, m_iMapMaxY)
  4058.                                     arrXmas(iCount%).z = m_iMapMaxZ
  4059.                                     arrXmas(iCount%).Tile1 = c_iTile_Wall
  4060.                                     arrXmas(iCount%).Color1 = cWhite
  4061.                                     arrXmas(iCount%).Alpha1 = 255 ' RandomNumber%(190, 255)
  4062.                                     arrXmas(iCount%).xCount = 0 ' snowflake x waver counter
  4063.                                     arrXmas(iCount%).xMax = 20 ' snowflake can waver along x axis every n steps
  4064.                                     arrXmas(iCount%).yCount = 0 ' snowflake y waver counter
  4065.                                     arrXmas(iCount%).yMax = 20 ' snowflake can waver along y axis every n steps
  4066.                                     arrXmas(iCount%).zCount = 10 ' snowflake descent counter
  4067.                                     arrXmas(iCount%).zMax = 10 ' snowflake descends every n steps
  4068.                                     bMakeSnow = FALSE
  4069.                                 End If
  4070.                             END IF
  4071.                         Case cXmasStar:
  4072.                             ' (DO NOTHING)
  4073.                         Case cXmasLight:
  4074.                             ' (DO NOTHING)
  4075.                         Case cXmasOrnament:
  4076.                             ' (DO NOTHING)
  4077.                         Case Else:
  4078.                             ' (DO NOTHING)
  4079.                     End Select
  4080.                 end if ' .IsEnabled = TRUE
  4081.             Next iCount%
  4082.             ' END MOVE XMAS OBJECTS @xmas
  4083.             ' -----------------------------------------------------------------------------
  4084.            
  4085.            
  4086.            
  4087.             ' -----------------------------------------------------------------------------
  4088.             ' CLEAR SCREEN
  4089.             ' TODO: CALCULATE THESE BASED ON GRID SIZE?
  4090.             ' xMin = 310, yMin = -9
  4091.             ' xMax = 1090, yMax = 765            
  4092.             'DrawRect (iX%, iY%, iSizeW%, iSizeH%, iColor~&)
  4093.             DrawRect 310, 0, 780, 765, cBlack
  4094.            
  4095.             ' -----------------------------------------------------------------------------
  4096.             ' DRAW SPLIT SCREEN (MAIN VIEW)
  4097.             'DrawSnowScreen iAngleXY, iScreenOffsetX, iScreenOffsetY, iGridSize, arrXmas() As XmasObjectType
  4098.             DrawSnowScreen iAngleXY, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, arrXmas()
  4099.            
  4100.             ' -----------------------------------------------------------------------------
  4101.             ' SHOW TEXT MESSAGE
  4102.             iMsgColorCount = iMsgColorCount + 1
  4103.             For iLoop1 = lbound(arrMessage) to ubound(arrMessage)
  4104.                 if iMsgColorCount > iMsgColorMax then
  4105.                     DoCycleColor 1, arrMessage(iLoop1).fg
  4106.                 end if
  4107.                 Color arrMessage(iLoop1).fg
  4108.                 ' TODO: why doesn't background color work?
  4109.                 'Color arrMessage(iLoop1).fg, arrTextColor(iLoop1).bg
  4110.                 LOCATE 19, 77 + iLoop1
  4111.                 Print arrMessage(iLoop1).s;
  4112.             Next iLoop1
  4113.             if iMsgColorCount > iMsgColorMax then
  4114.                 iMsgColorCount = 0
  4115.             end if
  4116.             Color cWhite
  4117.            
  4118.             ' -----------------------------------------------------------------------------
  4119.             ' BIRTH A SNOWFLAKE?
  4120.             iValue = RandomNumber% (1, 255)
  4121.             if iValue <= iSnowFreq then
  4122.                 bMakeSnow = TRUE
  4123.             end if
  4124.             iSnowFreq = iSnowFreq + 1 ' increase chance of snow
  4125.             if iSnowFreq > iSnowFreqMax then iSnowFreq = iSnowFreqMax
  4126.            
  4127.             ' -----------------------------------------------------------------------------
  4128.             ' ROTATE THE SCENE?
  4129.             ' UNDER CONSTRUCTION: (DOESN'T WORK!)
  4130. IF TRUE=FALSE THEN
  4131.             if iIncrementAngle <> 0 then
  4132.                 iRotationCount = iRotationCount + 1
  4133.                 if iRotationCount > iRotationMax then
  4134.                     iRotationCount = 0
  4135.                     iAngleXY = iAngleXY + iIncrementAngle
  4136.                     if iAngleXY < 0 then
  4137.                         iAngleXY = 359
  4138.                     elseif iAngleXY > 359 then
  4139.                         iAngleXY = 0
  4140.                     end if
  4141.                 end if
  4142.             end if
  4143.            
  4144.             ' -----------------------------------------------------------------------------
  4145.             ' GET KEYBOARD INPUT
  4146.             If _KeyDown(c_iKeyDown_Esc) Then
  4147.                 Exit Do
  4148.             End If
  4149.            
  4150.             ' -----------------------------------------------------------------------------
  4151.             ' REGULATE LOOP + REFRESH SCREEN
  4152.             _Limit 60
  4153.             _Display
  4154.         Loop
  4155.         ' END Animate until user presses <ESC>
  4156.         ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  4157.        
  4158.        
  4159.     End If
  4160.     ' =============================================================================
  4161.     ' END ANIMATION LOOP #1 @ani
  4162.     ' =============================================================================
  4163.    
  4164.    
  4165.    
  4166.    
  4167.    
  4168.    
  4169.    
  4170.    
  4171.    
  4172.    
  4173.    
  4174.    
  4175.    
  4176.    
  4177.    
  4178.    
  4179.    
  4180.    
  4181.    
  4182.    
  4183.    
  4184.    
  4185.    
  4186.     ' =============================================================================
  4187.     ' MAIN LOOP
  4188.     If Len(sError) = 0 Then
  4189.         iDrawColor% = 8 ' RED
  4190.         iCursorColor~& = cRed
  4191.        
  4192.         Do
  4193.             Cls ' is cls necessary?
  4194.            
  4195.            
  4196.            
  4197. 'TODO: ONLY DRAW IF IT CHANGES?
  4198.             ' -----------------------------------------------------------------------------
  4199.             ' BEGIN SHOW INSTRUCTIONS / COORDINATES ON SCREEN
  4200.             ' -----------------------------------------------------------------------------
  4201.             Locate m_iInstrStartRow+0, m_iInstrStartCol: Print "IsometricDraw1"
  4202.             Locate m_iInstrStartRow+2, m_iInstrStartCol: Print "CRSR RT/LF MOVES X = " + cstr$(iX%)
  4203.             Locate m_iInstrStartRow+3, m_iInstrStartCol: Print "CRSR UP/DN MOVES Y = " + cstr$(iY%)
  4204.             Locate m_iInstrStartRow+4, m_iInstrStartCol: Print "PAGE UP/DN MOVES Z = " + cstr$(iZ%)
  4205.             Locate m_iInstrStartRow+5, m_iInstrStartCol: Print "=    / -   CHANGES GRID SIZE     = " + cstr$(m_arrPlayer(1).GridSize)
  4206.             Locate m_iInstrStartRow+6, m_iInstrStartCol: Print "[    / ]   TOGGLES MOVEMENT      = " + IIFSTR$(m_arrPlayer(1).IsMoving, "TRUE", "FALSE")
  4207.             Locate m_iInstrStartRow+7, m_iInstrStartCol: Print "INS  / DEL TOGGLES REPEAT KEYS   = " + IIFSTR$(bEnableRepeatingKeys, "TRUE", "FALSE")
  4208.             Locate m_iInstrStartRow+8, m_iInstrStartCol: Print ",    / .   CHANGES MINI MAP SIZE = " + cstr$(m_arrPlayer(1).MapSize)
  4209.             Locate m_iInstrStartRow+9, m_iInstrStartCol: Print "a    / b   FOR UNDO / REDO"
  4210.             Locate m_iInstrStartRow+11, m_iInstrStartCol: Print "PRESS <ESC> TO QUIT"
  4211.            
  4212.             Locate m_iPaletteTextRow+0, m_iPaletteTextCol: Print "1 color-"
  4213.             Locate m_iPaletteTextRow+1, m_iPaletteTextCol: Print "2 color+"
  4214.             Locate m_iPaletteTextRow+2, m_iPaletteTextCol: Print "3 draw"
  4215.             Locate m_iPaletteTextRow+3, m_iPaletteTextCol: Print "4 erase"
  4216.             Locate m_iPaletteTextRow+4, m_iPaletteTextCol: Print "5 toggle"
  4217.             Locate m_iPaletteTextRow+5, m_iPaletteTextCol: Print "6 eyedropper"
  4218.             Locate m_iPaletteTextRow+6, m_iPaletteTextCol: Print "7 clear"
  4219.             Locate m_iPaletteTextRow+7, m_iPaletteTextCol: Print "8 open"
  4220.             Locate m_iPaletteTextRow+8, m_iPaletteTextCol: Print "9 save"
  4221.             ' -----------------------------------------------------------------------------
  4222.             ' END SHOW INSTRUCTIONS / COORDINATES ON SCREEN
  4223.             ' -----------------------------------------------------------------------------
  4224.            
  4225.             ' ****************************************************************************************************************************************************************
  4226.             ' BEGIN DRAW PALETTE
  4227.             ' ****************************************************************************************************************************************************************
  4228.             'TODO: support variable screen resolutions instead of hardcoded 1280x1024
  4229.             iSize% = 24 ' {n}x{n} pixels square
  4230.             iDrawX% = 10
  4231.             iOffsetY% = 250
  4232.             For iLoop1 = 0 To 25
  4233.                 iDrawY% = iOffsetY% + (iLoop1 * iSize%)
  4234.                 If iLoop1 = 0 Then
  4235.                     ' COLOR = TRANSPARENT
  4236.  
  4237.                     ' DRAW A CHECKERBOARD PATTERN FOR TRANSPARENT
  4238.                     iFirstColor~& = cDarkGray
  4239.                     For iLoopY% = iDrawY% To ((iDrawY% + iSize%) - 4) Step 4
  4240.                         If iFirstColor~& = cDarkGray Then
  4241.                             iFirstColor~& = cGray
  4242.                         Else
  4243.                             iFirstColor~& = cDarkGray
  4244.                         End If
  4245.                         iNextColor~& = iFirstColor~&
  4246.                         For iLoopX% = iDrawX% To ((iDrawX% + iSize%) - 4) Step 4
  4247.                             DrawBox iLoopX%, iLoopY%, 4, iNextColor~&
  4248.                             If iNextColor~& = cDarkGray Then
  4249.                                 iNextColor~& = cGray
  4250.                             Else
  4251.                                 iNextColor~& = cDarkGray
  4252.                             End If
  4253.                         Next iLoopX%
  4254.                     Next iLoopY%
  4255.                 ElseIf iLoop1 = 1 Then
  4256.                     ' COLOR = BLACK
  4257.                 Else
  4258.                     iNextColor~& = m_arrColors(iLoop1)
  4259.                     DrawBox iDrawX%, iDrawY%, iSize%, iNextColor~&
  4260.                 End If
  4261.  
  4262.                 ' DRAW A BORDER AROUND IT
  4263.                 iNextColor~& = cDarkGray
  4264.                 DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, 1
  4265.             Next iLoop1
  4266.  
  4267.             ' DRAW WHITE BOX AROUND CURRENT COLOR
  4268.             DoCycleColor 1, iCursorColor~&
  4269.             iDrawY% = iOffsetY% + (iDrawColor% * iSize%)
  4270.             DrawOutlineBox iDrawX%, iDrawY%, iSize%, iCursorColor~&, 1
  4271.             ' ****************************************************************************************************************************************************************
  4272.             ' END DRAW PALETTE
  4273.             ' ****************************************************************************************************************************************************************
  4274.  
  4275.  
  4276.  
  4277.  
  4278.             ' ****************************************************************************************************************************************************************
  4279.             ' BEGIN DRAW MAP
  4280.             ' ****************************************************************************************************************************************************************
  4281.             ' DRAW SPLIT SCREEN (MAIN VIEW)
  4282.             DrawScreen c_iDir_Forward, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  4283.            
  4284.             '' DRAW SPLIT SCREEN (3 OTHER VIEWS)
  4285.             'DrawScreen c_iDir_Back, m_arrSplitScreen(2).ScreenOffsetX, m_arrSplitScreen(2).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  4286.             'DrawScreen c_iDir_Left, m_arrSplitScreen(3).ScreenOffsetX, m_arrSplitScreen(3).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  4287.             'DrawScreen c_iDir_Right, m_arrSplitScreen(4).ScreenOffsetX, m_arrSplitScreen(4).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  4288.             ' ****************************************************************************************************************************************************************
  4289.             ' END DRAW MAP
  4290.             ' ****************************************************************************************************************************************************************
  4291.            
  4292.            
  4293.            
  4294.            
  4295.            
  4296.            
  4297.            
  4298.            
  4299.            
  4300.            
  4301.            
  4302.            
  4303.             ' ****************************************************************************************************************************************************************
  4304.             ' BEGIN PLAYER LOOP
  4305.             ' ****************************************************************************************************************************************************************
  4306.             For iPlayerLoop = 1 To m_iPlayerCount
  4307.                 'DrawScreen m_arrPlayer(iPlayerLoop).View, cScreenOffsetX, cScreenOffsetY, iX%, iY%, iZ%
  4308.                
  4309.                
  4310.                
  4311.                
  4312.                
  4313. ' this first person stuff is kind of hard
  4314. '                ' -----------------------------------------------------------------------------
  4315. '                ' BEGIN SHOW SIMPLE FIRST-PERSON MINI-DISPLAY ON SCREEN
  4316. '                ' -----------------------------------------------------------------------------
  4317. '                ' POINTING WHICHEVER WAY USER MOVED LAST
  4318. '                
  4319. '                ' ADD TEXT LABEL
  4320. '                Locate m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextY, m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextX: Print "First person";
  4321. '                Locate m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextY+1, m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextX: Print "(" + GetDirection$(m_arrPlayer(iPlayerLoop).Direction) + ")";
  4322. '                
  4323. '                ' ERASE OLD MAP
  4324. '                iDrawX% = m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
  4325. '                iDrawY% = m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
  4326. '                iSize% = m_arrPlayer(1).MapSize * m_iMapMaxX ' m_iMapMaxY m_iMapMaxZ
  4327. '                DrawBox iDrawX%, iDrawY%, iSize%, cBlack ' TODO: variable background color
  4328. '                
  4329. '                Select Case m_arrPlayer(iPlayerLoop).Direction
  4330. '                    Case c_iDir_Down:
  4331. '                        
  4332. '                    Case c_iDir_Up:
  4333. '                        
  4334. '                    Case c_iDir_Left:
  4335. '                        
  4336. '                    Case c_iDir_Right:
  4337. '                        
  4338. '                    Case c_iDir_Back:
  4339. '                        ' z = up/down
  4340. '                        ' x = left/right
  4341. '                        ' y = closeness (m_iMapMinY = farthest)
  4342. '                        
  4343. '                        ' first person tiles / scaling
  4344. '                        ' ----------------------------
  4345. '                        ' distance   tile size   # tiles   # total   # incl. partial
  4346. '                        ' 0          16           8        8          8
  4347. '                        ' 1          15           8  8/15  8         10
  4348. '                        ' 2          14           9  2/14  8         10
  4349. '                        ' 3          13           9 11/13  8         10
  4350. '                        ' 4          12          10  8/12  9         12
  4351. '                        ' 5          11          11  7/11  10        12
  4352. '                        ' 6          10          12  8/10  12        14
  4353. '                        ' 7           9          14  2/ 9  14        16
  4354. '                        
  4355. '                        ' each level closer, 1 pixel taller/wider, 4 pixels up & over
  4356. '                        
  4357. '                        ' draw in relation to player's position
  4358. '                        ' point blank range = 8 tiles x 8 tiles
  4359. '                        
  4360. '                        ' XoXoXoXoXoXoXoXo
  4361. '                        '        P
  4362. '                        ' 0123456789012345
  4363. '                        '           111111
  4364. '                        
  4365. '                        ' XoXoXoXoXoXoXo
  4366. '                        '       P
  4367. '                        ' 01234567890123
  4368. '                        '           1111
  4369. '                        
  4370. '                        ' XoXoXoXoXoXoXo
  4371. '                        '    P
  4372. '                        ' 01234567890123
  4373. '                        '           1111
  4374. '                        
  4375. '                        ' FOR DISTANCE:
  4376. '                        
  4377. '                        '        y: 76543210
  4378. '                        '           P
  4379. '                        ' distance: 01234567
  4380. '                        
  4381. '                        '        y: 76543210
  4382. '                        '              P
  4383. '                        ' distance: 01234567
  4384. '                        
  4385. '                        '        y: 76543210
  4386. '                        '                P
  4387. '                        ' distance: 01234567
  4388. '                        
  4389. '                        '        y: 76543210
  4390. '                        '                  P
  4391. '                        ' distance: 01234567
  4392. '                        
  4393. '                        ' start at   iDistance
  4394. '                        ' y-7        7
  4395. '                        ' 0          y
  4396. '                        
  4397. '                        ' Q: where is player?
  4398. '                        '     m_arrPlayer(iLoop1).x
  4399. '                        '     m_arrPlayer(iLoop1).y
  4400. '                        '     m_arrPlayer(iLoop1).z
  4401. '                        
  4402. '                        ' scan from right X2 to left X1, step-1
  4403. '                        if m_arrPlayer(iLoop1).x < 7 then
  4404. '                            iPosX1% = m_iMapMinX
  4405. '                            iPosX2% = m_iMapMinX+13
  4406. '                        else
  4407. '                            iPosX1% = m_arrPlayer(iLoop1).x - 6
  4408. '                            iPosX2% = m_arrPlayer(iLoop1).x + 7
  4409. '                        end if
  4410. '                        
  4411. '                        ' scan from bottom Z1 to top Z2
  4412. '                        if m_arrPlayer(iLoop1).z < 7 then
  4413. '                            iPosZ1% = m_iMapMinZ
  4414. '                            iPosZ2% = m_iMapMinZ+13
  4415. '                        else
  4416. '                            iPosZ1% = m_arrPlayer(iLoop1).z - 6
  4417. '                            iPosZ2% = m_arrPlayer(iLoop1).z + 7
  4418. '                        end if
  4419. '                        
  4420. '                        ' scan from far Y2 to close Y1
  4421. '                        if m_arrPlayer(iLoop1).y < 7 then
  4422. '                            iPosY1% = 0
  4423. '                            iPosY2% = m_arrPlayer(iLoop1).y
  4424. '                            iDistance = m_arrPlayer(iLoop1).y
  4425. '                        else
  4426. '                            iPosY1% = m_arrPlayer(iLoop1).y - 7
  4427. '                            iPosY2% = m_arrPlayer(iLoop1).y
  4428. '                            iDistance = 7
  4429. '                        end if
  4430. '                        
  4431. '                        For iLoopZ% = iPosZ1% To iPosZ2%
  4432. '                            For iLoopX% = iPosX2% To iPosX1% Step -1
  4433. '                                For iLoopY% = iPosY1% To iPosY2%
  4434. '                                    
  4435. '                                    ' Q: how big does block grow with each step closer?  1*MapSize
  4436. '                                    ' Q: what is the offset from the left/top?           4*MapSize
  4437. '                                    ' Q: what is the size of the smallest blocks?        1*MapSize
  4438. '                                    ' Q: what is the size of the largest blocks?         8*MapSize
  4439. '                                    ' Q: how far away do we see? what is the minimum y?  8 tiles
  4440. '                                    
  4441. '                                    ' at y, offset = 0
  4442. '                                    ' at y, what is x/y size of 1 block?
  4443. '                                    '     m_arrPlayer(1).MapSize
  4444. '                                    '     m_iMapMaxX
  4445. '                                    ' at y, how many blocks? 8x8
  4446. '                                    
  4447. '                                    iWidth = arrFPBrickSize(iDistance)
  4448. '                                    
  4449. '                                    arrFP_From(iDistance)
  4450. '                                    arrFP_To(iDistance)
  4451. '                                    
  4452. '                                    iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
  4453. '                                    iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
  4454. '                                    
  4455. '
  4456. '                                    If m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall Then
  4457. '                                        'DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4458. '                                        IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
  4459. '                                        
  4460. '                                    ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player1 Then
  4461. '                                        
  4462. '                                    ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player2 Then
  4463. '                                        
  4464. '                                    ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player3 Then
  4465. '                                        
  4466. '                                    ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player4 Then
  4467. '                                        
  4468. '                                    Else
  4469. '                                        'DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
  4470. '                                    End If
  4471. '                                    
  4472. '                                Next iLoopY%
  4473. '                            Next iLoopX%
  4474. '                        Next iLoopZ%
  4475. '                        
  4476. '                    Case c_iDir_Forward:
  4477. '                        
  4478. '                    Case Else:
  4479. '                        ' (DO NOTHING)
  4480. '                End Select
  4481. '                
  4482. '                'm_arrPlayer(1).MapSize
  4483. '                
  4484. '                For iLoopX% = m_iMapMinX To m_iMapMaxX
  4485. '                    For iLoopY% = m_iMapMinY To m_iMapMaxY
  4486. '                        iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
  4487. '                        iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
  4488. '                        If m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall Then
  4489. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4490. '                        ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player1 Then
  4491. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4492. '                        ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player2 Then
  4493. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4494. '                        ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player3 Then
  4495. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4496. '                        ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player4 Then
  4497. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4498. '                            'TODO: ADD OTHER TYPES
  4499. '                        Else
  4500. '                            DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
  4501. '                        End If
  4502. '                    Next iLoopY%
  4503. '                Next iLoopX%
  4504. '                ' -----------------------------------------------------------------------------
  4505. '                ' END SHOW SIMPLE FIRST-PERSON MINI-DISPLAY ON SCREEN
  4506. '                ' -----------------------------------------------------------------------------
  4507.                
  4508.                
  4509.                
  4510.                 ' -----------------------------------------------------------------------------
  4511.                 ' BEGIN SHOW TOP-DOWN X/Y 2D MINI MAP ON SCREEN
  4512.                 ' -----------------------------------------------------------------------------
  4513.                 ' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
  4514.                 ' ADD TEXT LABEL
  4515.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapTopDownTextY, m_arrSplitScreen(iPlayerLoop).MiniMapTopDownTextX: Print "Top-down";
  4516.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapTopDownTextY+1, m_arrSplitScreen(iPlayerLoop).MiniMapTopDownTextX: Print "(Z-slice)";
  4517.                
  4518.                 ' DRAW MAP
  4519.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  4520.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  4521.                         iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
  4522.                         iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
  4523.                         If m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall Then
  4524.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4525.                         ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player1 Then
  4526.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4527.                         ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player2 Then
  4528.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4529.                         ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player3 Then
  4530.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4531.                         ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player4 Then
  4532.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  4533.                             'TODO: ADD OTHER TYPES
  4534.                         Else
  4535.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
  4536.                         End If
  4537.                     Next iLoopY%
  4538.                 Next iLoopX%
  4539.                 ' DRAW THE PLAYERS ON THE MINI MAP
  4540.                 For iLoop1 = m_iPlayerMin To m_iPlayerCount
  4541.                     iDrawX% = (m_arrPlayer(iLoop1).x * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
  4542.                     iDrawY% = (m_arrPlayer(iLoop1).y * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
  4543.                     ' TODO: ADD Alpha PARAMETER TO DrawBox
  4544.                     DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
  4545.                 Next iLoop1
  4546.                 ' DRAW THE OBJECTS ON THE MINI MAP
  4547.                 ' (TO DO WHEN WE ADD OBJECTS)
  4548.                 ' -----------------------------------------------------------------------------
  4549.                 ' END SHOW TOP-DOWN X/Y 2D MINI MAP ON SCREEN
  4550.                 ' -----------------------------------------------------------------------------
  4551.  
  4552.  
  4553.  
  4554.  
  4555.  
  4556.                 ' -----------------------------------------------------------------------------
  4557.                 ' BEGIN SHOW FRONT-BACK X/Z 2D MINI MAP ON SCREEN
  4558.                 ' -----------------------------------------------------------------------------
  4559.                 ' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
  4560.                 ' ADD TEXT LABEL
  4561.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackTextY, m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackTextX: Print "Front/back";
  4562.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackTextY+1, m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackTextX: Print "(Y-slice)";
  4563.                
  4564.                 ' DRAW MAP
  4565.                 For iLoopZ% = m_iMapMaxZ To m_iMapMinZ Step -1
  4566.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  4567.                         iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
  4568.                         iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
  4569.                         If m_arrMap(iLoopX%, iY%, iLoopZ%).Typ = c_iTile_Wall Then
  4570.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
  4571.                         ElseIf m_arrMap(iLoopX%, iY%, iLoopZ%).Typ = c_iTile_Player1 Then
  4572.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
  4573.                         ElseIf m_arrMap(iLoopX%, iY%, iLoopZ%).Typ = c_iTile_Player2 Then
  4574.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
  4575.                         ElseIf m_arrMap(iLoopX%, iY%, iLoopZ%).Typ = c_iTile_Player3 Then
  4576.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
  4577.                         ElseIf m_arrMap(iLoopX%, iY%, iLoopZ%).Typ = c_iTile_Player4 Then
  4578.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
  4579.                             'TODO: ADD OTHER TYPES
  4580.                         Else
  4581.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
  4582.                         End If
  4583.                     Next iLoopX%
  4584.                 Next iLoopZ%
  4585.                
  4586.                 ' DRAW THE PLAYERS ON THE MINI MAP
  4587.                 For iLoop1 = m_iPlayerMin To m_iPlayerCount
  4588.                     iDrawX% = (m_arrPlayer(iLoop1).x * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
  4589.                     iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
  4590.                     ' TODO: ADD Alpha PARAMETER TO DrawBox
  4591.                     DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
  4592.                 Next iLoop1
  4593.                 ' DRAW THE OBJECTS ON THE MINI MAP
  4594.                 ' (TO DO WHEN WE ADD OBJECTS)
  4595.                 ' -----------------------------------------------------------------------------
  4596.                 ' END SHOW FRONT-BACK X/Z 2D MINI MAP ON SCREEN
  4597.                 ' -----------------------------------------------------------------------------
  4598.  
  4599.  
  4600.  
  4601.  
  4602.  
  4603.                 ' -----------------------------------------------------------------------------
  4604.                 ' BEGIN SHOW RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
  4605.                 ' -----------------------------------------------------------------------------
  4606.                 ' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
  4607.                 ' ADD TEXT LABEL
  4608.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftTextY, m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftTextX: Print "Right/left";
  4609.                 Locate m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftTextY+1, m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftTextX: Print "(X-slice)";
  4610.                
  4611.                 ' DRAW MAP
  4612.                 For iLoopZ% = m_iMapMaxZ To m_iMapMinZ Step -1
  4613.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  4614.                         iDrawX% = ((m_iMapMaxY - iLoopY%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
  4615.                         iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
  4616.                         If m_arrMap(iX%, iLoopY%, iLoopZ%).Typ = c_iTile_Wall Then
  4617.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
  4618.                         ElseIf m_arrMap(iX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player1 Then
  4619.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
  4620.                         ElseIf m_arrMap(iX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player2 Then
  4621.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
  4622.                         ElseIf m_arrMap(iX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player3 Then
  4623.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
  4624.                         ElseIf m_arrMap(iX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player4 Then
  4625.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
  4626.                             'TODO: ADD OTHER TYPES
  4627.                         Else
  4628.                             DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
  4629.                         End If
  4630.                     Next iLoopY%
  4631.                 Next iLoopZ%
  4632.                 ' DRAW THE PLAYERS ON THE MINI MAP
  4633.                 For iLoop1 = m_iPlayerMin To m_iPlayerCount
  4634.                     iDrawX% = ((m_iMapMaxY - m_arrPlayer(iLoop1).y) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
  4635.                     iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
  4636.                     ' TODO: ADD Alpha PARAMETER TO DrawBox
  4637.                     DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
  4638.                 Next iLoop1
  4639.                 ' DRAW THE OBJECTS ON THE MINI MAP
  4640.                 ' (TO DO WHEN WE ADD OBJECTS)
  4641.                 ' -----------------------------------------------------------------------------
  4642.                 ' END SHOW RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
  4643.                 ' -----------------------------------------------------------------------------
  4644.  
  4645.  
  4646.  
  4647.  
  4648.  
  4649.  
  4650.                 ' =============================================================================
  4651.                 ' BEGIN GET KEYBOARD INPUT WITH _BUTTON
  4652.                 ' =============================================================================
  4653.                 ' *** HEY WHY HAS _BUTTON STOPPED WORKING? DID I NOT GET A MEMO? ***
  4654.                 ' -----------------------------------------------------------------------------
  4655.                 ' BEGIN UNDO v1
  4656.                 ' TODO: unlimited levels of undo, for now just 1
  4657.                 ' -----------------------------------------------------------------------------
  4658.                 'IF _BUTTON(KeyCode_CtrlLeft%) OR _BUTTON(KeyCode_CtrlRight%) THEN
  4659.                 '   IF _BUTTON(KeyCode_Z%) THEN
  4660.                 '       IF Not m_bButton_Z THEN
  4661.                 '           m_bButton_Z = TRUE
  4662.                 '           ' UNDO!
  4663.                 '       END IF
  4664.                 '   ELSEIF _BUTTON(KeyCode_Y%) THEN
  4665.                 '       IF Not m_bButton_Y THEN
  4666.                 '           m_bButton_Y = TRUE
  4667.                 '           ' REDO!
  4668.                 '       END IF
  4669.                 '   END IF
  4670.                 'END IF
  4671.                 '
  4672.                 ' TRACK WHEN KEYS ARE RELEASED (DISABLES REPEATING KEYS)
  4673.                 'IF Not _BUTTON(KeyCode_Z%) THEN
  4674.                 '   m_bButton_Z = FALSE
  4675.                 'END IF
  4676.                 'IF Not _BUTTON(KeyCode_Y%) THEN
  4677.                 '   m_bButton_Y = FALSE
  4678.                 'END IF
  4679.                 ' -----------------------------------------------------------------------------
  4680.                 ' END UNDO v1
  4681.                 ' -----------------------------------------------------------------------------
  4682.  
  4683.                 ' =============================================================================
  4684.                 ' END GET KEYBOARD INPUT WITH _BUTTON
  4685.                 ' =============================================================================
  4686.  
  4687.  
  4688.                 ' =============================================================================
  4689.                 ' BEGIN GET DIRECTIONAL KEYBOARD INPUT
  4690.                 ' =============================================================================
  4691.                 If _KeyDown(c_iKeyDown_Up) Then
  4692.                     If iLastKey <> c_iKeyDown_Up Or bEnableRepeatingKeys = TRUE Then
  4693.                         iLastKey = c_iKeyDown_Up
  4694.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
  4695.                         bMoved = TRUE
  4696.                     End If
  4697.                 ElseIf _KeyDown(c_iKeyDown_Down) Then
  4698.                     If iLastKey <> c_iKeyDown_Down Or bEnableRepeatingKeys = TRUE Then
  4699.                         iLastKey = c_iKeyDown_Down
  4700.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
  4701.                         bMoved = TRUE
  4702.                     End If
  4703.                 ElseIf _KeyDown(c_iKeyDown_Left) Then
  4704.                     If iLastKey <> c_iKeyDown_Left Or bEnableRepeatingKeys = TRUE Then
  4705.                         iLastKey = c_iKeyDown_Left
  4706.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  4707.                         bMoved = TRUE
  4708.                     End If
  4709.                 ElseIf _KeyDown(c_iKeyDown_Right) Then
  4710.                     If iLastKey <> c_iKeyDown_Right Or bEnableRepeatingKeys = TRUE Then
  4711.                         iLastKey = c_iKeyDown_Right
  4712.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  4713.                         bMoved = TRUE
  4714.                     End If
  4715.                 ElseIf _KeyDown(c_iKeyDown_PgUp) Then
  4716.                     If iLastKey <> c_iKeyDown_PgUp Or bEnableRepeatingKeys = TRUE Then
  4717.                         iLastKey = c_iKeyDown_PgUp
  4718.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
  4719.                         bMoved = TRUE
  4720.                     End If
  4721.                 ElseIf _KeyDown(c_iKeyDown_PgDn) Then
  4722.                     If iLastKey <> c_iKeyDown_PgDn Or bEnableRepeatingKeys = TRUE Then
  4723.                         iLastKey = c_iKeyDown_PgDn
  4724.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
  4725.                         bMoved = TRUE
  4726.                     End If
  4727.                     ' =============================================================================
  4728.                     ' END GET DIRECTIONAL KEYBOARD INPUT
  4729.                     ' =============================================================================
  4730.  
  4731.  
  4732.  
  4733.                     ' =============================================================================
  4734.                     ' BEGIN GET UNDO/REDO INPUT
  4735.                     ' =============================================================================
  4736.                 ElseIf _KeyDown(c_iKeyDown_A) Then
  4737.                     If iLastKey <> c_iKeyDown_A Then
  4738.                         iLastKey = c_iKeyDown_A
  4739.  
  4740.                         ' UNDO!
  4741.                         MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
  4742.                         MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
  4743.                         MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
  4744.  
  4745.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
  4746.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
  4747.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
  4748.  
  4749.                         m_MapTileUndo.Typ = MapTileTempUndo.Typ
  4750.                         m_MapTileUndo.Color1 = MapTileTempUndo.Color1
  4751.                         m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
  4752.                     End If
  4753.                 ElseIf _KeyDown(c_iKeyDown_B) Then
  4754.                     If iLastKey <> c_iKeyDown_B Or bEnableRepeatingKeys = TRUE Then
  4755.                         iLastKey = c_iKeyDown_B
  4756.  
  4757.                         ' REDO! *** FOR NOW IT'S THE SAME AS UNDO, JUST SWAPS CURRENT WITH UNDO INFO ***
  4758.                         MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
  4759.                         MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
  4760.                         MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
  4761.  
  4762.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
  4763.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
  4764.                         m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
  4765.  
  4766.                         m_MapTileUndo.Typ = MapTileTempUndo.Typ
  4767.                         m_MapTileUndo.Color1 = MapTileTempUndo.Color1
  4768.                         m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
  4769.                     End If
  4770.                     ' =============================================================================
  4771.                     ' END GET UNDO/REDO INPUT
  4772.                     ' =============================================================================
  4773.  
  4774.  
  4775.  
  4776.  
  4777.  
  4778.  
  4779.  
  4780.                     ' =============================================================================
  4781.                     ' BEGIN GET DRAWING INPUT
  4782.                     ' =============================================================================
  4783.  
  4784.                     ' -----------------------------------------------------------------------------
  4785.                     ' 1 color-
  4786.                 ElseIf _KeyDown(c_iKeyDown_1) Then
  4787.                     If iLastKey <> c_iKeyDown_1 Or bEnableRepeatingKeys = TRUE Then
  4788.                         iLastKey = c_iKeyDown_1
  4789.  
  4790.                         iDrawColor% = iDrawColor% - 1
  4791.                         If iDrawColor% < 0 Then
  4792.                             iDrawColor% = 25
  4793.                         End If
  4794.                     End If
  4795.  
  4796.                     ' -----------------------------------------------------------------------------
  4797.                     ' 2 color+
  4798.                 ElseIf _KeyDown(c_iKeyDown_2) Then
  4799.                     If iLastKey <> c_iKeyDown_2 Or bEnableRepeatingKeys = TRUE Then
  4800.                         iLastKey = c_iKeyDown_2
  4801.  
  4802.                         iDrawColor% = iDrawColor% + 1
  4803.                         If iDrawColor% > 25 Then
  4804.                             iDrawColor% = 0
  4805.                         End If
  4806.                     End If
  4807.  
  4808.                     ' -----------------------------------------------------------------------------
  4809.                     ' 3 draw
  4810.                 ElseIf _KeyDown(c_iKeyDown_3) Then
  4811.                     If iLastKey <> c_iKeyDown_3 Or bEnableRepeatingKeys = TRUE Then
  4812.                         iLastKey = c_iKeyDown_3
  4813.  
  4814.                         ' SAVE UNDO INFO:
  4815.                         m_MapTileUndo.x = iX%
  4816.                         m_MapTileUndo.y = iY%
  4817.                         m_MapTileUndo.z = iZ%
  4818.                         m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
  4819.                         m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
  4820.                         m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
  4821.  
  4822.                         ' DRAW CURRENT COLOR (OR ERASE IF COLOR=TRANSPARENT)
  4823.                         If iDrawColor% > 0 Then
  4824.                             PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
  4825.                         Else
  4826.                             PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
  4827.                         End If
  4828.  
  4829.                         '' ADD TO RECORDING
  4830.                         'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
  4831.                         'iIndex = UBound(m_arrRecord)
  4832.                         'm_arrRecord(iIndex).Command = "plot"
  4833.                         'm_arrRecord(iIndex).intParam1 = iX%
  4834.                         'm_arrRecord(iIndex).intParam2 = iY%
  4835.                         'm_arrRecord(iIndex).intParam3 = iZ%
  4836.                         'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
  4837.                         'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
  4838.                     End If
  4839.  
  4840.                     ' -----------------------------------------------------------------------------
  4841.                     ' 4 erase
  4842.                 ElseIf _KeyDown(c_iKeyDown_4) Then
  4843.                     If iLastKey <> c_iKeyDown_4 Or bEnableRepeatingKeys = TRUE Then
  4844.                         iLastKey = c_iKeyDown_4
  4845.  
  4846.                         ' SAVE UNDO INFO:
  4847.                         m_MapTileUndo.x = iX%
  4848.                         m_MapTileUndo.y = iY%
  4849.                         m_MapTileUndo.z = iZ%
  4850.                         m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
  4851.                         m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
  4852.                         m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
  4853.  
  4854.                         ' ERASE CURRENT TILE
  4855.                         PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
  4856.  
  4857.                         '' ADD TO RECORDING
  4858.                         'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
  4859.                         'iIndex = UBound(m_arrRecord)
  4860.                         'm_arrRecord(iIndex).Command = "plot"
  4861.                         'm_arrRecord(iIndex).intParam1 = iX%
  4862.                         'm_arrRecord(iIndex).intParam2 = iY%
  4863.                         'm_arrRecord(iIndex).intParam3 = iZ%
  4864.                         'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
  4865.                         'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
  4866.                     End If
  4867.  
  4868.                     ' -----------------------------------------------------------------------------
  4869.                     ' 5 toggle
  4870.                 ElseIf _KeyDown(c_iKeyDown_5) Then
  4871.                     If iLastKey <> c_iKeyDown_5 Or bEnableRepeatingKeys = TRUE Then
  4872.                         iLastKey = c_iKeyDown_5
  4873.  
  4874.                         ' SAVE UNDO INFO:
  4875.                         m_MapTileUndo.x = iX%
  4876.                         m_MapTileUndo.y = iY%
  4877.                         m_MapTileUndo.z = iZ%
  4878.                         m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
  4879.                         m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
  4880.                         m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
  4881.  
  4882.                         ' TOGGLE CURRENT TILE:
  4883.                         If m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty Then
  4884.                             If iDrawColor% > 0 Then
  4885.                                 'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Wall
  4886.                                 PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
  4887.                             Else
  4888.                                 'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
  4889.                                 PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
  4890.                             End If
  4891.                         Else
  4892.                             'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
  4893.                             PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
  4894.                         End If
  4895.  
  4896.                         '' ADD TO RECORDING
  4897.                         'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
  4898.                         'iIndex = UBound(m_arrRecord)
  4899.                         'm_arrRecord(iIndex).Command = "plot"
  4900.                         'm_arrRecord(iIndex).intParam1 = iX%
  4901.                         'm_arrRecord(iIndex).intParam2 = iY%
  4902.                         'm_arrRecord(iIndex).intParam3 = iZ%
  4903.                         'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
  4904.                         'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
  4905.                     End If
  4906.  
  4907.                     ' -----------------------------------------------------------------------------
  4908.                     ' 6 eyedropper
  4909.                 ElseIf _KeyDown(c_iKeyDown_6) Then
  4910.                     If iLastKey <> c_iKeyDown_6 Or bEnableRepeatingKeys = TRUE Then
  4911.                         iLastKey = c_iKeyDown_6
  4912.  
  4913.                         iDrawColor% = GetPaletteFromColor%(m_arrMap(iX%, iY%, iZ%).Color1)
  4914.                     End If
  4915.  
  4916.                     ' -----------------------------------------------------------------------------
  4917.                     ' 7 clear all
  4918.                 ElseIf _KeyDown(c_iKeyDown_7) Then
  4919.                     If iLastKey <> c_iKeyDown_7 Or bEnableRepeatingKeys = TRUE Then
  4920.                         iLastKey = c_iKeyDown_7
  4921.  
  4922.                         ReDim m_arrRecord(-1) As RecordType
  4923.                         ClearIsometricMap
  4924.                         'For iLoopX% = m_iMapMinX To m_iMapMaxX
  4925.                         '    For iLoopY% = m_iMapMinY To m_iMapMaxY
  4926.                         '        For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  4927.                         '            m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
  4928.                         '            m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cEmpty
  4929.                         '            m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1 = 255
  4930.                         '            m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  4931.                         '        Next iLoopZ%
  4932.                         '    Next iLoopY%
  4933.                         'Next iLoopX%
  4934.  
  4935.                     End If
  4936.  
  4937.                     ' -----------------------------------------------------------------------------
  4938.                     ' 8 open
  4939.                 ElseIf _KeyDown(c_iKeyDown_8) Then
  4940.                     If iLastKey <> c_iKeyDown_8 Or bEnableRepeatingKeys = TRUE Then
  4941.                         iLastKey = c_iKeyDown_8
  4942.                         _KeyClear
  4943.                         sNextErr = LoadIsometricDrawing$
  4944.                     End If
  4945.  
  4946.                     ' -----------------------------------------------------------------------------
  4947.                     ' 9 save
  4948.                 ElseIf _KeyDown(c_iKeyDown_9) Then
  4949.                     If iLastKey <> c_iKeyDown_9 Or bEnableRepeatingKeys = TRUE Then
  4950.                         iLastKey = c_iKeyDown_9
  4951.                         _KeyClear
  4952.                         sNextErr = SaveIsometricDrawing$
  4953.                     End If
  4954.                     ' =============================================================================
  4955.                     ' END GET DRAWING INPUT
  4956.                     ' =============================================================================
  4957.  
  4958.  
  4959.  
  4960.  
  4961.                     ' =============================================================================
  4962.                     ' BEGIN GET OTHER KEYBOARD INPUT
  4963.                     ' =============================================================================
  4964.                 ElseIf _KeyDown(c_iKeyDown_BracketLeft) Then
  4965.                     If iLastKey <> c_iKeyDown_BracketLeft Or bEnableRepeatingKeys = TRUE Then
  4966.                         iLastKey = c_iKeyDown_BracketLeft
  4967.                         m_arrPlayer(iPlayerLoop).IsMoving = TRUE
  4968.                     End If
  4969.                 ElseIf _KeyDown(c_iKeyDown_BracketRight) Then
  4970.                     If iLastKey <> c_iKeyDown_BracketRight Or bEnableRepeatingKeys = TRUE Then
  4971.                         iLastKey = c_iKeyDown_BracketRight
  4972.                         m_arrPlayer(iPlayerLoop).IsMoving = FALSE
  4973.                     End If
  4974.  
  4975.                 ElseIf _KeyDown(c_iKeyDown_Comma) Then
  4976.                     If iLastKey <> c_iKeyDown_Comma Or bEnableRepeatingKeys = TRUE Then
  4977.                         iLastKey = c_iKeyDown_Comma
  4978.                         ' TODO: HAVE MAP SIZE PER PLAYER
  4979.                         m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize - 1
  4980.                         If m_arrPlayer(iPlayerLoop).MapSize < 1 Then
  4981.                             m_arrPlayer(iPlayerLoop).MapSize = 1
  4982.                         Else
  4983.                             bMoved = TRUE
  4984.                         End If
  4985.                     End If
  4986.                 ElseIf _KeyDown(c_iKeyDown_Period) Then
  4987.                     If iLastKey <> c_iKeyDown_Period Or bEnableRepeatingKeys = TRUE Then
  4988.                         iLastKey = c_iKeyDown_Period
  4989.                         m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize + 1
  4990.                         If m_arrPlayer(iPlayerLoop).MapSize > m_iGridSizeMax Then
  4991.                             m_arrPlayer(iPlayerLoop).MapSize = m_iGridSizeMax
  4992.                         Else
  4993.                             bMoved = TRUE
  4994.                         End If
  4995.                     End If
  4996.  
  4997.                 ElseIf _KeyDown(c_iKeyDown_Minus) Then
  4998.                     If iLastKey <> c_iKeyDown_Minus Or bEnableRepeatingKeys = TRUE Then
  4999.                         iLastKey = c_iKeyDown_Minus
  5000.                         ' TODO: HAVE SEPARATE GRID SIZE PER PLAYER / SPLIT SCREEN?
  5001.                         m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize - 1
  5002.                         If m_arrPlayer(iPlayerLoop).GridSize < m_iGridSizeMin Then
  5003.                             m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMin
  5004.                         Else
  5005.                             bMoved = TRUE
  5006.                         End If
  5007.                     End If
  5008.                 ElseIf _KeyDown(c_iKeyDown_EqualPlus) Then
  5009.                     If iLastKey <> c_iKeyDown_EqualPlus Or bEnableRepeatingKeys = TRUE Then
  5010.                         iLastKey = c_iKeyDown_EqualPlus
  5011.                         m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize + 1
  5012.                         If m_arrPlayer(iPlayerLoop).GridSize > m_iGridSizeMax Then
  5013.                             m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMax
  5014.                         Else
  5015.                             bMoved = TRUE
  5016.                         End If
  5017.                     End If
  5018.  
  5019.                 ElseIf _KeyDown(c_iKeyDown_Home) Then
  5020.                     If iLastKey <> c_iKeyDown_Home Or bEnableRepeatingKeys = TRUE Then
  5021.                         iLastKey = c_iKeyDown_Home
  5022.                         ' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  5023.                         m_arrPlayer(iPlayerLoop).View = m_arrPlayer(iPlayerLoop).View - 1
  5024.                         If m_arrPlayer(iPlayerLoop).View < c_iDir_Min Then
  5025.                             m_arrPlayer(iPlayerLoop).View = c_iDir_Max
  5026.                         End If
  5027.                     End If
  5028.                 ElseIf _KeyDown(c_iKeyDown_End) Then
  5029.                     If iLastKey <> c_iKeyDown_End Or bEnableRepeatingKeys = TRUE Then
  5030.                         iLastKey = c_iKeyDown_End
  5031.                         ' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  5032.                         m_arrPlayer(iPlayerLoop).View = m_arrPlayer(iPlayerLoop).View + 1
  5033.                         If m_arrPlayer(iPlayerLoop).View > c_iDir_Max Then
  5034.                             m_arrPlayer(iPlayerLoop).View = c_iDir_Min
  5035.                         End If
  5036.                     End If
  5037.  
  5038.                 ElseIf _KeyDown(c_iKeyDown_Ins) Then
  5039.                     ' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
  5040.                     If iLastKey <> c_iKeyDown_Ins Or bEnableRepeatingKeys = TRUE Then
  5041.                         iLastKey = c_iKeyDown_Ins
  5042.                         bEnableRepeatingKeys = TRUE
  5043.                     End If
  5044.  
  5045.                 ElseIf _KeyDown(c_iKeyDown_Del) Then
  5046.                     ' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
  5047.                     If iLastKey <> c_iKeyDown_Del Or bEnableRepeatingKeys = TRUE Then
  5048.                         iLastKey = c_iKeyDown_Del
  5049.                         bEnableRepeatingKeys = FALSE
  5050.                     End If
  5051.  
  5052.                 ElseIf _KeyDown(c_iKeyDown_Esc) Then
  5053.                     Exit Do
  5054.                 Else
  5055.                     iLastKey = -1
  5056.                 End If
  5057.                 ' =============================================================================
  5058.                 ' END GET OTHER KEYBOARD INPUT
  5059.                 ' =============================================================================
  5060.  
  5061.  
  5062.  
  5063.                 ' =============================================================================
  5064.                 ' BEGIN MOVE PLAYER BASED ON DIRECTION
  5065.                 ' =============================================================================
  5066.                 If m_arrPlayer(iPlayerLoop).IsMoving = TRUE Or bMoved = TRUE Then
  5067.                     bMoved = FALSE
  5068.  
  5069.                     Select Case m_arrPlayer(iPlayerLoop).Direction
  5070.                         Case c_iDir_Down:
  5071.                             iNewX% = iX%
  5072.                             iNewY% = iY%
  5073.                             iNewZ% = iZ% - 1
  5074.                             If iNewZ% < m_iMapMinZ Then
  5075.                                 iNewZ% = m_iMapMaxZ
  5076.                             End If
  5077.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5078.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
  5079.                                 iNewZ% = iZ%
  5080.                             End If
  5081.  
  5082.                         Case c_iDir_Up:
  5083.                             iNewX% = iX%
  5084.                             iNewY% = iY%
  5085.                             iNewZ% = iZ% + 1
  5086.                             If iNewZ% > m_iMapMaxZ Then
  5087.                                 iNewZ% = m_iMapMinZ
  5088.                             End If
  5089.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5090.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
  5091.                                 iNewZ% = iZ%
  5092.                             End If
  5093.  
  5094.                         Case c_iDir_Left:
  5095.                             iNewX% = iX% - 1
  5096.                             iNewY% = iY%
  5097.                             iNewZ% = iZ%
  5098.                             If iNewX% < m_iMapMinX Then
  5099.                                 iNewX% = m_iMapMaxX
  5100.                             End If
  5101.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5102.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  5103.                                 iNewX% = iX%
  5104.                             End If
  5105.  
  5106.                         Case c_iDir_Right:
  5107.                             iNewX% = iX% + 1
  5108.                             iNewY% = iY%
  5109.                             iNewZ% = iZ%
  5110.                             If iNewX% > m_iMapMaxX Then
  5111.                                 iNewX% = m_iMapMinX
  5112.                             End If
  5113.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5114.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  5115.                                 iNewX% = iX%
  5116.                             End If
  5117.  
  5118.                         Case c_iDir_Back:
  5119.                             iNewX% = iX%
  5120.                             iNewY% = iY% - 1
  5121.                             iNewZ% = iZ%
  5122.                             If iNewY% < m_iMapMinY Then
  5123.                                 iNewY% = m_iMapMaxY
  5124.                             End If
  5125.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5126.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
  5127.                                 iNewY% = iY%
  5128.                             End If
  5129.  
  5130.                         Case c_iDir_Forward:
  5131.                             iNewX% = iX%
  5132.                             iNewY% = iY% + 1
  5133.                             iNewZ% = iZ%
  5134.                             If iNewY% > m_iMapMaxY Then
  5135.                                 iNewY% = m_iMapMinY
  5136.                             End If
  5137.                             If (m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iTile_Empty) And (bIgnoreTerrain = FALSE) Then
  5138.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
  5139.                                 iNewY% = iY%
  5140.                             End If
  5141.  
  5142.                         Case Else:
  5143.                             ' (DO NOTHING)
  5144.                             'iNewX% = iX%
  5145.                             'iNewY% = iY%
  5146.                             'iNewZ% = iZ%
  5147.                     End Select
  5148.  
  5149.                     ' SAVE NEW POSITION
  5150.                     iX% = iNewX%
  5151.                     iY% = iNewY%
  5152.                     iZ% = iNewZ%
  5153.  
  5154.                     ' FOR MULTIPLAYER WE WOULD USE:
  5155.                     m_arrPlayer(iPlayerLoop).x = iNewX%
  5156.                     m_arrPlayer(iPlayerLoop).y = iNewY%
  5157.                     m_arrPlayer(iPlayerLoop).z = iNewZ%
  5158.  
  5159.                 End If
  5160.                 ' =============================================================================
  5161.                 ' END MOVE PLAYER BASED ON DIRECTION
  5162.                 ' =============================================================================
  5163.  
  5164.  
  5165.                 ' =============================================================================
  5166.                 ' BEGIN CYCLE COLOR
  5167.                 ' =============================================================================
  5168.                 If m_arrPlayer(iPlayerLoop).ColorScheme1 > 0 Then
  5169.                     m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = m_arrPlayer(iPlayerLoop).ColorSchemeCount1 + 1
  5170.                     If m_arrPlayer(iPlayerLoop).ColorSchemeCount1 > m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 Then
  5171.                         m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
  5172.                         DoCycleColor m_arrPlayer(iPlayerLoop).ColorScheme1, m_arrPlayer(iPlayerLoop).Color1
  5173.                     End If
  5174.                 End If
  5175.                 ' =============================================================================
  5176.                 ' END CYCLE COLOR
  5177.                 ' =============================================================================
  5178.  
  5179.  
  5180.             Next iPlayerLoop
  5181.  
  5182.             ' ****************************************************************************************************************************************************************
  5183.             ' END PLAYER LOOP
  5184.             ' ****************************************************************************************************************************************************************
  5185.            
  5186.            
  5187.            
  5188.             ' ****************************************************************************************************************************************************************
  5189.             ' BEGIN DRAW SCREEN MARKERS
  5190.             ' ****************************************************************************************************************************************************************
  5191.             IF m_bDebugGrid = TRUE THEN
  5192.                
  5193.                 ' -----------------------------------------------------------------------------
  5194.                 ' BEGIN DRAW BITMAP GRID
  5195.                 ' -----------------------------------------------------------------------------
  5196.                 ' screen = 1280h x 1024w
  5197.                 iLoopX% = 1
  5198.                 for iLoopY% = 50 to 950 step 100
  5199.                     DrawRect iLoopX%, iLoopY%, 1280, 1, cWhite
  5200.                     DrawRect iLoopX%, iLoopY%+50, 1280, 1, cCyan
  5201.                 next iLoopY%
  5202.                 iLoopY% = 1
  5203.                 for iLoopX% = 50 to 1250 step 100
  5204.                     DrawRect iLoopX%, iLoopY%, 1, 1024, cWhite
  5205.                     DrawRect iLoopX%+50, iLoopY%, 1, 1024, cCyan
  5206.                 next iLoopX%
  5207.                 ' -----------------------------------------------------------------------------
  5208.                 ' END DRAW BITMAP GRID
  5209.                 ' -----------------------------------------------------------------------------
  5210.                
  5211.                 ' -----------------------------------------------------------------------------
  5212.                 ' BEGIN DRAW TEXT GRID
  5213.                 ' -----------------------------------------------------------------------------
  5214.                 iLoopY% = 64
  5215.                 for iLoopX% = 1 TO 160
  5216.                     ' show 100s place
  5217.                     in$ = cstr$(iLoopX%)
  5218.                     if len(in$) > 2 then
  5219.                         in$ = mid$(in$, len(in$)-2, 1)
  5220.                     else
  5221.                         in$ = " "
  5222.                     end if
  5223.                     Locate iLoopY%-2, iLoopX%
  5224.                     Print in$;
  5225.                    
  5226.                     ' show 10s place
  5227.                     in$ = cstr$(iLoopX%)
  5228.                     if len(in$) > 1 then
  5229.                         in$ = mid$(in$, len(in$)-1, 1)
  5230.                     else
  5231.                         in$ = " "
  5232.                     end if
  5233.                     Locate iLoopY%-1, iLoopX%
  5234.                     Print in$;
  5235.                    
  5236.                     ' show 1s place
  5237.                     in$ = right$(cstr$(iLoopX%), 1)
  5238.                     Locate iLoopY%, iLoopX%
  5239.                     Print in$;
  5240.                 next iLoopX%
  5241.                
  5242.                 iLoopX% = 1
  5243.                 for iLoopY% = 1 TO 64
  5244.                     Locate iLoopY%, iLoopX%
  5245.                     in$ = right$("  " + cstr$(iLoopY%), 2)
  5246.                     Print in$;
  5247.                 next iLoopY%
  5248.                 ' -----------------------------------------------------------------------------
  5249.                 ' END DRAW TEXT GRID
  5250.                 ' -----------------------------------------------------------------------------
  5251.                
  5252.             END IF
  5253.             ' ****************************************************************************************************************************************************************
  5254.             ' END DRAW SCREEN MARKERS
  5255.             ' ****************************************************************************************************************************************************************
  5256.            
  5257.            
  5258.            
  5259.            
  5260.             _Limit 30
  5261.             _Display
  5262.  
  5263.         Loop
  5264.     End If
  5265.  
  5266.     CleanupAndExit:
  5267.     ' FINISH UP AND EXIT
  5268.     _KeyClear
  5269.     Screen 0
  5270.     IsometricDraw1$ = sResult
  5271. End Function ' IsometricDraw1$
  5272.  
  5273. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5274. ' BEGIN FILE FUNCTIONS
  5275. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5276.  
  5277. ' /////////////////////////////////////////////////////////////////////////////
  5278. ' PLOT TILE TO MAP AND SAVE TO RECORDING
  5279.  
  5280. 'PlotTile iX, iY, iZ, iTile, ulngColor1
  5281. Sub PlotTile (iX As Integer, iY As Integer, iZ As Integer, iTile As Integer, ulngColor1 As _Unsigned Long)
  5282.     if iX >= lbound(m_arrMap, 1) and iX <= ubound(m_arrMap, 1) then
  5283.         if iY >= lbound(m_arrMap, 2) and iY <= ubound(m_arrMap, 2) then
  5284.             if iZ >= lbound(m_arrMap, 3) and iZ <= ubound(m_arrMap, 3) then
  5285.                 m_arrMap(iX, iY, iZ).Typ = iTile
  5286.                 m_arrMap(iX, iY, iZ).Color1 = ulngColor1
  5287.                 m_arrMap(iX, iY, iZ).Alpha1 = 255
  5288.                 m_arrMap(iX, iY, iZ).AlphaOverride = 255
  5289.                 LogPlotTile iX, iY, iZ, iTile, ulngColor1
  5290.             end if
  5291.         end if
  5292.     end if
  5293. End Sub ' PlotTile
  5294.  
  5295. ' /////////////////////////////////////////////////////////////////////////////
  5296. ' PLOT TILE TO SPECIFIED MAP, AND SAVE TO RECORDING IF SPECIFIED
  5297.  
  5298. ' temporary function for now
  5299. ' later we will update PlotTile and all will use that
  5300. ' and global bSaveToRecording will control whether LogPlotTile is called
  5301.  
  5302. 'PlotTile2 arrMap, iX, iY, iZ, iTile, ulngColor1
  5303. Sub PlotTile2 (arrMap() As MapTileType, iX As Integer, iY As Integer, iZ As Integer, iTile As Integer, ulngColor1 As _Unsigned Long)
  5304.     if iX >= lbound(arrMap, 1) and iX <= ubound(m_arrMap, 1) then
  5305.         if iY >= lbound(arrMap, 2) and iY <= ubound(m_arrMap, 2) then
  5306.             if iZ >= lbound(arrMap, 3) and iZ <= ubound(m_arrMap, 3) then
  5307.                 arrMap(iX, iY, iZ).Typ = iTile
  5308.                 arrMap(iX, iY, iZ).Color1 = ulngColor1
  5309.                 arrMap(iX, iY, iZ).Alpha1 = 255
  5310.                 arrMap(iX, iY, iZ).AlphaOverride = 255
  5311.                 'if bSaveToRecording = TRUE then
  5312.                 '    LogPlotTile iX, iY, iZ, iTile, ulngColor1
  5313.                 'end if
  5314.             end if
  5315.         end if
  5316.     end if
  5317. End Sub ' PlotTile2
  5318.  
  5319. ' /////////////////////////////////////////////////////////////////////////////
  5320. ' SAVE PLOT COMMAND TO RECORDING
  5321.  
  5322. 'LogPlotTile iX, iY, iZ, iTile, ulngColor1
  5323. Sub LogPlotTile (iX As Integer, iY As Integer, iZ As Integer, iTile As Integer, ulngColor1 As _Unsigned Long)
  5324.     Dim iIndex As Long
  5325.     ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
  5326.     iIndex = UBound(m_arrRecord)
  5327.     m_arrRecord(iIndex).Command = "plot"
  5328.     m_arrRecord(iIndex).intParam1 = iX
  5329.     m_arrRecord(iIndex).intParam2 = iY
  5330.     m_arrRecord(iIndex).intParam3 = iZ
  5331.     m_arrRecord(iIndex).intParam4 = iTile
  5332.     m_arrRecord(iIndex).ulngParam1 = ulngColor1
  5333. End Sub ' LogPlotTile
  5334.  
  5335. ' /////////////////////////////////////////////////////////////////////////////
  5336. '   - save screens to file (stored as editable text)
  5337. '     + FORMAT: [tile=t][color@x,y,z][color@x,y,z][color@x,y,z]...
  5338.  
  5339. Function SaveIsometricDrawing$
  5340.     Dim RoutineName As String:: RoutineName = "SaveIsometricDrawing$"
  5341.     Dim sError As String: sError = ""
  5342.     Dim sFile As String
  5343.     Dim in$
  5344.     Dim iX As Integer
  5345.     Dim iY As Integer
  5346.     Dim iZ As Integer
  5347.     Dim iTile As Integer
  5348.     Dim ulngColor1 As _Unsigned Long
  5349.     Dim iIndex As Long
  5350.     Dim sLine As String
  5351.     Dim iCount As Long: iCount = 0
  5352.     Dim iError As Long: iError = 0
  5353.    
  5354.     'DebugPrint "--------------------------------------------------------------------------------"
  5355.     'DebugPrint "Started " + RoutineName
  5356.     'DebugPrint "--------------------------------------------------------------------------------"
  5357.    
  5358.     _KeyClear
  5359.  
  5360.     ' Get file name
  5361.     Cls
  5362.     If Len(m_SaveFileName$) = 0 Then
  5363.         m_SaveFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "txt"
  5364.     End If
  5365.     Print "SAVE DRAWING:"
  5366.     Print "Default file name is " + Chr$(34) + m_SaveFileName$ + Chr$(34) + "."
  5367.     Input "Type save file name, or blank for default: ", in$
  5368.     in$ = _Trim$(in$)
  5369.     If Len(in$) > 0 Then
  5370.         m_SaveFileName$ = in$
  5371.     End If
  5372.     sFile = m_ProgramPath$ + m_SaveFileName$
  5373.  
  5374.     'DebugPrint "sFile=" + CHR$(34) + sFile + CHR$(34)
  5375.  
  5376.     ' Save recording to file
  5377.     Open sFile For Output As #1
  5378.  
  5379.     '[tile=t][color@x,y,z][color@x,y,z][color@x,y,z]
  5380.     For iIndex = 0 To UBound(m_arrRecord)
  5381.         If m_arrRecord(iIndex).Command = "plot" Then
  5382.             sLine = ""
  5383.             sLine = sLine + "plot,"
  5384.             sLine = sLine + "tile=" + _Trim$(Str$(m_arrRecord(iIndex).intParam4)) + ","
  5385.             sLine = sLine + "color=" + _Trim$(Str$(m_arrRecord(iIndex).ulngParam1)) + ","
  5386.             sLine = sLine + "x=" + _Trim$(Str$(m_arrRecord(iIndex).intParam1)) + ","
  5387.             sLine = sLine + "y=" + _Trim$(Str$(m_arrRecord(iIndex).intParam2)) + ","
  5388.             sLine = sLine + "z=" + _Trim$(Str$(m_arrRecord(iIndex).intParam3))
  5389.             Print #1, sLine
  5390.             iCount = iCount + 1
  5391.         Else
  5392.             'DebugPrint "SKIPPED m_arrRecord(" + _Trim$(Str$(iIndex)) + ") INVALID .Command=" + CHR$(34) + m_arrRecord(iIndex).Command + CHR$(34)
  5393.             iError = iError + 1
  5394.         End If
  5395.     Next iIndex
  5396.  
  5397.     Close #1
  5398.  
  5399.     Print "Wrote   " + _Trim$(Str$(iCount)) + " lines."
  5400.     Print "Skipped " + _Trim$(Str$(iError)) + " lines."
  5401.     Print
  5402.     Input "PRESS <ENTER> TO CONTINUE", in$
  5403.  
  5404.     SaveIsometricDrawing$ = sError
  5405. End Function ' SaveIsometricDrawing$
  5406.  
  5407. ' /////////////////////////////////////////////////////////////////////////////
  5408. '   - load screens into array m_arrRecord
  5409. '     + PARSER:
  5410. '       1. replace all ][ with [
  5411. '       2. split by "[" into simple 1D array
  5412. '       3. each element is either "tile=t" or "plot=color@x,y,z"
  5413. '       4. parse data into array to playback recording
  5414. '          [n][0] = command$ = "draw"
  5415. '          [n][1] = intParam1 = x
  5416. '          [n][2] = intValue2 = y
  5417. '          [n][3] = intValue3 = z
  5418. '          [n][4] = intParam4 = tile #
  5419. '          [n][5] = intValue5 = alpha1
  5420. '          [n][6] = ulngValue1 = color1
  5421.  
  5422. Function LoadIsometricDrawing$
  5423.     Dim RoutineName As String:: RoutineName = "LoadIsometricDrawing$"
  5424.     Dim sError As String: sError = ""
  5425.     Dim sFile As String
  5426.     Dim iIndex As Long
  5427.     Dim iLine As Long
  5428.     Dim iPair As Long
  5429.     Dim sText As String
  5430.     Dim sLine As String
  5431.     Dim sPair As String
  5432.     Dim iTotal As Long: iTotal = 0
  5433.     Dim iRead As Long: iRead = 0
  5434.     Dim iKnown As Long: iKnown = 0
  5435.     Dim iSkipped As Long: iSkipped = 0
  5436.     Dim iErrors As Long: iErrors = 0
  5437.     Dim iValid As Long: iValid = 0
  5438.     Dim iUnknown As Long: iUnknown = 0
  5439.     ReDim arrLines(-1) As String
  5440.     ReDim m_arrRecord(-1) As RecordType
  5441.     ReDim arrNextLine(-1) As String
  5442.     ReDim arrNameValue(-1) As String
  5443.     Dim sName As String
  5444.     Dim sValue As String
  5445.     Dim iX As Integer
  5446.     Dim iY As Integer
  5447.     Dim iZ As Integer
  5448.     Dim iTile As Integer
  5449.     Dim ulngColor1 As _Unsigned Long
  5450.     Dim sNextErr As String
  5451.     Dim sCommand As String
  5452.     'Dim sDebugLine As String
  5453.     Dim iPercent As Long
  5454.     Dim iStatusEvery As Long
  5455.     Dim iStatusCount As Long
  5456.  
  5457.     'DebugPrint "--------------------------------------------------------------------------------"
  5458.     'DebugPrint "Started " + RoutineName
  5459.     'DebugPrint "--------------------------------------------------------------------------------"
  5460.  
  5461.     _KeyClear
  5462.  
  5463.     ' Get file name
  5464.     If Len(sError) = 0 Then
  5465.         Cls
  5466.         If Len(m_SaveFileName$) = 0 Then
  5467.             m_SaveFileName$ = Left$(m_ProgramName$, _InStrRev(m_ProgramName$, ".")) + "txt"
  5468.         End If
  5469.         Print "LOAD DRAWING:"
  5470.         Print "Default file name is " + Chr$(34) + m_SaveFileName$ + Chr$(34) + "."
  5471.         Input "Type name of file to open, or blank for default: ", in$
  5472.         in$ = _Trim$(in$)
  5473.         If Len(in$) > 0 Then
  5474.             m_SaveFileName$ = in$
  5475.         End If
  5476.         sFile = m_ProgramPath$ + m_SaveFileName$
  5477.     End If
  5478.  
  5479.     ' Make sure file exists
  5480.     If Len(sError) = 0 Then
  5481.         If _FileExists(sFile) = FALSE Then
  5482.             sError = "File not found: " + Chr$(34) + sFile + Chr$(34)
  5483.         'Else
  5484.             'DebugPrint "Found file: " + chr$(34) + sFile + chr$(34)
  5485.         End If
  5486.     End If
  5487.  
  5488.     ' Load recording from file
  5489.     If Len(sError) = 0 Then
  5490.         ClearIsometricMap
  5491.         ReDim m_arrRecord(-1) As RecordType
  5492.  
  5493.         'DebugPrint "OPEN sFile FOR BINARY AS #1"
  5494.         Open sFile For Binary As #1
  5495.         sText = Space$(LOF(1))
  5496.         Get #1, , sText
  5497.         Close #1
  5498.         iTotal = Len(sText) - Len(Replace$(sText, Chr$(13), ""))
  5499.         sText = ""
  5500.  
  5501.         ' SPLIT IS TOO SLOW!
  5502.         'DebugPrint "split sText, CHR$(13), arrLines()"
  5503.         'split sText, CHR$(13), arrLines()
  5504.         'iTotal = ubound(arrLines)-1
  5505.  
  5506.         ' PARSE LINES: plot,tile=2,color=4294901760,x=10,y=10,z=10
  5507.         iStatusCount = 0
  5508.         iStatusEvery = iTotal / 100
  5509.  
  5510.         'Print "iTotal      =" + _Trim$(Str$(iTotal))
  5511.         'Print "iStatusEvery=" + _Trim$(Str$(iStatusEvery))
  5512.         'Input "PRESS <ENTER> TO CONTINUE",in$
  5513.  
  5514.         'FOR iLine = lbound(arrLines) TO ubound(arrLines)-1
  5515.         'sLine = arrLines(iLine)
  5516.         Open sFile For Input As #1
  5517.         While Not EOF(1)
  5518.             'INPUT #1, sLine
  5519.             Line Input #1, sLine ' read entire text file line
  5520.  
  5521.             iRead = iRead + 1
  5522.             'DebugPrint "Parsing line " + _Trim$(Str$(iRead))
  5523.  
  5524.             ' SHOW STATUS
  5525.             ' TODO: FIX <- DOESN'T SEEM TO DISPLAY UNTIL THE END, ALL AT ONCE
  5526.             iStatusCount = iStatusCount + 1
  5527.             If iStatusCount > iStatusEvery Then
  5528.                 iStatusCount = 0
  5529.                 iPercent = 100 * (iRead / iTotal)
  5530.                 Print _Trim$(Str$(iPercent)) + "%"
  5531.                 'DebugPrint _Trim$(Str$(iPercent)) + "%"
  5532.             End If
  5533.  
  5534.             'sDebugLine = sLine
  5535.             'sDebugLine = Replace$(sDebugLine, CHR$(9), "\t")
  5536.             'sDebugLine = Replace$(sDebugLine, CHR$(13), "\n")
  5537.             'sDebugLine = Replace$(sDebugLine, CHR$(10), "\r")
  5538.             'DebugPrint "    Raw    =" + chr$(34) + sDebugLine + chr$(34)
  5539.             ''DebugPrint "    Raw    =" + chr$(34) + arrLines(iLine) + chr$(34)
  5540.  
  5541.             sLine = Replace$(sLine, " ", "") ' Remove spaces
  5542.             sLine = Replace$(sLine, Chr$(9), "") ' Remove tabs
  5543.             sLine = Replace$(sLine, Chr$(10), "") ' Remove line breaks
  5544.             sLine = Replace$(sLine, Chr$(13), "") ' Remove carriage returns
  5545.             'DebugPrint "    Trimmed=" + chr$(34) + sLine + chr$(34)
  5546.  
  5547.             If Len(sLine) > 0 Then
  5548.                 split sLine, ",", arrNextLine()
  5549.                 'DebugPrint "    lbound =" + _Trim$(Str$(lbound(arrNextLine))) '+ CHR$(10)
  5550.                 'DebugPrint "    ubound =" + _Trim$(Str$(ubound(arrNextLine))) '+ CHR$(10)
  5551.  
  5552.                 sCommand = arrNextLine(LBound(arrNextLine))
  5553.                 sCommand = LCase$(sCommand)
  5554.                 'DebugPrint "    Command=" + chr$(34) + sCommand + chr$(34)
  5555.  
  5556.                 If sCommand = "plot" Then
  5557.                     iKnown = iKnown + 1
  5558.  
  5559.                     For iPair = LBound(arrNextLine) + 1 To UBound(arrNextLine)
  5560.                         sPair = arrNextLine(iPair)
  5561.                         If InStr(1, sPair, "=") > 0 Then
  5562.                             split sPair, "=", arrNameValue()
  5563.                             sName = LCase$(arrNameValue(LBound(arrNameValue)))
  5564.                             If UBound(arrNameValue) > LBound(arrNameValue) Then
  5565.                                 sValue = arrNameValue(LBound(arrNameValue) + 1)
  5566.                             Else
  5567.                                 sValue = ""
  5568.                             End If
  5569.                         Else
  5570.                             sName = ""
  5571.                         End If
  5572.                         sNextErr = ""
  5573.                         Select Case sName
  5574.                             Case "tile":
  5575.                                 If IsNum%(sValue) Then
  5576.                                     iTile = Val(sValue)
  5577.                                 Else
  5578.                                     sNextErr = "Invalid value: " + sName + " = " + Chr$(34) + sValue + Chr$(34)
  5579.                                 End If
  5580.                             Case "color":
  5581.                                 If IsNum%(sValue) Then
  5582.                                     ulngColor1 = Val(sValue)
  5583.                                 Else
  5584.                                     sNextErr = "Invalid value: " + sName + " = " + Chr$(34) + sValue + Chr$(34)
  5585.                                 End If
  5586.                             Case "x":
  5587.                                 If IsNum%(sValue) Then
  5588.                                     iX = Val(sValue)
  5589.                                 Else
  5590.                                     sNextErr = "Invalid value: " + sName + " = " + Chr$(34) + sValue + Chr$(34)
  5591.                                 End If
  5592.                             Case "y":
  5593.                                 If IsNum%(sValue) Then
  5594.                                     iY = Val(sValue)
  5595.                                 Else
  5596.                                     sNextErr = "Invalid value: " + sName + " = " + Chr$(34) + sValue + Chr$(34)
  5597.                                 End If
  5598.                             Case "z":
  5599.                                 If IsNum%(sValue) Then
  5600.                                     iZ = Val(sValue)
  5601.                                 Else
  5602.                                     sNextErr = "Invalid value: " + sName + " = " + Chr$(34) + sValue + Chr$(34)
  5603.                                 End If
  5604.                             Case Else:
  5605.                                 sNextErr = "Unknown parameter: " + Chr$(34) + sName + Chr$(34) + "," + Chr$(34) + sValue + Chr$(34)
  5606.                         End Select
  5607.                     Next iPair
  5608.                     If Len(sNextErr) = 0 Then
  5609.                         iValid = iValid + 1
  5610.  
  5611.                         'DebugPrint "READ VALUES SUCCESSFULLY:" + CHR$(13)
  5612.                         'DebugPrint "iTile     =" + _Trim$(Str$(iTile)) + CHR$(13)
  5613.                         'DebugPrint "ulngColor1=" + _Trim$(Str$(ulngColor1)) + CHR$(13)
  5614.                         'DebugPrint "iX        =" + _Trim$(Str$(iX)) + CHR$(13)
  5615.                         'DebugPrint "iY        =" + _Trim$(Str$(iY)) + CHR$(13)
  5616.                         'DebugPrint "iZ        =" + _Trim$(Str$(iZ)) + CHR$(13)
  5617.                         'IF m_bTesting = TRUE THEN EXIT FOR
  5618.  
  5619.                         PlotTile iX, iY, iZ, iTile, ulngColor1
  5620.                     Else
  5621.                         iErrors = iErrors + 1
  5622.  
  5623.                         Print "Line " + _Trim$(Str$(iRead)) + "=" + Chr$(34) + sLine + Chr$(34) + Chr$(10)
  5624.                         Print "    ERROR: " + sNextErr
  5625.  
  5626.                         ''DebugPrint "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
  5627.                         'DebugPrint "    ERROR: " + sNextErr
  5628.                         ''IF m_bTesting = TRUE THEN EXIT FOR
  5629.                     End If
  5630.                 Else
  5631.                     ''DebugPrint "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
  5632.                     'DebugPrint "    command not recognized: skipped"
  5633.                     iUnknown = iUnknown + 1
  5634.                 End If
  5635.  
  5636.             Else
  5637.                 ''DebugPrint "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
  5638.                 'DebugPrint "    Line is blank: skipped"
  5639.                 iSkipped = iSkipped + 1
  5640.             End If ' LEN(sLine) > 0
  5641.  
  5642.         Wend
  5643.         Close #1
  5644.         'NEXT iLine
  5645.     End If
  5646.  
  5647.     Print
  5648.     Print "Total lines read: " + _Trim$(Str$(iRead))
  5649.     Print "Known commands  : " + _Trim$(Str$(iKnown))
  5650.     Print "       -> Good  : " + _Trim$(Str$(iValid))
  5651.     Print "       ->  Bad  : " + _Trim$(Str$(iErrors))
  5652.     Print "Not recognized  : " + _Trim$(Str$(iUnknown))
  5653.     Print "Skipped blank   : " + _Trim$(Str$(iSkipped))
  5654.     Print
  5655.     Input "PRESS <ENTER> TO CONTINUE", in$
  5656.  
  5657.     LoadIsometricDrawing$ = sError
  5658. End Function ' LoadIsometricDrawing$
  5659.  
  5660. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5661. ' END FILE FUNCTIONS
  5662. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5663.  
  5664. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5665. ' BEGIN GRAPHICS FUNCTIONS
  5666. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5667.  
  5668. ' =============================================================================
  5669. ' LET'S GET THE COORDINATES STRAIGHT!
  5670. ' Coordinates are m_arrMap(x,y,z)
  5671. '           ________________
  5672. '          /|e            /|e
  5673. '         / |            / |
  5674. '        /  |           /  |z-axis
  5675. '       /   |          /   |
  5676. '      /    /---------/----/
  5677. '     /    / a       /   b/
  5678. '    /    /         /    /
  5679. '   |--------------|    /
  5680. '   |f  /         g|   / y-axis
  5681. '   |  /           |  /
  5682. '   | /            | /
  5683. '   |/c           d|/
  5684. '   ----------------
  5685. '      x-axis
  5686. '
  5687. ' POINT    ( X, Y, Z)
  5688. ' a        ( 0, 0, 0)
  5689. ' b        (32, 0, 0)
  5690. ' c        ( 0,32, 0)
  5691. ' d        (32,32, 0)
  5692. ' e        ( 0, 0,32)
  5693. ' f        ( 0,32,32)
  5694. ' g        (32,32,32)
  5695. ' =============================================================================
  5696.  
  5697. ' /////////////////////////////////////////////////////////////////////////////
  5698. ' INITIALIZE MAP TO EMPTY
  5699.  
  5700. ' Requires shared global variable:
  5701. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  5702. Sub ClearIsometricMap
  5703.     Dim RoutineName As String: RoutineName = "ClearIsometricMap"
  5704.     Dim iLoopX%
  5705.     Dim iLoopY%
  5706.     Dim iLoopZ%
  5707.  
  5708.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5709.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5710.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5711.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
  5712.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5713.             Next iLoopY%
  5714.         Next iLoopX%
  5715.     Next iLoopZ%
  5716. End Sub ' ClearIsometricMap
  5717.  
  5718. ' /////////////////////////////////////////////////////////////////////////////
  5719. ' INITIALIZE RENDERING MAP #1 TO EMPTY
  5720.  
  5721. ' Requires shared global variable:
  5722. ' m_arrRender1(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  5723.  
  5724. Sub ClearRenderMap1
  5725.     Dim RoutineName As String: RoutineName = "ClearRenderMap1"
  5726.     Dim iLoopX%
  5727.     Dim iLoopY%
  5728.     Dim iLoopZ%
  5729.    
  5730.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5731.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5732.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5733.                 m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
  5734.                 m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 0
  5735.             Next iLoopY%
  5736.         Next iLoopX%
  5737.     Next iLoopZ%
  5738. End Sub ' ClearRenderMap1
  5739.  
  5740. ' /////////////////////////////////////////////////////////////////////////////
  5741. ' INITIALIZE RENDERING MAP #2 TO EMPTY
  5742.  
  5743. ' Requires shared global variable:
  5744. ' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  5745.  
  5746. Sub ClearRenderMap2
  5747.     Dim RoutineName As String: RoutineName = "ClearRenderMap2"
  5748.     Dim iLoopX%
  5749.     Dim iLoopY%
  5750.     Dim iLoopZ%
  5751.    
  5752.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5753.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5754.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5755.                 m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
  5756.                 m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 0
  5757.             Next iLoopY%
  5758.         Next iLoopX%
  5759.     Next iLoopZ%
  5760. End Sub ' ClearRenderMap2
  5761.  
  5762. ' /////////////////////////////////////////////////////////////////////////////
  5763. ' Determine which squares are visible in isometric map
  5764.  
  5765. ' Original operates directly on the main map array m_arrMap
  5766. ' and not the copy (m_arrRender2) used to rotate the perspective.
  5767.  
  5768. ' Requires shared global variable (3D array of map):
  5769. ' m_arrMap(x,y,z) = 3D array map of world
  5770. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  5771.  
  5772. ' RECEIVES:
  5773. ' iX% = player's X positon
  5774. ' iY% = player's Y position
  5775. ' iZ% = player's Z position
  5776.  
  5777. ' Direction is assumed to be c_iDir_Forward.
  5778.  
  5779. ' If iX% < 0 then we just render everything with its normal alpha value.
  5780.  
  5781. Sub ComputeVisible (iX%, iY%, iZ%, iGridSize)
  5782.     Dim RoutineName As String: RoutineName = "ComputeVisible"
  5783.     Dim iLoopX%
  5784.     Dim iLoopY%
  5785.     Dim iLoopZ%
  5786.  
  5787.     Dim iPX1%
  5788.     Dim iPY1%
  5789.     Dim iPZ1%
  5790.     Dim iPlayer2Dx As Integer
  5791.     Dim iPlayer2Dy As Integer
  5792.     Dim iTile2Dx As Integer
  5793.     Dim iTile2Dy As Integer
  5794.  
  5795.     If iX% > -1 Then
  5796.         ' CALCULATE PLAYER'S 2-D POSITION
  5797.         iPX1% = iX% * iGridSize + cGridOffsetX
  5798.         iPY1% = iY% * iGridSize + cGridOffsetY
  5799.         iPZ1% = iZ% * iGridSize + cGridOffsetZ
  5800.         iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  5801.         iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  5802.         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  5803.  
  5804.         ' LOOK AT EACH TILE
  5805.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5806.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5807.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5808.  
  5809.                     ' *****************************************************************************
  5810.                     ' IF SPACE HAS A TILE
  5811.                     ' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
  5812.                     ' THEN MAKE THE TILE TRANSPARENT
  5813.                     ' *****************************************************************************
  5814.                     ' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
  5815.                     If m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Wall Or m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Floor Then
  5816.                         ' CALCULATE TILE'S 2-D POSITION
  5817.                         iPX1% = iLoopX% * iGridSize + cGridOffsetX
  5818.                         iPY1% = iLoopY% * iGridSize + cGridOffsetY
  5819.                         iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  5820.                         iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  5821.                         iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  5822.                         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  5823.  
  5824.                         'If iLoopZ% >= iZ% Then
  5825.                         'If iLoopX% >= iX% Then
  5826.  
  5827.                         ' FOR TILES FORWARD OF PLAYER
  5828.                         If iLoopY% > iY% Then
  5829.  
  5830.                             ' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
  5831.                             If (iPlayer2Dy >= (iTile2Dy - iGridSize)) And (iPlayer2Dy <= (iTile2Dy + iGridSize)) Then
  5832.  
  5833.                                 ' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
  5834.                                 If (iPlayer2Dx >= (iTile2Dx - iGridSize)) And (iPlayer2Dx <= (iTile2Dx + iGridSize)) Then
  5835.                                     ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
  5836.                                     ' TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE
  5837.                                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
  5838.                                 Else
  5839.                                     ' LEAVE THE TILE OPAQUE
  5840.                                     ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5841.                                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5842.                                 End If
  5843.                             Else
  5844.                                 ' LEAVE THE TILE OPAQUE
  5845.                                 ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5846.                                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5847.                             End If
  5848.                         Else
  5849.                             ' LEAVE THE TILE OPAQUE
  5850.                             ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5851.                             m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5852.                         End If
  5853.                         'End If
  5854.                         'End If
  5855.                     Else
  5856.                         ' LEAVE THE TILE OPAQUE
  5857.                         ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5858.                         m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5859.                     End If
  5860.                 Next iLoopZ%
  5861.             Next iLoopY%
  5862.         Next iLoopX%
  5863.     Else
  5864.         ' JUST MAKE ALL TILES VISIBLE
  5865.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5866.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5867.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5868.                     ' LEAVE THE TILE OPAQUE
  5869.                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5870.  
  5871.                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5872.                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  5873.                     'm_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  5874.  
  5875.                 Next iLoopZ%
  5876.             Next iLoopY%
  5877.         Next iLoopX%
  5878.     End If
  5879. End Sub ' ComputeVisible
  5880.  
  5881. ' /////////////////////////////////////////////////////////////////////////////
  5882. ' Determine which squares are visible in isometric map
  5883.  
  5884. ' Same as ComputeVisible except uses the rotated copy
  5885. ' (m_arrRender2 instead of m_arrMap)
  5886.  
  5887. ' Requires shared global variable (3D array of map):
  5888. ' m_arrRender2(x,y,z) = rotated copy of 3D array map of world
  5889. ' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  5890.  
  5891. ' RECEIVES:
  5892. ' iX% = player's X positon
  5893. ' iY% = player's Y position
  5894. ' iZ% = player's Z position
  5895.  
  5896. ' If iX% < 0 then we just render everything with its normal alpha value.
  5897.  
  5898. ' TODO: FIX FOR c_iDir_Down and c_iDir_Up DIRECTIONS
  5899. '       "FOR TILES FORWARD OF PLAYER" SECTION BELOW
  5900. '       NEEDS TO LOOK AT Z AXIS INSTEAD OF Y ?
  5901.  
  5902. Sub ComputeRenderVisible (iX%, iY%, iZ%, iGridSize)
  5903.     Dim RoutineName As String: RoutineName = "ComputeRenderVisible"
  5904.     Dim iLoopX%
  5905.     Dim iLoopY%
  5906.     Dim iLoopZ%
  5907.  
  5908.     Dim iPX1%
  5909.     Dim iPY1%
  5910.     Dim iPZ1%
  5911.     Dim iPlayer2Dx As Integer
  5912.     Dim iPlayer2Dy As Integer
  5913.     Dim iTile2Dx As Integer
  5914.     Dim iTile2Dy As Integer
  5915.  
  5916.     If iX% > -1 Then
  5917.         ' CALCULATE PLAYER'S 2-D POSITION
  5918.         iPX1% = iX% * iGridSize + cGridOffsetX
  5919.         iPY1% = iY% * iGridSize + cGridOffsetY
  5920.         iPZ1% = iZ% * iGridSize + cGridOffsetZ
  5921.         iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  5922.         iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  5923.         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  5924.  
  5925.         ' LOOK AT EACH TILE
  5926.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5927.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5928.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5929.  
  5930.                     ' *****************************************************************************
  5931.                     ' IF SPACE HAS A TILE
  5932.                     ' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
  5933.                     ' THEN MAKE THE TILE TRANSPARENT
  5934.                     ' *****************************************************************************
  5935.                     ' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
  5936.                     If m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Wall Or m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Floor Then
  5937.                         ' CALCULATE TILE'S 2-D POSITION
  5938.                         iPX1% = iLoopX% * iGridSize + cGridOffsetX
  5939.                         iPY1% = iLoopY% * iGridSize + cGridOffsetY
  5940.                         iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  5941.                         iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  5942.                         iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  5943.                         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  5944.  
  5945.                         'If iLoopZ% >= iZ% Then
  5946.                         'If iLoopX% >= iX% Then
  5947.  
  5948.                         ' FOR TILES FORWARD OF PLAYER
  5949.                         If iLoopY% > iY% Then
  5950.  
  5951.                             ' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
  5952.                             If (iPlayer2Dy >= (iTile2Dy - iGridSize)) And (iPlayer2Dy <= (iTile2Dy + iGridSize)) Then
  5953.  
  5954.                                 ' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
  5955.                                 If (iPlayer2Dx >= (iTile2Dx - iGridSize)) And (iPlayer2Dx <= (iTile2Dx + iGridSize)) Then
  5956.                                     ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
  5957.                                     'TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE?
  5958.                                     m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
  5959.                                 Else
  5960.                                     ' LEAVE THE TILE OPAQUE
  5961.                                     m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5962.  
  5963.                                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5964.                                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  5965.                                     'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  5966.                                 End If
  5967.                             Else
  5968.                                 ' LEAVE THE TILE OPAQUE
  5969.                                 m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5970.  
  5971.                                 'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5972.                                 'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  5973.                                 'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  5974.                             End If
  5975.                         Else
  5976.                             ' LEAVE THE TILE OPAQUE
  5977.                             m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5978.  
  5979.                             'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  5980.                             'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  5981.                             'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  5982.                         End If
  5983.                         'End If
  5984.                         'End If
  5985.                     Else
  5986.                         m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  5987.  
  5988.                         'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  5989.                         'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  5990.                     End If
  5991.                 Next iLoopZ%
  5992.             Next iLoopY%
  5993.         Next iLoopX%
  5994.     Else
  5995.         ' JUST MAKE ALL TILES VISIBLE
  5996.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  5997.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  5998.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  5999.                     m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  6000.  
  6001.                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  6002.                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  6003.                     'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  6004.                 Next iLoopZ%
  6005.             Next iLoopY%
  6006.         Next iLoopX%
  6007.     End If
  6008. End Sub ' ComputeRenderVisible
  6009.  
  6010. ' /////////////////////////////////////////////////////////////////////////////
  6011. ' Draw the map in 3D Isometic Perspective
  6012. ' from the forward (default) perspective.
  6013.  
  6014. ' Requires shared global variable
  6015. ' m_arrMap(x,y,z) = 3D array map of world
  6016. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  6017.  
  6018. ' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
  6019. ' params instead of constants:
  6020. ' Const cScreenOffsetX = 500 ' 450
  6021. ' Const cScreenOffsetY = 300 ' 50
  6022. ' Const cScreenOffsetZ = 0
  6023.  
  6024. ' what about?
  6025. ' Const cGridOffsetX = 50
  6026. ' Const cGridOffsetY = 50
  6027. ' Const cGridOffsetZ = 0
  6028.  
  6029. Sub DrawIsometricScreen (iScreenOffsetX, iScreenOffsetY, iGridSize)
  6030.     Dim RoutineName As String: RoutineName = "DrawIsometricScreen"
  6031.     Dim bTile As Integer
  6032.     Dim iLoopX%
  6033.     Dim iLoopY%
  6034.     Dim iLoopZ%
  6035.     Dim iColor As _Unsigned Long
  6036.     Dim iPosX1%
  6037.     Dim iPosX2%
  6038.     Dim iPosY1%
  6039.     Dim iPosY2%
  6040.     Dim iPosZ1%
  6041.     Dim alpha&
  6042.  
  6043.     alpha& = 255
  6044.     bTile = FALSE
  6045.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6046.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  6047.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  6048.  
  6049.                 ' CALCULATE POSITION
  6050.                 iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  6051.                 iPosX1% = iLoopX% * iGridSize + cGridOffsetX
  6052.                 iPosY1% = iLoopY% * iGridSize + cGridOffsetY
  6053.                 iPosX2% = iPosX1% + iGridSize
  6054.                 iPosY2% = iPosY1% + iGridSize
  6055.  
  6056.                 ' DETERMINE COLOR
  6057.                 If m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Floor Then
  6058.                     If bTile = TRUE Then
  6059.                         iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6060.                         bTile = FALSE
  6061.                     Else
  6062.                         iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
  6063.                         bTile = TRUE
  6064.                     End If
  6065.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Wall Then
  6066.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6067.                     alpha& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
  6068.  
  6069.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player1 Then
  6070.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6071.                     alpha& = 255
  6072.  
  6073.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player2 Then
  6074.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6075.                     alpha& = 255
  6076.  
  6077.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player3 Then
  6078.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6079.                     alpha& = 255
  6080.  
  6081.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player4 Then
  6082.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6083.                     alpha& = 255
  6084.  
  6085.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Water Then
  6086.                     'TODO: transparent for water
  6087.                     iColor = cEmpty
  6088.                     alpha& = 64
  6089.  
  6090.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Window Then
  6091.                     'TODO: transparent for windows
  6092.                     iColor = cEmpty
  6093.                     alpha& = 64
  6094.  
  6095.                 Else
  6096.                     iColor = cEmpty
  6097.                 End If
  6098.  
  6099.                 ' PLOT NEXT TILE
  6100.                 If iColor <> cEmpty Then
  6101.                     'IsoLine3D(x,      y,       x2,      y2,      z,       iHeight,     xoffset,        yoffset,        iColor As _Unsigned Long, alpha&)
  6102.                     'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
  6103.                     IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
  6104.                 End If
  6105.  
  6106.             Next iLoopY%
  6107.         Next iLoopX%
  6108.     Next iLoopZ%
  6109. End Sub ' DrawIsometricScreen
  6110.  
  6111. ' /////////////////////////////////////////////////////////////////////////////
  6112. ' Draw the map in 3D Isometic Perspective.
  6113.  
  6114. ' Requires shared global variable
  6115. ' m_arrRender2(x,y,z) = 3D array map of world
  6116. ' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  6117.  
  6118. Sub DrawRenderScreen (iScreenOffsetX, iScreenOffsetY, iGridSize)
  6119.     Dim RoutineName As String: RoutineName = "DrawRenderScreen"
  6120.     Dim bTile As Integer
  6121.     Dim iLoopX%
  6122.     Dim iLoopY%
  6123.     Dim iLoopZ%
  6124.     Dim iColor As _Unsigned Long
  6125.     Dim iPosX1%
  6126.     Dim iPosX2%
  6127.     Dim iPosY1%
  6128.     Dim iPosY2%
  6129.     Dim iPosZ1%
  6130.     Dim alpha&
  6131.  
  6132.     alpha& = 255
  6133.     bTile = FALSE
  6134.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6135.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  6136.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  6137.  
  6138.                 ' CALCULATE POSITION
  6139.                 iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  6140.                 iPosX1% = iLoopX% * iGridSize + cGridOffsetX
  6141.                 iPosY1% = iLoopY% * iGridSize + cGridOffsetY
  6142.                 iPosX2% = iPosX1% + iGridSize
  6143.                 iPosY2% = iPosY1% + iGridSize
  6144.  
  6145.                 ' DETERMINE COLOR
  6146.                 If m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Floor Then
  6147.                     If bTile = TRUE Then
  6148.                         iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6149.                         bTile = FALSE
  6150.                     Else
  6151.                         iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color2
  6152.                         bTile = TRUE
  6153.                     End If
  6154.  
  6155.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Wall Then
  6156.                     iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6157.                     alpha& = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
  6158.  
  6159.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player1 Then
  6160.                     iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6161.                     alpha& = 255
  6162.  
  6163.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player2 Then
  6164.                     iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6165.                     alpha& = 255
  6166.  
  6167.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player3 Then
  6168.                     iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6169.                     alpha& = 255
  6170.  
  6171.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Player4 Then
  6172.                     iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
  6173.                     alpha& = 255
  6174.  
  6175.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Water Then
  6176.                     'TODO: transparent for water
  6177.                     iColor = cEmpty
  6178.                     alpha& = 64
  6179.  
  6180.                 ElseIf m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Window Then
  6181.                     'TODO: transparent for windows
  6182.                     iColor = cEmpty
  6183.                     alpha& = 64
  6184.  
  6185.                 Else
  6186.                     iColor = cEmpty
  6187.                 End If
  6188.  
  6189.                 ' PLOT NEXT TILE
  6190.                 If iColor <> cEmpty Then
  6191.                     'IsoLine3D(x,      y,       x2,      y2,      z,       iHeight,     xoffset,        yoffset,        iColor As _Unsigned Long, alpha&)
  6192.                     'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
  6193.                     IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
  6194.                 End If
  6195.  
  6196.             Next iLoopY%
  6197.         Next iLoopX%
  6198.     Next iLoopZ%
  6199. End Sub ' DrawRenderScreen
  6200.  
  6201. ' /////////////////////////////////////////////////////////////////////////////
  6202. ' Draw the map in 3D Isometic Perspective
  6203. ' from a different direction.
  6204.  
  6205. ' This is the lazy man's version which simply copies the tiles to
  6206. ' a temporary array, rotated to the specified direction/orientation.
  6207. ' A more efficient + faster method would operate directly on the
  6208. ' main array, but I am too bogged down to figure that out right now!
  6209.  
  6210. ' RECEIVES:
  6211. ' iDirection% = point of view to render from
  6212. '     i.e. the direction we are looking at the scene FROM
  6213. '     iDirection% can be one of the following:
  6214. '     c_iDir_Down
  6215. '     c_iDir_Up
  6216. '     c_iDir_Left
  6217. '     c_iDir_Right
  6218. '     c_iDir_Back
  6219. '     c_iDir_Forward = default
  6220. '
  6221. '     If iDirection% = c_iDir_Forward, just call DrawIsometricScreen instead (faster).
  6222. '
  6223. ' iScreenOffsetX, iScreenOffsetY = where on display to draw
  6224. '
  6225. ' iX%, iY%, iZ% = player's position, used for ComputeRenderVisible
  6226. '     to compute which tiles to hide / make transparent
  6227. '     (tiles that might be hiding the player)
  6228. '     If these are <0, then ComputeRenderVisible uses original alpha values.
  6229.  
  6230. ' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
  6231. ' params instead of constants:
  6232. ' Const cScreenOffsetX = 500 ' 450
  6233. ' Const cScreenOffsetY = 300 ' 50
  6234. ' Const cScreenOffsetZ = 0
  6235.  
  6236. ' what about?
  6237. ' Const cGridOffsetX = 50
  6238. ' Const cGridOffsetY = 50
  6239. ' Const cGridOffsetZ = 0
  6240.  
  6241. ' TODO: player layer
  6242. ' m_iPlayerCount
  6243. ' shared for current player #?
  6244. ' first copy world and superimpose player coords?
  6245.  
  6246. Sub DrawScreen (iDirection%, iScreenOffsetX, iScreenOffsetY, iGridSize, iX%, iY%, iZ%)
  6247.     Dim RoutineName As String: RoutineName = "DrawScreen"
  6248.     Dim bTile As Integer
  6249.     Dim iLoopX%
  6250.     Dim iLoopY%
  6251.     Dim iLoopZ%
  6252.     Dim iColor As _Unsigned Long
  6253.     Dim iPosX1%
  6254.     Dim iPosX2%
  6255.     Dim iPosY1%
  6256.     Dim iPosY2%
  6257.     Dim iPosZ1%
  6258.     Dim alpha&
  6259.  
  6260.     ' =============================================================================
  6261.     ' USE FIRST TEMPORARY ARRAY TO STORE SCENE OVERLAID WITH PLAYERS + OBJECTS
  6262.  
  6263.     ' CLEAR THE MAP (NECESSARY?)
  6264.     ClearRenderMap1
  6265.  
  6266.     ' FIRST COPY THE MAP
  6267.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6268.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  6269.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  6270.                 'm_arrRender1(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  6271.                 CopyMapTile m_arrMap(iLoopX%, iLoopY%, iLoopZ%), m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6272.             Next iLoopY%
  6273.         Next iLoopX%
  6274.     Next iLoopZ%
  6275.  
  6276.     ' NEXT COPY THE PLAYERS
  6277.     For iLoopX% = m_iPlayerMin To m_iPlayerCount
  6278.         m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Typ = m_arrPlayer(iLoopX%).Tile1
  6279.         m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Color1 = m_arrPlayer(iLoopX%).Color1
  6280.         m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Alpha1 = m_arrPlayer(iLoopX%).Alpha1
  6281.         m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).AlphaOverride = m_arrPlayer(iLoopX%).AlphaOverride
  6282.     Next iLoopX%
  6283.  
  6284.     ' NEXT COPY THE OBJECTS
  6285.     ' (TO DO WHEN WE HAVE OBJECTS)
  6286.    
  6287.     ' =============================================================================
  6288.     ' USE SECOND TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
  6289.    
  6290.     ' CLEAR THE MAP (NECESSARY?)
  6291.     ClearRenderMap2
  6292.    
  6293.     ' COPY TILES, ROTATED TO DESIRED VIEWING PERSPECTIVE / ANGLE
  6294.     Select Case iDirection%
  6295.         Case c_iDir_Down:
  6296.             ' SCENE IS FLIPPED UP (TOP FACE NOW FACING AWAY FROM US)
  6297.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6298.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6299.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6300.                         m_arrRender2(iLoopX%, m_iMapMaxZ - iLoopZ%, iLoopY%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6301.                     Next iLoopY%
  6302.                 Next iLoopX%
  6303.             Next iLoopZ%
  6304.             ComputeRenderVisible iX%, m_iMapMaxZ - iZ%, iY%, iGridSize
  6305.         Case c_iDir_Up:
  6306.             ' SCENE IS FLIPPED DOWN (TOP FACE NOW FACING TOWARD US)
  6307.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6308.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6309.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6310.                         m_arrRender2(iLoopX%, iLoopZ%, m_iMapMaxY - iLoopY%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6311.                     Next iLoopY%
  6312.                 Next iLoopX%
  6313.             Next iLoopZ%
  6314.             ComputeRenderVisible iX%, iZ%, m_iMapMaxY - iY%, iGridSize
  6315.         Case c_iDir_Left:
  6316.             ' SCENE IS ROTATED COUNTER CLOCKWISE FROM TOP (LEFT FACE NOW FACING TOWARD US)
  6317.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6318.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6319.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6320.                         m_arrRender2(iLoopY%, m_iMapMaxX - iLoopX%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6321.                     Next iLoopY%
  6322.                 Next iLoopX%
  6323.             Next iLoopZ%
  6324.             ComputeRenderVisible iY%, m_iMapMaxX - iX%, iZ%, iGridSize
  6325.         Case c_iDir_Right:
  6326.             ' SCENE IS ROTATED CLOCKWISE FROM TOP (RIGHT FACE NOW FACING TOWARD US)
  6327.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6328.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6329.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6330.                         m_arrRender2(m_iMapMaxY - iLoopY%, iLoopX%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6331.                     Next iLoopY%
  6332.                 Next iLoopX%
  6333.             Next iLoopZ%
  6334.             ComputeRenderVisible m_iMapMaxY - iY%, iX%, iZ%, iGridSize
  6335.         Case c_iDir_Back:
  6336.             ' SCENE IS TURNED AROUND (FRONT FACE NOW FACING AWAY FROM US)
  6337.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6338.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6339.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6340.                         m_arrRender2(m_iMapMaxX - iLoopX%, m_iMapMaxY - iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6341.                     Next iLoopY%
  6342.                 Next iLoopX%
  6343.             Next iLoopZ%
  6344.             ComputeRenderVisible m_iMapMaxX - iX%, m_iMapMaxY - iY%, iZ%, iGridSize
  6345.         Case Else: ' c_iDir_Forward
  6346.             ' FOR ALL OTHER CASES WE JUST DRAW FORWARD (FACING TOWARD US)
  6347.             For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6348.                 For iLoopX% = m_iMapMinX To m_iMapMaxX
  6349.                     For iLoopY% = m_iMapMinY To m_iMapMaxY
  6350.                         m_arrRender2(iLoopX%, iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6351.                     Next iLoopY%
  6352.                 Next iLoopX%
  6353.             Next iLoopZ%
  6354.             ComputeRenderVisible iX%, iY%, iZ%, iGridSize
  6355.     End Select
  6356.     DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
  6357. End Sub ' DrawScreen
  6358.  
  6359. ' /////////////////////////////////////////////////////////////////////////////
  6360. ' similar to DrawScreen
  6361. ' but instead of player, draws objects
  6362. ' and free rotates (to angle iAngleXY)
  6363.  
  6364. ' TODO: get free rotation working
  6365. Sub DrawSnowScreen (iAngleXY, iScreenOffsetX, iScreenOffsetY, iGridSize, arrXmas() As XmasObjectType)
  6366.     Dim RoutineName As String: RoutineName = "DrawScreen"
  6367.     Dim bTile As Integer
  6368.     Dim iLoopX%
  6369.     Dim iLoopY%
  6370.     Dim iLoopZ%
  6371.     Dim iColor As _Unsigned Long
  6372.     Dim iPosX1%
  6373.     Dim iPosX2%
  6374.     Dim iPosY1%
  6375.     Dim iPosY2%
  6376.     Dim iPosZ1%
  6377.     Dim alpha&
  6378.     Dim iCount%
  6379.     Dim iMissingTileCount As Integer
  6380.    
  6381.     ' =============================================================================
  6382.     ' USE FIRST TEMPORARY ARRAY TO STORE SCENE OVERLAID WITH OBJECTS
  6383.    
  6384.     ' CLEAR THE MAP (NECESSARY?)
  6385.     ClearRenderMap1
  6386.    
  6387.     ' FIRST COPY THE MAP
  6388.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6389.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  6390.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  6391.                 'm_arrRender1(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  6392.                 CopyMapTile m_arrMap(iLoopX%, iLoopY%, iLoopZ%), m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6393.             Next iLoopY%
  6394.         Next iLoopX%
  6395.     Next iLoopZ%
  6396.    
  6397.     ' -----------------------------------------------------------------------------
  6398.     ' BEGIN DRAW XMAS OBJECTS #xmas
  6399.     For iCount% = lbound(arrXmas) to ubound(arrXmas)
  6400.         ' IS OBJECT ACTIVE?
  6401.         if arrXmas(iCount%).IsEnabled = TRUE then
  6402.            
  6403.             Select Case arrXmas(iCount%).Typ
  6404.                 Case cXmasSnow:
  6405.                     ' -----------------------------------------------------------------------------
  6406.                     ' BEGIN SNOWFLAKES #snow
  6407.                    
  6408.                     m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Typ = arrXmas(iCount%).Tile1
  6409.                     m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Color1 = arrXmas(iCount%).Color1
  6410.                     m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Alpha1 = arrXmas(iCount%).Alpha1
  6411.                     m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).AlphaOverride = arrXmas(iCount%).Alpha1
  6412.                    
  6413.                     ' END SNOWFLAKES @snow
  6414.                     ' -----------------------------------------------------------------------------
  6415.                    
  6416.                 Case cXmasStar:
  6417.                     ' -----------------------------------------------------------------------------
  6418.                     ' BEGIN STAR #star
  6419.                    
  6420.                     ' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
  6421.                     ' PlotCircle2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
  6422.                     PlotCircle2 m_arrRender1(), cPlaneXY, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).xCount, c_iTile_Wall, arrXmas(iCount%).Color1
  6423.                     PlotCircle2 m_arrRender1(), cPlaneYZ, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).yCount, c_iTile_Wall, arrXmas(iCount%).Color2
  6424.                     PlotCircle2 m_arrRender1(), cPlaneZX, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).zCount, c_iTile_Wall, arrXmas(iCount%).Color3
  6425.                     'CircleFill2 m_arrRender1(), cPlaneXY, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).xCount, c_iTile_Wall, arrXmas(iCount%).Color1
  6426.                     'CircleFill2 m_arrRender1(), cPlaneYZ, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).yCount, c_iTile_Wall, arrXmas(iCount%).Color1
  6427.                     'CircleFill2 m_arrRender1(), cPlaneZX, arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).zCount, c_iTile_Wall, arrXmas(iCount%).Color1
  6428.                    
  6429.                     ' END STAR @star
  6430.                     ' -----------------------------------------------------------------------------
  6431.                    
  6432.                 Case cXmasLight:
  6433.                     ' -----------------------------------------------------------------------------
  6434.                     ' BEGIN LIGHTS #lights
  6435.                    
  6436.                     ' blinking or always on?
  6437.                     if arrXmas(iCount%).xMax > 0 then
  6438.                         ' increment the counter for blinking
  6439.                         arrXmas(iCount%).xCount = arrXmas(iCount%).xCount + 1
  6440.                        
  6441.                         '' turn on for the first half
  6442.                         'if arrXmas(iCount%).xCount <= (arrXmas(iCount%).xMax/2) then
  6443.                         ' turn on for the majority (looks better!)
  6444.                         if arrXmas(iCount%).xCount <= (arrXmas(iCount%).xMax-1) then
  6445.                             m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Typ = arrXmas(iCount%).Tile1
  6446.                             m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Color1 = arrXmas(iCount%).Color1
  6447.                             m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Alpha1 = arrXmas(iCount%).Alpha1
  6448.                             m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).AlphaOverride = arrXmas(iCount%).Alpha1
  6449.                         else
  6450.                             ' turn off for the second half (don't render)
  6451.                            
  6452.                             ' remember to check to reset the counter!
  6453.                             if arrXmas(iCount%).xCount > arrXmas(iCount%).xMax then
  6454.                                 arrXmas(iCount%).xCount = arrXmas(iCount%).xMin
  6455.                             end if
  6456.                         end if
  6457.                     else
  6458.                         ' always on
  6459.                         m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Typ = arrXmas(iCount%).Tile1
  6460.                         m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Color1 = arrXmas(iCount%).Color1
  6461.                         m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).Alpha1 = arrXmas(iCount%).Alpha1
  6462.                         m_arrRender1(arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z).AlphaOverride = arrXmas(iCount%).Alpha1
  6463.                     end if
  6464.                    
  6465.                     ' END LIGHTS @lights
  6466.                     ' -----------------------------------------------------------------------------
  6467.                    
  6468.                 Case cXmasOrnament:
  6469.                     ' -----------------------------------------------------------------------------
  6470.                     ' BEGIN ORNAMENTS #orn
  6471.                    
  6472.                     'PlotSolidSphere m_arrMap(), CX, CY, CZ, R, iTile, iColor
  6473.                     'PlotSolidSphere m_arrRender1(), arrXmas(iCount%).x, arrXmas(iCount%).y, arrXmas(iCount%).z, arrXmas(iCount%).xSize, c_iTile_Wall, arrXmas(iCount%).Color1
  6474.                    
  6475.                     ' END ORNAMENTS @orn
  6476.                     ' -----------------------------------------------------------------------------
  6477.  
  6478.                 Case Else:
  6479.                     ' (DO NOTHING)
  6480.             End Select
  6481.         else ' .IsEnabled = FALSE
  6482.             Select Case arrXmas(iCount%).Typ
  6483.                 Case cXmasSnow:
  6484.                     ' (DO NOTHING)
  6485.                 Case cXmasStar:
  6486.                     ' (DO NOTHING)
  6487.                 Case cXmasLight:
  6488.                     ' (DO NOTHING)
  6489.                 Case cXmasOrnament:
  6490.                     ' (DO NOTHING)
  6491.                 Case Else:
  6492.                     ' (DO NOTHING)
  6493.             End Select
  6494.         end if ' .IsEnabled = TRUE
  6495.     Next iCount%
  6496.     ' END DRAW XMAS OBJECTS @xmas
  6497.     ' -----------------------------------------------------------------------------
  6498.    
  6499.     ' =============================================================================
  6500.     ' USE SECOND TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
  6501.     if (iAngleXY MOD 360 = 0) then
  6502.         ' CLEAR THE MAP (NECESSARY?)
  6503.         ClearRenderMap2
  6504.        
  6505.         ' COPY TILES, ROTATED TO DESIRED VIEWING PERSPECTIVE / ANGLE
  6506.         For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  6507.             'TODO: here is where we would do rotation
  6508.             For iLoopX% = m_iMapMinX To m_iMapMaxX
  6509.                 For iLoopY% = m_iMapMinY To m_iMapMaxY
  6510.                     m_arrRender2(iLoopX%, iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
  6511.                 Next iLoopY%
  6512.             Next iLoopX%
  6513.         Next iLoopZ%
  6514.         'ComputeRenderVisible iX%, iY%, iZ%, iGridSize
  6515.     else
  6516.         ShearRotate4 m_arrRender1(), m_arrRender2(), iAngleXY, cClockwise, cPlaneXY, iMissingTileCount
  6517.     end if
  6518.    
  6519.     ' =============================================================================
  6520.     ' DRAW THE FINAL SCENE
  6521.     DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
  6522. End Sub ' DrawSnowScreen
  6523.  
  6524. ' /////////////////////////////////////////////////////////////////////////////
  6525. ' Copies a MapTileType user defined type variable, member by member
  6526. ' (not sure if you can just do MyUDT1 = MyUDT2?)
  6527.  
  6528. Sub CopyMapTile (SourceMap As MapTileType, DestMap As MapTileType)
  6529.     DestMap.Typ = SourceMap.Typ
  6530.     DestMap.Color1 = SourceMap.Color1
  6531.     DestMap.Color2 = SourceMap.Color2
  6532.     DestMap.Color3 = SourceMap.Color3
  6533.     DestMap.Alpha1 = SourceMap.Alpha1
  6534.     DestMap.Alpha2 = SourceMap.Alpha2
  6535.     DestMap.Alpha3 = SourceMap.Alpha3
  6536.     DestMap.AlphaOverride = SourceMap.AlphaOverride
  6537. End Sub ' CopyMapTile
  6538.  
  6539. ' /////////////////////////////////////////////////////////////////////////////
  6540. ' RETURNS MAP AS TEXT
  6541.  
  6542. ' Requires shared global variable
  6543. ' m_arrMap(x,y,z) = 3D array map of world
  6544. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  6545.  
  6546. ' USAGE:
  6547. 'Input "See a text dump (y/n)? ", in$
  6548. 'If LCase$(in$) = LCase$("y") Then
  6549. '    Print MapToText$
  6550. 'End If
  6551.  
  6552. Function MapToText$
  6553.     Dim RoutineName As String: RoutineName = "MapToText$"
  6554.     Dim sResult As String
  6555.     Dim iLoopX%
  6556.     Dim iLoopY%
  6557.     Dim iLoopZ%
  6558.     Dim iMinX%
  6559.     Dim iMaxX%
  6560.     Dim iMinY%
  6561.     Dim iMaxY%
  6562.     Dim iMinZ%
  6563.     Dim iMaxZ%
  6564.     Dim sLine As String
  6565.     Dim iType%
  6566.     Dim iColor1&
  6567.     Dim iColor2&
  6568.     Dim iColor3&
  6569.     Dim in$
  6570.  
  6571.     sResult = ""
  6572.  
  6573.     ' FIND USED BOUNDARIES OF MAP
  6574.     iMinX% = -1
  6575.     iMaxX% = -1
  6576.     iMinY% = -1
  6577.     iMaxY% = -1
  6578.     iMinZ% = -1
  6579.     iMaxZ% = -1
  6580.     For iLoopZ% = 0 To 32
  6581.         For iLoopX% = 0 To 32
  6582.             For iLoopY% = 0 To 32
  6583.                 iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
  6584.                 If iType% <> c_iTile_Empty And iType% <> c_iTile_Floor Then
  6585.                     If iMinX% = -1 Then
  6586.                         iMinX% = iLoopX%
  6587.                     End If
  6588.                     If iMinY% = -1 Then
  6589.                         iMinY% = iLoopY%
  6590.                     End If
  6591.                     If iMinZ% = -1 Then
  6592.                         iMinZ% = iLoopZ%
  6593.                     End If
  6594.                     If iLoopX% > iMaxX% Then
  6595.                         iMaxX% = iLoopX%
  6596.                     End If
  6597.                     If iLoopY% > iMaxY% Then
  6598.                         iMaxY% = iLoopY%
  6599.                     End If
  6600.                     If iLoopZ% > iMaxZ% Then
  6601.                         iMaxZ% = iLoopZ%
  6602.                     End If
  6603.                 End If
  6604.             Next iLoopY%
  6605.         Next iLoopX%
  6606.     Next iLoopZ%
  6607.  
  6608.     ' GENERATE OUTPUT
  6609.     For iLoopZ% = iMinZ% To iMaxZ%
  6610.         sResult = sResult + "-------------------------------------------------------------------------------" + Chr$(13)
  6611.         sResult = sResult + "Map Z=" + cstr$(iLoopZ%) + ":" + Chr$(13)
  6612.         sResult = sResult + "-------------------------------------------------------------------------------" + Chr$(13)
  6613.         For iLoopY% = iMinY% To iMaxY%
  6614.             sLine = ""
  6615.             For iLoopX% = iMinX% To iMaxX%
  6616.                 iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
  6617.                 iColor1& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  6618.                 iColor2& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
  6619.                 iColor3& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color3
  6620.  
  6621.                 If iType% = c_iTile_Empty Then
  6622.                     sLine = sLine + " "
  6623.                 Else
  6624.                     If iColor1& = cEmpty Then
  6625.                         sLine = sLine + " "
  6626.                     Else
  6627.                         sLine = sLine + "#"
  6628.                     End If
  6629.                 End If
  6630.             Next iLoopX%
  6631.             sResult = sResult + sLine + Chr$(13)
  6632.         Next iLoopY%
  6633.  
  6634.         sResult = sResult + Chr$(13)
  6635.     Next iLoopZ%
  6636.  
  6637.     MapToText$ = sResult
  6638. End Function ' MapToText$
  6639.  
  6640. ' /////////////////////////////////////////////////////////////////////////////
  6641. ' Return string description for 2.5D movement constants
  6642.  
  6643. Function GetDirection$ (iDir As Integer)
  6644.     Dim sDir As String
  6645.     Select Case iDir
  6646.         Case c_iDir_Down:
  6647.             sDir = "Down"
  6648.         Case c_iDir_Up:
  6649.             sDir = "Up"
  6650.         Case c_iDir_Left:
  6651.             sDir = "Left"
  6652.         Case c_iDir_Right:
  6653.             sDir = "Right"
  6654.         Case c_iDir_Back:
  6655.             sDir = "Back"
  6656.         Case c_iDir_Forward:
  6657.             sDir = "Forward"
  6658.         Case Else:
  6659.             sDir = "Unknown"
  6660.     End Select
  6661.     GetDirection$ = sDir
  6662. End Function ' GetDirection$
  6663.  
  6664. ' /////////////////////////////////////////////////////////////////////////////
  6665.  
  6666. Function CX2I (x As Long, y As Long) 'Convert Cartesian X To Isometic coordinates
  6667.     CX2I = x - y
  6668. End Function ' CX2I
  6669.  
  6670. ' /////////////////////////////////////////////////////////////////////////////
  6671.  
  6672. Function CY2I (x As Long, y As Long) 'Convert Cartesian Y To Isometic coordinates
  6673.     CY2I = (x + y) / 2
  6674. End Function ' CY2I
  6675.  
  6676. ' /////////////////////////////////////////////////////////////////////////////
  6677. ' since we're drawing a diamond and not a square box, we can't use Line BF.
  6678. ' We have to manually down the 4 points of the line.
  6679.  
  6680. Sub IsoLine (x, y, x2, y2, xoffset, yoffset, iColor As _Unsigned Long)
  6681.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), iColor
  6682.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), iColor
  6683.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), iColor
  6684.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), iColor
  6685.     Paint (CX2I(x, y) + xoffset, CY2I(x, y) + 4), iColor 'and fill the diamond solid
  6686.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), &HFFFFFFFF
  6687.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), &HFFFFFFFF
  6688.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), &HFFFFFFFF
  6689.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), &HFFFFFFFF
  6690. End Sub ' IsoLine
  6691.  
  6692. ' /////////////////////////////////////////////////////////////////////////////
  6693. ' Like IsoLine, we're going to have to draw our lines manually.
  6694. ' only in this case, we also need a Z coordinate to tell us how
  6695. ' THICK/TALL/HIGH to make our tile
  6696.  
  6697. ' MODIFIED by madscijr to draw a single tile of height iHeight at Z axis
  6698. ' MODIFIED by madscijr to accept an alpha& value to control transparency (where 0=fully transparent, 255=opaque)
  6699.  
  6700. ''Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
  6701. 'Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
  6702. Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
  6703.     Dim r 'as integer
  6704.     Dim g 'as integer
  6705.     Dim b 'as integer
  6706.    
  6707.     r = _Red32(iColor)
  6708.     g = _Green32(iColor)
  6709.     b = _Blue32(iColor)
  6710.    
  6711.     ' Let's just do all the math first this time.
  6712.     ' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
  6713.     TempX1 = CX2I(x, y) + xoffset
  6714.     TempY1 = CY2I(x, y) + yoffset
  6715.     TempX2 = CX2I(x2, y) + xoffset
  6716.     TempY2 = CY2I(x2, y) + yoffset
  6717.     TempX3 = CX2I(x2, y2) + xoffset
  6718.     TempY3 = CY2I(x2, y2) + yoffset
  6719.     TempX4 = CX2I(x, y2) + xoffset
  6720.     TempY4 = CY2I(x, y2) + yoffset
  6721.    
  6722.     ' The top
  6723.     'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
  6724.     fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  6725.    
  6726.     If z <> 0 Then
  6727.         ' TODO: maybe change which sides gets shaded depending on the direction of the light source?
  6728.  
  6729.         ' draw the left side, shaded 75%
  6730.         'fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b)
  6731.         fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b, alpha&)
  6732.  
  6733.         ' draw the right side,s haded 50%
  6734.         'fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b)
  6735.         fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b, alpha&)
  6736.     Else
  6737.         ' no need to draw any height, if there isn't any.
  6738.     End If
  6739. End Sub ' IsoLine3D
  6740.  
  6741. ' /////////////////////////////////////////////////////////////////////////////
  6742. ' found at abandoned, outdated and now likely malicious qb64 dot net website
  6743. ' don't go there: http://www.qb64.[net]/forum/index.php?topic=14425.0
  6744.  
  6745. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  6746.     Dim D As Long
  6747.     Dim a&
  6748.  
  6749.     D = _Dest
  6750.     a& = _NewImage(1, 1, 32)
  6751.     _Dest a&
  6752.     PSet (0, 0), K
  6753.     _Dest D
  6754.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  6755.     _FreeImage a& ' <<< this is important!
  6756. End Sub ' ftri
  6757.  
  6758. ' /////////////////////////////////////////////////////////////////////////////
  6759. ' 2019-11-20 Steve saves some time with STATIC
  6760. ' and saves and restores last dest
  6761.  
  6762. Sub ftri1 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  6763.     Dim D As Long
  6764.     Static a&
  6765.    
  6766.     D = _Dest
  6767.     If a& = 0 Then
  6768.         a& = _NewImage(1, 1, 32)
  6769.     End If
  6770.     _Dest a&
  6771.     _DontBlend a&
  6772.     PSet (0, 0), K
  6773.     _Blend a&
  6774.     _Dest D
  6775.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  6776. End Sub ' ftri1
  6777.  
  6778. ' /////////////////////////////////////////////////////////////////////////////
  6779. ' original fill quad that may be at fault using Steve's fTri version
  6780. ' need 4 non linear points (not all on 1 line) list them clockwise
  6781. ' so x2, y2 is opposite of x4, y4
  6782.  
  6783. Sub fquad1 (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  6784.     ftri1 x1, y1, x2, y2, x4, y4, K
  6785.     ftri1 x3, y3, x2, y2, x4, y4, K
  6786. End Sub ' fquad1
  6787.  
  6788. ' /////////////////////////////////////////////////////////////////////////////
  6789. ' update 2019-12-16 needs orig fTri
  6790. ' need 4 non linear points (not all on 1 line)
  6791. ' list them clockwise so x2, y2 is opposite of x4, y4
  6792.  
  6793. Sub fquad (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  6794.     ftri x1, y1, x2, y2, x3, y3, K
  6795.     ftri x3, y3, x4, y4, x1, y1, K
  6796. End Sub ' fquad
  6797.  
  6798. ' /////////////////////////////////////////////////////////////////////////////
  6799. ' DRAW A 2-D RECTANGLE (SOLID)
  6800. ' Based on DrawBox
  6801.  
  6802. 'SUB DrawRect (iX%, iY%, iSizeW%, iSizeH%, iColor%)
  6803. Sub DrawRect (iX%, iY%, iSizeW%, iSizeH%, iColor~&)
  6804.     Line (iX%, iY%)-(iX% + iSizeW%, iY% + iSizeH%), iColor~&, BF ' Draw a solid box
  6805.     'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
  6806.     'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
  6807. End Sub ' DrawRect
  6808.  
  6809. ' /////////////////////////////////////////////////////////////////////////////
  6810. ' DRAW A 2-D BOX (SOLID)
  6811. ' https://www.qb64.org/wiki/LINE
  6812.  
  6813. 'SUB DrawBox (iX%, iY%, iSize%, iColor%)
  6814. Sub DrawBox (iX%, iY%, iSize%, iColor~&)
  6815.     Line (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor~&, BF ' Draw a solid box
  6816.     'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
  6817.     'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
  6818. End Sub ' DrawBox
  6819.  
  6820. ' /////////////////////////////////////////////////////////////////////////////
  6821. ' DRAW A 2-D BOX (OUTLINE)
  6822. ' https://www.qb64.org/wiki/LINE
  6823.  
  6824. ' The style parameter 0-255 doesn't seemt to have a solid line?
  6825.  
  6826. 'SUB DrawStyledOutlineBox (iX%, iY%, iSize%, iColor%, iStyle%)
  6827. Sub DrawStyledOutlineBox (iX%, iY%, iSize%, iColor~&, iStyle%)
  6828.     ' LINE [STEP] [(column1, row1)]-[STEP] (column2, row2), color[, [{B|BF}], style%]
  6829.     ' B creates a box outline with each side parallel to the program screen sides. BF creates a filled box.
  6830.     ' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
  6831.  
  6832.     Line (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor~&, B , iStyle%
  6833. End Sub ' DrawStyledOutlineBox
  6834.  
  6835. ' /////////////////////////////////////////////////////////////////////////////
  6836. ' DRAW A 2-D BOX (OUTLINE) WITH A SOLID LINE
  6837.  
  6838. Sub DrawOutlineBox (iX%, iY%, iSize2%, iColor~&, iWeight2%)
  6839.     Dim iFromX%
  6840.     Dim iFromY%
  6841.     Dim iToX%
  6842.     Dim iToY%
  6843.     iSize% = iSize2% - 1
  6844.     iWeight% = iWeight2% - 1
  6845.     If iWeight% = 0 Then
  6846.         ' TOP LINE
  6847.         iFromX% = iX%
  6848.         iFromY% = iY%
  6849.         iToX% = iX% + iSize%
  6850.         iToY% = iY%
  6851.         Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6852.  
  6853.         ' BOTTOM LINE
  6854.         iFromX% = iX%
  6855.         iFromY% = iY% + iSize%
  6856.         iToX% = iX% + iSize%
  6857.         iToY% = iY% + iSize%
  6858.         Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6859.  
  6860.         ' LEFT LINE
  6861.         iFromX% = iX%
  6862.         iFromY% = iY%
  6863.         iToX% = iX%
  6864.         iToY% = iY% + iSize%
  6865.         Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6866.  
  6867.         ' RIGHT LINE
  6868.         iFromX% = iX% + iSize%
  6869.         iFromY% = iY%
  6870.         iToX% = iX% + iSize%
  6871.         iToY% = iY% + iSize%
  6872.         Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6873.     ElseIf iWeight% > 0 Then
  6874.         ' TOP LINE
  6875.         For iFromY% = iY% To (iY% + iWeight%)
  6876.             iFromX% = iX%
  6877.             'iFromY% = iY%
  6878.             iToX% = iX% + iSize%
  6879.             iToY% = iFromY%
  6880.             Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6881.         Next iFromY%
  6882.  
  6883.         ' BOTTOM LINE
  6884.         For iFromY% = ((iY% + iSize%) - iWeight%) To (iY% + iSize%)
  6885.             iFromX% = iX%
  6886.             'iFromY% = iY% + iSize%
  6887.             iToX% = iX% + iSize%
  6888.             iToY% = iFromY%
  6889.             Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6890.         Next iFromY%
  6891.  
  6892.         ' LEFT LINE
  6893.         For iFromX% = iX% To (iX% + iWeight%)
  6894.             'iFromX% = iX%
  6895.             iFromY% = iY%
  6896.             iToX% = iFromX%
  6897.             iToY% = iY% + iSize%
  6898.             Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6899.         Next iFromX%
  6900.  
  6901.         ' RIGHT LINE
  6902.         For iFromX% = ((iX% + iSize%) - iWeight%) To (iX% + iSize%)
  6903.             'iFromX% = iX% + iSize%
  6904.             iFromY% = iY%
  6905.             iToX% = iFromX%
  6906.             iToY% = iY% + iSize%
  6907.             Line (iFromX%, iFromY%)-(iToX%, iToY%), iColor~&, BF
  6908.         Next iFromX%
  6909.     End If
  6910. End Sub ' DrawOutlineBox
  6911.  
  6912. ' /////////////////////////////////////////////////////////////////////////////
  6913.  
  6914. Function GetPaletteFromColor% (iColor~&)
  6915.     Select Case iColor~&
  6916.         Case cEmpty:
  6917.             GetPaletteFromColor% = 0
  6918.         Case cBlack:
  6919.             GetPaletteFromColor% = 1
  6920.         Case cDarkGray:
  6921.             GetPaletteFromColor% = 2
  6922.         Case cDimGray:
  6923.             GetPaletteFromColor% = 3
  6924.         Case cGray:
  6925.             GetPaletteFromColor% = 4
  6926.         Case cLightGray:
  6927.             GetPaletteFromColor% = 5
  6928.         Case cSilver:
  6929.             GetPaletteFromColor% = 6
  6930.         Case cWhite:
  6931.             GetPaletteFromColor% = 7
  6932.         Case cRed:
  6933.             GetPaletteFromColor% = 8
  6934.         Case cOrangeRed:
  6935.             GetPaletteFromColor% = 9
  6936.         Case cDarkOrange:
  6937.             GetPaletteFromColor% = 10
  6938.         Case cOrange:
  6939.             GetPaletteFromColor% = 11
  6940.         Case cGold:
  6941.             GetPaletteFromColor% = 12
  6942.         Case cYellow:
  6943.             GetPaletteFromColor% = 13
  6944.         Case cOliveDrab1:
  6945.             GetPaletteFromColor% = 14
  6946.         Case cLime:
  6947.             GetPaletteFromColor% = 15
  6948.         Case cMediumSpringGreen:
  6949.             GetPaletteFromColor% = 16
  6950.         Case cCyan:
  6951.             GetPaletteFromColor% = 17
  6952.         Case cDeepSkyBlue:
  6953.             GetPaletteFromColor% = 18
  6954.         Case cDodgerBlue:
  6955.             GetPaletteFromColor% = 19
  6956.         Case cSeaBlue:
  6957.             GetPaletteFromColor% = 20
  6958.         Case cBlue:
  6959.             GetPaletteFromColor% = 21
  6960.         Case cBluePurple:
  6961.             GetPaletteFromColor% = 22
  6962.         Case cDeepPurple:
  6963.             GetPaletteFromColor% = 23
  6964.         Case cPurple:
  6965.             GetPaletteFromColor% = 24
  6966.         Case cPurpleRed:
  6967.             GetPaletteFromColor% = 25
  6968.         Case Else:
  6969.             GetPaletteFromColor% = 0
  6970.     End Select
  6971. End Function ' GetPaletteFromColor%
  6972.  
  6973. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6974. ' END GRAPHICS FUNCTIONS
  6975. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6976.  
  6977.  
  6978.  
  6979. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6980. ' BEGIN DEBUGGING ROTUINES #DEBUGGING
  6981. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6982. sub DebugPrint(s$)
  6983.     IF m_bTesting = TRUE THEN
  6984.         _echo s$
  6985.         'ReDim arrLines$(0)
  6986.         'dim delim$ : delim$ = Chr$(13)
  6987.         'split MyString, delim$, arrLines$()
  6988.     END IF
  6989. end sub ' DebugPrint
  6990.  
  6991. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6992. ' END DEBUGGING ROTUINES @DEBUGGING
  6993. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6994.  
  6995.  
  6996. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6997. ' BEGIN GENERAL PURPOSE ROUTINES #GEN
  6998. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6999.  
  7000. ' /////////////////////////////////////////////////////////////////////////////
  7001. ' Convert a value to string and trim it (because normal Str$ adds spaces)
  7002.  
  7003. Function cstr$ (myValue)
  7004.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  7005.     cstr$ = _Trim$(Str$(myValue))
  7006. End Function ' cstr$
  7007.  
  7008. ' /////////////////////////////////////////////////////////////////////////////
  7009. ' Convert a Long value to string and trim it (because normal Str$ adds spaces)
  7010.  
  7011. Function cstrl$ (myValue As Long)
  7012.     cstrl$ = _Trim$(Str$(myValue))
  7013. End Function ' cstrl$
  7014.  
  7015. ' /////////////////////////////////////////////////////////////////////////////
  7016. ' Convert a Single value to string and trim it (because normal Str$ adds spaces)
  7017.  
  7018. Function cstrs$ (myValue As Single)
  7019.     ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  7020.     cstrs$ = _Trim$(Str$(myValue))
  7021. End Function ' cstrs$
  7022.  
  7023. ' /////////////////////////////////////////////////////////////////////////////
  7024. ' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
  7025.  
  7026. Function cstrul$ (myValue As _Unsigned Long)
  7027.     cstrul$ = _Trim$(Str$(myValue))
  7028. End Function ' cstrul$
  7029.  
  7030. ' /////////////////////////////////////////////////////////////////////////////
  7031. ' based on code from:
  7032. ' Qbasic Programs - Download free bas source code
  7033. ' http://www.thedubber.altervista.org/qbsrc.htm
  7034.  
  7035. Sub DrawTextLine (x%, y%, x2%, y2%, c$)
  7036.     'bError% = FALSE
  7037.     'LOCATE 2, 2: PRINT "(" + STR$(x%) + "," + STR$(y%) + ") to (" + STR$(x2%) + "," + STR$(y2%) + ") of " + CHR$(34) + c$ + CHR$(34);
  7038.  
  7039.     i% = 0
  7040.     steep% = 0
  7041.     e1% = 0
  7042.     If (x2% - x%) > 0 Then sx% = 1: Else sx% = -1
  7043.     dx% = Abs(x2% - x%)
  7044.     If (y2% - y%) > 0 Then sy% = 1: Else sy% = -1
  7045.     dy% = Abs(y2% - y%)
  7046.     If (dy% > dx%) Then
  7047.         steep% = 1
  7048.         Swap x%, y%
  7049.         Swap dx%, dy%
  7050.         Swap sx%, sy%
  7051.     End If
  7052.     e1% = 2 * dy% - dx%
  7053.     For i% = 0 To dx% - 1
  7054.         If steep% = 1 Then
  7055.             'PSET (y%, x%), c%:
  7056.             Locate y%, x%
  7057.             Print c$;
  7058.         Else
  7059.             'PSET (x%, y%), c%
  7060.             Locate x%, y%
  7061.             Print c$;
  7062.         End If
  7063.  
  7064.         While E% >= 0
  7065.             y% = y% + sy%: e1% = e1% - 2 * dx%
  7066.         Wend
  7067.         x% = x% + sx%: e1% = e1% + 2 * dy%
  7068.     Next
  7069.     'PSET (x2%, y2%), c%
  7070.     Locate x2%, y2%
  7071.     Print c$;
  7072.  
  7073. End Sub ' DrawTextLine
  7074.  
  7075. ' /////////////////////////////////////////////////////////////////////////////
  7076. ' From: Bitwise Manipulations By Steven Roman
  7077. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  7078.  
  7079. ' Returns the 8-bit binary representation
  7080. ' of an integer iInput where 0 <= iInput <= 255
  7081.  
  7082. Function GetBinary$ (iInput1 As Integer)
  7083.     Dim sResult As String
  7084.     Dim iLoop As Integer
  7085.     Dim iInput As Integer: iInput = iInput1
  7086.  
  7087.     sResult = ""
  7088.  
  7089.     If iInput >= 0 And iInput <= 255 Then
  7090.         For iLoop = 1 To 8
  7091.             sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
  7092.             iInput = iInput \ 2
  7093.             'If iLoop = 4 Then sResult = " " + sResult
  7094.         Next iLoop
  7095.     End If
  7096.  
  7097.     GetBinary$ = sResult
  7098. End Function ' GetBinary$
  7099.  
  7100. ' /////////////////////////////////////////////////////////////////////////////
  7101. ' wonderfully inefficient way to read if a bit is set
  7102. ' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
  7103.  
  7104. ' See also: GetBit256%, SetBit256%
  7105.  
  7106. Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
  7107.     Dim iResult As Integer
  7108.     Dim sNum As String
  7109.     Dim sBit As String
  7110.     Dim iLoop As Integer
  7111.     Dim bContinue As Integer
  7112.     'DIM iTemp AS INTEGER
  7113.     Dim iNum As Integer: iNum = iNum1
  7114.     Dim iBit As Integer: iBit = iBit1
  7115.  
  7116.     iResult = FALSE
  7117.     bContinue = TRUE
  7118.  
  7119.     If iNum < 256 And iBit <= 128 Then
  7120.         sNum = GetBinary$(iNum)
  7121.         sBit = GetBinary$(iBit)
  7122.         For iLoop = 1 To 8
  7123.             If Mid$(sBit, iLoop, 1) = "1" Then
  7124.                 'if any of the bits in iBit are false, return false
  7125.                 If Mid$(sNum, iLoop, 1) = "0" Then
  7126.                     iResult = FALSE
  7127.                     bContinue = FALSE
  7128.                     Exit For
  7129.                 End If
  7130.             End If
  7131.         Next iLoop
  7132.         If bContinue = TRUE Then
  7133.             iResult = TRUE
  7134.         End If
  7135.     End If
  7136.  
  7137.     GetBit256% = iResult
  7138. End Function ' GetBit256%
  7139.  
  7140. ' /////////////////////////////////////////////////////////////////////////////
  7141. ' From: Bitwise Manipulations By Steven Roman
  7142. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  7143.  
  7144. ' Returns the integer that corresponds to a binary string of length 8
  7145.  
  7146. Function GetIntegerFromBinary% (sBinary1 As String)
  7147.     Dim iResult As Integer
  7148.     Dim iLoop As Integer
  7149.     Dim strBinary As String
  7150.     Dim sBinary As String: sBinary = sBinary1
  7151.  
  7152.     iResult = 0
  7153.     strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
  7154.     For iLoop = 0 To Len(strBinary) - 1
  7155.         iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
  7156.     Next iLoop
  7157.  
  7158.     GetIntegerFromBinary% = iResult
  7159. End Function ' GetIntegerFromBinary%
  7160.  
  7161. ' /////////////////////////////////////////////////////////////////////////////
  7162.  
  7163. Function IIF (Condition, IfTrue, IfFalse)
  7164.     If Condition Then IIF = IfTrue Else IIF = IfFalse
  7165.  
  7166. ' /////////////////////////////////////////////////////////////////////////////
  7167.  
  7168. Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
  7169.     If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
  7170.  
  7171. ' /////////////////////////////////////////////////////////////////////////////
  7172. ' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
  7173.  
  7174. Function IsEven% (n)
  7175.     If n Mod 2 = 0 Then
  7176.         IsEven% = TRUE
  7177.     Else
  7178.         IsEven% = FALSE
  7179.     End If
  7180. End Function ' IsEven%
  7181.  
  7182. ' /////////////////////////////////////////////////////////////////////////////
  7183. ' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
  7184.  
  7185. Function IsOdd% (n)
  7186.     If n Mod 2 = 1 Then
  7187.         IsOdd% = TRUE
  7188.     Else
  7189.         IsOdd% = FALSE
  7190.     End If
  7191. End Function ' IsOdd%
  7192.  
  7193. ' /////////////////////////////////////////////////////////////////////////////
  7194. ' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
  7195.  
  7196. Function IsNum% (text$)
  7197.     Dim a$
  7198.     Dim b$
  7199.     a$ = _Trim$(text$)
  7200.     b$ = _Trim$(Str$(Val(text$)))
  7201.     If a$ = b$ Then
  7202.         IsNum% = TRUE
  7203.     Else
  7204.         IsNum% = FALSE
  7205.     End If
  7206. End Function ' IsNum%
  7207.  
  7208. ' /////////////////////////////////////////////////////////////////////////////
  7209. ' Re: Does a Is Number function exist in QB64?
  7210. ' https://www.qb64.org/forum/index.php?topic=896.15
  7211.  
  7212. ' MWheatley
  7213. ' « Reply #18 on: January 01, 2019, 11:24:30 AM »
  7214.  
  7215. ' returns 1 if string is an integer, 0 if not
  7216. Function IsNumber (text$)
  7217.     Dim i As Integer
  7218.  
  7219.     IsNumber = 1
  7220.     For i = 1 To Len(text$)
  7221.         If Asc(Mid$(text$, i, 1)) < 45 Or Asc(Mid$(text$, i, 1)) >= 58 Then
  7222.             IsNumber = 0
  7223.             Exit For
  7224.         ElseIf Asc(Mid$(text$, i, 1)) = 47 Then
  7225.             IsNumber = 0
  7226.             Exit For
  7227.         End If
  7228.     Next i
  7229. End Function ' IsNumber
  7230.  
  7231. ' /////////////////////////////////////////////////////////////////////////////
  7232. ' Split and join strings
  7233. ' https://www.qb64.org/forum/index.php?topic=1073.0
  7234.  
  7235. 'Combine all elements of in$() into a single string with delimiter$ separating the elements.
  7236.  
  7237. Function join$ (in$(), delimiter$)
  7238.     Dim result$
  7239.     Dim i As Long
  7240.     result$ = in$(LBound(in$))
  7241.     For i = LBound(in$) + 1 To UBound(in$)
  7242.         result$ = result$ + delimiter$ + in$(i)
  7243.     Next i
  7244.     join$ = result$
  7245. End Function ' join$
  7246.  
  7247. ' /////////////////////////////////////////////////////////////////////////////
  7248. ' ABS was returning strange values with type LONG
  7249. ' so I created this which does not.
  7250.  
  7251. Function LongABS& (lngValue As Long)
  7252.     If Sgn(lngValue) = -1 Then
  7253.         LongABS& = 0 - lngValue
  7254.     Else
  7255.         LongABS& = lngValue
  7256.     End If
  7257. End Function ' LongABS&
  7258.  
  7259. ' /////////////////////////////////////////////////////////////////////////////
  7260. ' Writes sText to a debug file in the EXE folder.
  7261. ' Debug file is named the same thing as the program EXE name with ".txt" at the end.
  7262. ' For example the program "C:\QB64\MyProgram.BAS" running as
  7263. ' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
  7264. ' If the file doesn't exist, it is created, otherwise it is appended to.
  7265.  
  7266. Sub DebugPrintFile (sText As String)
  7267.     Dim sFileName As String
  7268.     Dim sError As String
  7269.     Dim sOut As String
  7270.  
  7271.     sFileName = ProgramPath$ + ProgramName$ + ".txt"
  7272.     sError = ""
  7273.     If _FileExists(sFileName) = FALSE Then
  7274.         sOut = ""
  7275.         sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
  7276.         sOut = sOut + "PROGRAM : " + ProgramName$ + Chr$(13) + Chr$(10)
  7277.         sOut = sOut + "RUN DATE: " + CurrentDateTime$ + Chr$(13) + Chr$(10)
  7278.         sOut = sOut + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10)
  7279.         sError = PrintFile$(sFileName, sOut, FALSE)
  7280.     End If
  7281.     If Len(sError) = 0 Then
  7282.         sError = PrintFile$(sFileName, sText, TRUE)
  7283.     End If
  7284.     If Len(sError) <> 0 Then
  7285.         Print CurrentDateTime$ + " DebugPrintFile FAILED: " + sError
  7286.     End If
  7287. End Sub ' DebugPrintFile
  7288.  
  7289. ' /////////////////////////////////////////////////////////////////////////////
  7290. ' Returns blank if successful else returns error message.
  7291.  
  7292. Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
  7293.     'x = 1: y = 2: z$ = "Three"
  7294.  
  7295.     Dim sError As String: sError = ""
  7296.  
  7297.     If Len(sError) = 0 Then
  7298.         If (bAppend = TRUE) Then
  7299.             If _FileExists(sFileName) Then
  7300.                 Open sFileName For Append As #1 ' opens an existing file for appending
  7301.             Else
  7302.                 sError = "Error in PrintFile$ : File not found. Cannot append."
  7303.             End If
  7304.         Else
  7305.             Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
  7306.         End If
  7307.     End If
  7308.     If Len(sError) = 0 Then
  7309.         ' WRITE places text in quotes in the file
  7310.         'WRITE #1, x, y, z$
  7311.         'WRITE #1, sText
  7312.  
  7313.         ' PRINT does not put text inside quotes
  7314.         Print #1, sText
  7315.  
  7316.         Close #1
  7317.  
  7318.         'PRINT "File created with data. Press a key!"
  7319.         'K$ = INPUT$(1) 'press a key
  7320.  
  7321.         'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
  7322.         'INPUT #2, a, b, c$
  7323.         'CLOSE #2
  7324.  
  7325.         'PRINT a, b, c$
  7326.         'WRITE a, b, c$
  7327.     End If
  7328.  
  7329.     PrintFile$ = sError
  7330. End Function ' PrintFile$
  7331.  
  7332. ' /////////////////////////////////////////////////////////////////////////////
  7333. ' iNum% = PromptForIntegerInRange%("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
  7334.  
  7335. Function PromptForIntegerInRange% (sPrompt$, iMin%, iMax%, iDefault%)
  7336.     Dim iValue%
  7337.     Dim bFinished%
  7338.     Dim sPrompt1$
  7339.     Dim in$
  7340.  
  7341.     If Len(sPrompt$) > 0 Then
  7342.         sPrompt1$ = sPrompt$
  7343.     Else
  7344.         sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
  7345.     End If
  7346.  
  7347.     sPrompt1$ = Replace$(sPrompt1$, "{min}", cstr$(iMin%))
  7348.     sPrompt1$ = Replace$(sPrompt1$, "{max}", cstr$(iMax%))
  7349.  
  7350.     bFinished% = FALSE
  7351.     Do
  7352.         Print sPrompt1$
  7353.  
  7354.         Input in$
  7355.         in$ = _Trim$(in$)
  7356.         If Len(in$) > 0 Then
  7357.             If IsNumber(in$) Then
  7358.                 iValue% = Val(in$)
  7359.                 If iValue% >= iMin% And iValue% <= iMax% Then
  7360.                     'bFinished% = TRUE
  7361.                     Exit Do
  7362.                 Else
  7363.                     Print "Number out of range."
  7364.                     Print
  7365.                 End If
  7366.             Else
  7367.                 Print "Not a valid number."
  7368.                 Print
  7369.             End If
  7370.         Else
  7371.             iValue% = iDefault%
  7372.             Exit Do
  7373.             'bFinished% = TRUE
  7374.         End If
  7375.     Loop Until bFinished% = TRUE
  7376.  
  7377.     PromptForIntegerInRange% = iValue%
  7378. End Function ' PromptForIntegerInRange%
  7379.  
  7380. ' /////////////////////////////////////////////////////////////////////////////
  7381. ' iNum& = PromptForLongInRange&("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
  7382.  
  7383. Function PromptForLongInRange& (sPrompt$, iMin&, iMax&, iDefault&)
  7384.     Dim iValue&
  7385.     Dim bFinished&
  7386.     Dim sPrompt1$
  7387.     Dim in$
  7388.  
  7389.     bFinished& = FALSE
  7390.     Do
  7391.         If Len(sPrompt$) > 0 Then
  7392.             sPrompt1$ = sPrompt$
  7393.         Else
  7394.             sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
  7395.         End If
  7396.  
  7397.         sPrompt1$ = Replace$(sPrompt1$, "{min}", cstrl$(iMin&))
  7398.         sPrompt1$ = Replace$(sPrompt1$, "{max}", cstrl$(iMax&))
  7399.  
  7400.         Input in$
  7401.         in$ = _Trim$(in$)
  7402.         If Len(in$) > 0 Then
  7403.             If IsNumber(in$) Then
  7404.                 iValue& = Val(in$)
  7405.                 If iValue& >= iMin& And iValue& <= iMax& Then
  7406.                     bFinished& = TRUE
  7407.                 Else
  7408.                     Print "Number out of range."
  7409.                     Print
  7410.                 End If
  7411.             Else
  7412.                 Print "Not a valid number."
  7413.                 Print
  7414.             End If
  7415.         Else
  7416.             iValue& = iDefault&
  7417.             bFinished& = TRUE
  7418.         End If
  7419.     Loop Until bFinished&
  7420.  
  7421.     PromptForLongInRange& = iValue&
  7422. End Function ' PromptForLongInRange&
  7423.  
  7424. ' /////////////////////////////////////////////////////////////////////////////
  7425. ' Generate random value between Min and Max.
  7426. Function RandomNumber% (Min%, Max%)
  7427.     Dim NumSpread%
  7428.  
  7429.     ' SET RANDOM SEED
  7430.     'Randomize ' Initialize random-number generator.
  7431.  
  7432.     ' GET RANDOM # Min%-Max%
  7433.     'RandomNumber = Int((Max * Rnd) + Min) ' generate number
  7434.  
  7435.     NumSpread% = (Max% - Min%) + 1
  7436.  
  7437.     RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
  7438.  
  7439. End Function ' RandomNumber%
  7440.  
  7441. ' /////////////////////////////////////////////////////////////////////////////
  7442.  
  7443. Sub RandomNumberTest
  7444.     Dim iCols As Integer: iCols = 10
  7445.     Dim iRows As Integer: iRows = 20
  7446.     Dim iLoop As Integer
  7447.     Dim iX As Integer
  7448.     Dim iY As Integer
  7449.     Dim sError As String
  7450.     Dim sFileName As String
  7451.     Dim sText As String
  7452.     Dim bAppend As Integer
  7453.     Dim iMin As Integer
  7454.     Dim iMax As Integer
  7455.     Dim iNum As Integer
  7456.     Dim iErrorCount As Integer
  7457.     Dim sInput$
  7458.  
  7459.     sFileName = "c:\temp\maze_test_1.txt"
  7460.     sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
  7461.     bAppend = FALSE
  7462.     sError = PrintFile$(sFileName, sText, bAppend)
  7463.     If Len(sError) = 0 Then
  7464.         bAppend = TRUE
  7465.         iErrorCount = 0
  7466.  
  7467.         iMin = 0
  7468.         iMax = iCols - 1
  7469.         For iLoop = 1 To 100
  7470.             iNum = RandomNumber%(iMin, iMax)
  7471.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  7472.             sError = PrintFile$(sFileName, sText, bAppend)
  7473.             If Len(sError) > 0 Then
  7474.                 iErrorCount = iErrorCount + 1
  7475.                 Print Str$(iLoop) + ". ERROR"
  7476.                 Print "    " + "iMin=" + Str$(iMin)
  7477.                 Print "    " + "iMax=" + Str$(iMax)
  7478.                 Print "    " + "iNum=" + Str$(iNum)
  7479.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  7480.                 Print "    " + sError
  7481.             End If
  7482.         Next iLoop
  7483.  
  7484.         iMin = 0
  7485.         iMax = iRows - 1
  7486.         For iLoop = 1 To 100
  7487.             iNum = RandomNumber%(iMin, iMax)
  7488.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  7489.             sError = PrintFile$(sFileName, sText, bAppend)
  7490.             If Len(sError) > 0 Then
  7491.                 iErrorCount = iErrorCount + 1
  7492.                 Print Str$(iLoop) + ". ERROR"
  7493.                 Print "    " + "iMin=" + Str$(iMin)
  7494.                 Print "    " + "iMax=" + Str$(iMax)
  7495.                 Print "    " + "iNum=" + Str$(iNum)
  7496.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  7497.                 Print "    " + sError
  7498.             End If
  7499.         Next iLoop
  7500.  
  7501.         Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
  7502.     Else
  7503.         Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
  7504.         Print sError
  7505.     End If
  7506.  
  7507.     Input "Press <ENTER> to continue", sInput$
  7508. End Sub ' RandomNumberTest
  7509.  
  7510. ' /////////////////////////////////////////////////////////////////////////////
  7511. ' FROM: String Manipulation
  7512. ' found at abandoned, outdated and now likely malicious qb64 dot net website
  7513. ' http://www.qb64.[net]/forum/index_topic_5964-0/
  7514. '
  7515. 'SUMMARY:
  7516. '   Purpose:  A library of custom functions that transform strings.
  7517. '   Author:   Dustinian Camburides (dustinian@gmail.com)
  7518. '   Platform: QB64 (www.qb64.org)
  7519. '   Revision: 1.6
  7520. '   Updated:  5/28/2012
  7521.  
  7522. 'SUMMARY:
  7523. '[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
  7524. 'INPUT:
  7525. 'Text: The input string; the text that's being manipulated.
  7526. 'Find: The specified sub-string; the string sought within the [Text] string.
  7527. 'Add: The sub-string that's being added to the [Text] string.
  7528.  
  7529. Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
  7530.     ' VARIABLES:
  7531.     Dim Text2 As String
  7532.     Dim Find2 As String
  7533.     Dim Add2 As String
  7534.     Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
  7535.     Dim strBefore As String ' The characters before the string to be replaced.
  7536.     Dim strAfter As String ' The characters after the string to be replaced.
  7537.  
  7538.     ' INITIALIZE:
  7539.     ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
  7540.     Text2 = Text1
  7541.     Find2 = Find1
  7542.     Add2 = Add1
  7543.  
  7544.     lngLocation = InStr(1, Text2, Find2)
  7545.  
  7546.     ' PROCESSING:
  7547.     ' While [Find2] appears in [Text2]...
  7548.     While lngLocation
  7549.         ' Extract all Text2 before the [Find2] substring:
  7550.         strBefore = Left$(Text2, lngLocation - 1)
  7551.  
  7552.         ' Extract all text after the [Find2] substring:
  7553.         strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
  7554.  
  7555.         ' Return the substring:
  7556.         Text2 = strBefore + Add2 + strAfter
  7557.  
  7558.         ' Locate the next instance of [Find2]:
  7559.         lngLocation = InStr(1, Text2, Find2)
  7560.  
  7561.         ' Next instance of [Find2]...
  7562.     Wend
  7563.  
  7564.     ' OUTPUT:
  7565.     Replace$ = Text2
  7566. End Function ' Replace$
  7567.  
  7568. ' /////////////////////////////////////////////////////////////////////////////
  7569.  
  7570. Sub ReplaceTest
  7571.     Dim in$
  7572.  
  7573.     Print "-------------------------------------------------------------------------------"
  7574.     Print "ReplaceTest"
  7575.     Print
  7576.  
  7577.     Print "Original value"
  7578.     in$ = "Thiz iz a teZt."
  7579.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  7580.     Print
  7581.  
  7582.     Print "Replacing lowercase " + Chr$(34) + "z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
  7583.     in$ = Replace$(in$, "z", "s")
  7584.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  7585.     Print
  7586.  
  7587.     Print "Replacing uppercase " + Chr$(34) + "Z" + Chr$(34) + " with " + Chr$(34) + "s" + Chr$(34) + "..."
  7588.     in$ = Replace$(in$, "Z", "s")
  7589.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  7590.     Print
  7591.  
  7592.     Print "ReplaceTest finished."
  7593. End Sub ' ReplaceTest
  7594.  
  7595. ' /////////////////////////////////////////////////////////////////////////////
  7596. ' fantastically inefficient way to set a bit
  7597.  
  7598. ' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
  7599.  
  7600. ' See also: GetBit256%, SetBit256%
  7601.  
  7602. ' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
  7603. Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
  7604.     Dim sNum As String
  7605.     Dim sBit As String
  7606.     Dim sVal As String
  7607.     Dim iLoop As Integer
  7608.     Dim strResult As String
  7609.     Dim iResult As Integer
  7610.     Dim iNum As Integer: iNum = iNum1
  7611.     Dim iBit As Integer: iBit = iBit1
  7612.     Dim bVal As Integer: bVal = bVal1
  7613.  
  7614.     If iNum < 256 And iBit <= 128 Then
  7615.         sNum = GetBinary$(iNum)
  7616.         sBit = GetBinary$(iBit)
  7617.         If bVal = TRUE Then
  7618.             sVal = "1"
  7619.         Else
  7620.             sVal = "0"
  7621.         End If
  7622.         strResult = ""
  7623.         For iLoop = 1 To 8
  7624.             If Mid$(sBit, iLoop, 1) = "1" Then
  7625.                 strResult = strResult + sVal
  7626.             Else
  7627.                 strResult = strResult + Mid$(sNum, iLoop, 1)
  7628.             End If
  7629.         Next iLoop
  7630.         iResult = GetIntegerFromBinary%(strResult)
  7631.     Else
  7632.         iResult = iNum
  7633.     End If
  7634.  
  7635.     SetBit256% = iResult
  7636. End Function ' SetBit256%
  7637.  
  7638. ' /////////////////////////////////////////////////////////////////////////////
  7639. ' Split and join strings
  7640. ' https://www.qb64.org/forum/index.php?topic=1073.0
  7641. '
  7642. ' FROM luke, QB64 Developer
  7643. ' Date: February 15, 2019, 04:11:07 AM »
  7644. '
  7645. ' Given a string of words separated by spaces (or any other character),
  7646. ' splits it into an array of the words. I've no doubt many people have
  7647. ' written a version of this over the years and no doubt there's a million
  7648. ' ways to do it, but I thought I'd put mine here so we have at least one
  7649. ' version. There's also a join function that does the opposite
  7650. ' array -> single string.
  7651. '
  7652. ' Code is hopefully reasonably self explanatory with comments and a little demo.
  7653. ' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
  7654.  
  7655. 'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
  7656. 'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
  7657. '
  7658. 'delimiter$ must be one character long.
  7659. 'result$() must have been REDIMmed previously.
  7660.  
  7661. ' Modified to handle multi-character delimiters
  7662.  
  7663. Sub split (in$, delimiter$, result$())
  7664.     Dim start As Integer
  7665.     Dim finish As Integer
  7666.     Dim iDelimLen As Integer
  7667.     ReDim result$(-1)
  7668.  
  7669.     iDelimLen = Len(delimiter$)
  7670.  
  7671.     start = 1
  7672.     Do
  7673.         'While Mid$(in$, start, 1) = delimiter$
  7674.         While Mid$(in$, start, iDelimLen) = delimiter$
  7675.             'start = start + 1
  7676.             start = start + iDelimLen
  7677.             If start > Len(in$) Then
  7678.                 Exit Sub
  7679.             End If
  7680.         Wend
  7681.         finish = InStr(start, in$, delimiter$)
  7682.         If finish = 0 Then
  7683.             finish = Len(in$) + 1
  7684.         End If
  7685.  
  7686.         ReDim _Preserve result$(0 To UBound(result$) + 1)
  7687.  
  7688.         result$(UBound(result$)) = Mid$(in$, start, finish - start)
  7689.         start = finish + 1
  7690.     Loop While start <= Len(in$)
  7691. End Sub ' split
  7692.  
  7693. ' /////////////////////////////////////////////////////////////////////////////
  7694.  
  7695. Sub SplitTest
  7696.     Dim in$
  7697.     Dim delim$
  7698.     ReDim arrTest$(0)
  7699.     Dim iLoop%
  7700.  
  7701.     delim$ = Chr$(10)
  7702.     in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
  7703.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  7704.     Print "delim$ = " + Chr$(34) + delim$ + Chr$(34)
  7705.     split in$, delim$, arrTest$()
  7706.  
  7707.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  7708.         Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
  7709.     Next iLoop%
  7710.     Print
  7711.     Print "Split test finished."
  7712. End Sub ' SplitTest
  7713.  
  7714. ' /////////////////////////////////////////////////////////////////////////////
  7715.  
  7716. Sub SplitAndReplaceTest
  7717.     Dim in$
  7718.     Dim out$
  7719.     Dim iLoop%
  7720.     ReDim arrTest$(0)
  7721.  
  7722.     Print "-------------------------------------------------------------------------------"
  7723.     Print "SplitAndReplaceTest"
  7724.     Print
  7725.  
  7726.     Print "Original value"
  7727.     in$ = "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
  7728.     out$ = in$
  7729.     out$ = Replace$(out$, Chr$(13), "\r")
  7730.     out$ = Replace$(out$, Chr$(10), "\n")
  7731.     out$ = Replace$(out$, Chr$(9), "\t")
  7732.     Print "in$ = " + Chr$(34) + out$ + Chr$(34)
  7733.     Print
  7734.  
  7735.     Print "Fixing linebreaks..."
  7736.     in$ = Replace$(in$, Chr$(13) + Chr$(10), Chr$(13))
  7737.     in$ = Replace$(in$, Chr$(10), Chr$(13))
  7738.     out$ = in$
  7739.     out$ = Replace$(out$, Chr$(13), "\r")
  7740.     out$ = Replace$(out$, Chr$(10), "\n")
  7741.     out$ = Replace$(out$, Chr$(9), "\t")
  7742.     Print "in$ = " + Chr$(34) + out$ + Chr$(34)
  7743.     Print
  7744.  
  7745.     Print "Splitting up..."
  7746.     split in$, Chr$(13), arrTest$()
  7747.  
  7748.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  7749.         out$ = arrTest$(iLoop%)
  7750.         out$ = Replace$(out$, Chr$(13), "\r")
  7751.         out$ = Replace$(out$, Chr$(10), "\n")
  7752.         out$ = Replace$(out$, Chr$(9), "\t")
  7753.         Print "arrTest$(" + cstr$(iLoop%) + ") = " + Chr$(34) + out$ + Chr$(34)
  7754.     Next iLoop%
  7755.     Print
  7756.  
  7757.     Print "SplitAndReplaceTest finished."
  7758. End Sub ' SplitAndReplaceTest
  7759.  
  7760. ' /////////////////////////////////////////////////////////////////////////////
  7761.  
  7762. Sub WaitForEnter
  7763.     Dim in$
  7764.     Input "Press <ENTER> to continue", in$
  7765. End Sub ' WaitForEnter
  7766.  
  7767. ' /////////////////////////////////////////////////////////////////////////////
  7768. ' WaitForKey "Press <ESC> to continue", 27, 0
  7769. ' WaitForKey "Press <ENTER> to begin;", 13, 0
  7770. ' waitforkey "", 65, 5
  7771.  
  7772. Sub WaitForKey (prompt$, KeyCode&, DelaySeconds%)
  7773.     ' SHOW PROMPT (IF SPECIFIED)
  7774.     If Len(prompt$) > 0 Then
  7775.         If Right$(prompt$, 1) <> ";" Then
  7776.             Print prompt$
  7777.         Else
  7778.             Print Right$(prompt$, Len(prompt$) - 1);
  7779.         End If
  7780.     End If
  7781.  
  7782.     ' WAIT FOR KEY
  7783.     Do: Loop Until _KeyDown(KeyCode&) ' leave loop when specified key pressed
  7784.  
  7785.     ' PAUSE AFTER (IF SPECIFIED)
  7786.     If DelaySeconds% < 1 Then
  7787.         _KeyClear: '_DELAY 1
  7788.     Else
  7789.         _KeyClear: _Delay DelaySeconds%
  7790.     End If
  7791. End Sub ' WaitForKey
  7792.  
  7793. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7794. ' END GENERAL PURPOSE ROUTINES
  7795. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7796.  
  7797. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7798. ' BEGIN COLOR ROUTINES
  7799. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7800.  
  7801. ' /////////////////////////////////////////////////////////////////////////////
  7802. ' Receives:
  7803. ' cycleColor = determines how foreColor, backColor are modified
  7804. ' foreColor  = the foreground color
  7805. ' backColor  = the background color (if needed)
  7806.  
  7807. ' /////////////////////////////////////////////////////////////////////////////
  7808. ' DoCycleColor colorScheme%, myColor~&
  7809.  
  7810. ' colorScheme = color scheme (value is alternated on subsequent calls)
  7811. ' myColor     = the current color (value is incremented/decremented on subsequent calls)
  7812.  
  7813. ' colorScheme  values:
  7814. '  1 Rainbow6  #1
  7815. '  9 Rainbow6  #2
  7816. '  2 Rainbow18 #1
  7817. ' 10 Rainbow18 #2
  7818. '  3 Grayscale #1
  7819. ' 11 Grayscale #2
  7820. '  4 Grayscale #1
  7821. ' 12 Grayscale #2
  7822. ' 20 green6    #1
  7823. ' 21 green6    #2
  7824.  
  7825. Sub DoCycleColor (colorScheme As Integer, myColor As _Unsigned Long)
  7826.     ReDim ColorArray(-1) As _Unsigned Long
  7827.     Dim iPos As Integer
  7828.    
  7829.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
  7830.     ' CYCLE FORE COLOR
  7831.    
  7832.     ' 1, 9 = simple rainbow
  7833.     If colorScheme = 1 Or colorScheme = 9 Then
  7834.         Select Case myColor
  7835.             Case cRed:
  7836.                 myColor = cOrange
  7837.             Case cOrange:
  7838.                 myColor = cYellow
  7839.             Case cYellow:
  7840.                 myColor = cGreen
  7841.             Case cGreen:
  7842.                 myColor = cBlue
  7843.             Case cBlue:
  7844.                 myColor = cPurple
  7845.             Case Else:
  7846.                 myColor = cRed
  7847.         End Select
  7848.  
  7849.         ' 2, 10 = complex rainbow
  7850.     ElseIf colorScheme = 2 Or colorScheme = 10 Then
  7851.         Select Case myColor
  7852.             Case cRed:
  7853.                 myColor = cOrangeRed
  7854.             Case cOrangeRed:
  7855.                 myColor = cDarkOrange
  7856.             Case cDarkOrange:
  7857.                 myColor = cOrange
  7858.             Case cOrange:
  7859.                 myColor = cGold
  7860.             Case cGold:
  7861.                 myColor = cYellow
  7862.             Case cYellow:
  7863.                 myColor = cOliveDrab1
  7864.             Case cOliveDrab1:
  7865.                 myColor = cLime
  7866.             Case cLime:
  7867.                 myColor = cMediumSpringGreen
  7868.             Case cMediumSpringGreen:
  7869.                 myColor = cCyan
  7870.             Case cCyan:
  7871.                 myColor = cDeepSkyBlue
  7872.             Case cDeepSkyBlue:
  7873.                 myColor = cDodgerBlue
  7874.             Case cDodgerBlue:
  7875.                 myColor = cSeaBlue
  7876.             Case cSeaBlue:
  7877.                 myColor = cBlue
  7878.             Case cBlue:
  7879.                 myColor = cBluePurple
  7880.             Case cBluePurple:
  7881.                 myColor = cDeepPurple
  7882.             Case cDeepPurple:
  7883.                 myColor = cPurple
  7884.             Case cPurple:
  7885.                 myColor = cPurpleRed
  7886.             Case Else:
  7887.                 myColor = cRed
  7888.         End Select
  7889.  
  7890.         ' 3, 11 = grayscale, ascending
  7891.     ElseIf colorScheme = 3 Or colorScheme = 11 Then
  7892.         Select Case myColor
  7893.             Case cBlack:
  7894.                 myColor = cDarkGray
  7895.             Case cDarkGray:
  7896.                 myColor = cDimGray
  7897.             Case cDimGray:
  7898.                 myColor = cGray
  7899.             Case cGray:
  7900.                 myColor = cLightGray
  7901.             Case cLightGray:
  7902.                 myColor = cSilver
  7903.             Case cSilver:
  7904.                 myColor = cWhite
  7905.             Case Else:
  7906.                 'myColor = cBlack
  7907.                 myColor = cSilver
  7908.  
  7909.                 ' go in the other direction!
  7910.                 If colorScheme = 3 Then
  7911.                     colorScheme = 4
  7912.                 Else
  7913.                     colorScheme = 12
  7914.                 End If
  7915.  
  7916.         End Select
  7917.  
  7918.         ' 4, 8, 12 = grayscale, descending
  7919.     ElseIf colorScheme = 4 Or colorScheme = 12 Then
  7920.         Select Case myColor
  7921.             Case cWhite:
  7922.                 myColor = cSilver
  7923.             Case cSilver:
  7924.                 myColor = cLightGray
  7925.             Case cLightGray:
  7926.                 myColor = cGray
  7927.             Case cGray:
  7928.                 myColor = cDimGray
  7929.             Case cDimGray:
  7930.                 myColor = cDarkGray
  7931.             Case cDarkGray:
  7932.                 myColor = cBlack
  7933.             Case Else:
  7934.                 myColor = cDarkGray
  7935.  
  7936.                 ' go in the other direction!
  7937.                 If colorScheme = 4 Then
  7938.                     colorScheme = 3
  7939.                 Else
  7940.                     colorScheme = 11
  7941.                 End If
  7942.         End Select
  7943.    
  7944.    
  7945.    
  7946. 'yoda
  7947.     ' =============================================================================
  7948.     ' BEGIN GreenTreeColors 20,21
  7949.     ' =============================================================================
  7950.     ' 20 = GetGreenTreeColors ascending
  7951.     ElseIf colorScheme = 20 Then
  7952.         GetGreenTreeColors ColorArray()
  7953.         iPos = FindInColorArray%(ColorArray(), myColor, 0)
  7954.         if iPos < ubound(ColorArray) then
  7955.             myColor = ColorArray(iPos+1)
  7956.         else
  7957.             myColor = ColorArray(iPos-1)
  7958.             colorScheme = 21 ' go in the other direction!
  7959.         end if
  7960.     ' 21 = GetGreenTreeColors descending
  7961.     ElseIf colorScheme = 21 Then
  7962.         GetGreenTreeColors ColorArray()
  7963.         iPos = FindInColorArray%(ColorArray(), myColor, 0)
  7964.         if iPos > lbound(ColorArray) then
  7965.             myColor = ColorArray(iPos-1)
  7966.         else
  7967.             myColor = ColorArray(iPos+1)
  7968.             colorScheme = 20 ' go in the other direction!
  7969.         end if
  7970.     ' =============================================================================
  7971.     ' END GreenTreeColors 20,21
  7972.     ' =============================================================================
  7973.     End If
  7974.  
  7975. End Sub ' DoCycleColor
  7976.  
  7977. Function FindInColorArray%(ColorArray() As _Unsigned Long, iColor As _Unsigned Long, iDefaultIfNotFound As Integer)
  7978.     Dim iLoop As Integer
  7979.     Dim bFound As Integer : bFound = FALSE
  7980.     For iLoop = lbound(ColorArray) to ubound(ColorArray)
  7981.         if ColorArray(iLoop) = iColor then
  7982.             bFound = TRUE
  7983.             FindInColorArray% = iLoop
  7984.             Exit For
  7985.         end if
  7986.     Next iLoop
  7987.     If bFound = FALSE Then
  7988.         FindInColorArray% = iDefaultIfNotFound
  7989.     End If
  7990. End Function ' FindInColorArray
  7991.  
  7992. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7993. ' END COLOR ROUTINES
  7994. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7995.  
  7996. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7997. ' BEGIN COLOR FUNCTIONS
  7998. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  7999.  
  8000. ' NOTE: these are mostly negative numbers
  8001. '       and have to be forced to positive
  8002. '       when stored in the dictionary
  8003. '       (only cEmpty should be negative)
  8004.  
  8005. Function cRed~& ()
  8006.     cRed = _RGB32(255, 0, 0)
  8007.  
  8008. Function cOrangeRed~& ()
  8009.     cOrangeRed = _RGB32(255, 69, 0)
  8010. End Function ' cOrangeRed~&
  8011.  
  8012. Function cDarkOrange~& ()
  8013.     cDarkOrange = _RGB32(255, 140, 0)
  8014. End Function ' cDarkOrange~&
  8015.  
  8016. Function cOrange~& ()
  8017.     cOrange = _RGB32(255, 165, 0)
  8018. End Function ' cOrange~&
  8019.  
  8020. Function cGold~& ()
  8021.     cGold = _RGB32(255, 215, 0)
  8022. End Function ' cGold~&
  8023.  
  8024. Function cYellow~& ()
  8025.     cYellow = _RGB32(255, 255, 0)
  8026. End Function ' cYellow~&
  8027.  
  8028. ' LONG-HAIRED FRIENDS OF JESUS OR NOT,
  8029. ' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
  8030. ' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
  8031. Function cChartreuse~& ()
  8032.     cChartreuse = _RGB32(127, 255, 0)
  8033. End Function ' cChartreuse~&
  8034.  
  8035. ' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
  8036. Function cOliveDrab1~& ()
  8037.     cOliveDrab1 = _RGB32(192, 255, 62)
  8038. End Function ' cOliveDrab1~&
  8039.  
  8040. Function cLime~& ()
  8041.     cLime = _RGB32(0, 255, 0)
  8042. End Function ' cLime~&
  8043.  
  8044. Function cMediumSpringGreen~& ()
  8045.     cMediumSpringGreen = _RGB32(0, 250, 154)
  8046. End Function ' cMediumSpringGreen~&
  8047.  
  8048. Function cCyan~& ()
  8049.     cCyan = _RGB32(0, 255, 255)
  8050. End Function ' cCyan~&
  8051.  
  8052. Function cDeepSkyBlue~& ()
  8053.     cDeepSkyBlue = _RGB32(0, 191, 255)
  8054. End Function ' cDeepSkyBlue~&
  8055.  
  8056. Function cDodgerBlue~& ()
  8057.     cDodgerBlue = _RGB32(30, 144, 255)
  8058. End Function ' cDodgerBlue~&
  8059.  
  8060. Function cSeaBlue~& ()
  8061.     cSeaBlue = _RGB32(0, 64, 255)
  8062. End Function ' cSeaBlue~&
  8063.  
  8064. Function cBlue~& ()
  8065.     cBlue = _RGB32(0, 0, 255)
  8066. End Function ' cBlue~&
  8067.  
  8068. Function cBluePurple~& ()
  8069.     cBluePurple = _RGB32(64, 0, 255)
  8070. End Function ' cBluePurple~&
  8071.  
  8072. Function cDeepPurple~& ()
  8073.     cDeepPurple = _RGB32(96, 0, 255)
  8074. End Function ' cDeepPurple~&
  8075.  
  8076. Function cPurple~& ()
  8077.     cPurple = _RGB32(128, 0, 255)
  8078. End Function ' cPurple~&
  8079.  
  8080. Function cPurpleRed~& ()
  8081.     cPurpleRed = _RGB32(128, 0, 192)
  8082. End Function ' cPurpleRed~&
  8083.  
  8084. Function cDarkRed~& ()
  8085.     cDarkRed = _RGB32(160, 0, 64)
  8086. End Function ' cDarkRed~&
  8087.  
  8088. Function cBrickRed~& ()
  8089.     cBrickRed = _RGB32(192, 0, 32)
  8090. End Function ' cBrickRed~&
  8091.  
  8092. Function cDarkGreen~& ()
  8093.     cDarkGreen = _RGB32(0, 100, 0)
  8094. End Function ' cDarkGreen~&
  8095.  
  8096. Function cGreen~& ()
  8097.     cGreen = _RGB32(0, 128, 0)
  8098. End Function ' cGreen~&
  8099.  
  8100. Function cOliveDrab~& ()
  8101.     cOliveDrab = _RGB32(107, 142, 35)
  8102. End Function ' cOliveDrab~&
  8103.  
  8104. Function cLightPink~& ()
  8105.     cLightPink = _RGB32(255, 182, 193)
  8106. End Function ' cLightPink~&
  8107.  
  8108. Function cHotPink~& ()
  8109.     cHotPink = _RGB32(255, 105, 180)
  8110. End Function ' cHotPink~&
  8111.  
  8112. Function cDeepPink~& ()
  8113.     cDeepPink = _RGB32(255, 20, 147)
  8114. End Function ' cDeepPink~&
  8115.  
  8116. Function cMagenta~& ()
  8117.     cMagenta = _RGB32(255, 0, 255)
  8118. End Function ' cMagenta~&
  8119.  
  8120. Function cBlack~& ()
  8121.     cBlack = _RGB32(0, 0, 0)
  8122. End Function ' cBlack~&
  8123.  
  8124. Function cDimGray~& ()
  8125.     cDimGray = _RGB32(105, 105, 105)
  8126. End Function ' cDimGray~&
  8127.  
  8128. Function cGray~& ()
  8129.     cGray = _RGB32(128, 128, 128)
  8130. End Function ' cGray~&
  8131.  
  8132. Function cDarkGray~& ()
  8133.     cDarkGray = _RGB32(169, 169, 169)
  8134. End Function ' cDarkGray~&
  8135.  
  8136. Function cSilver~& ()
  8137.     cSilver = _RGB32(192, 192, 192)
  8138. End Function ' cSilver~&
  8139.  
  8140. Function cLightGray~& ()
  8141.     cLightGray = _RGB32(211, 211, 211)
  8142. End Function ' cLightGray~&
  8143.  
  8144. Function cGainsboro~& ()
  8145.     cGainsboro = _RGB32(220, 220, 220)
  8146. End Function ' cGainsboro~&
  8147.  
  8148. Function cWhiteSmoke~& ()
  8149.     cWhiteSmoke = _RGB32(245, 245, 245)
  8150. End Function ' cWhiteSmoke~&
  8151.  
  8152. Function cWhite~& ()
  8153.     cWhite = _RGB32(255, 255, 255)
  8154.     'cWhite = _RGB32(254, 254, 254)
  8155. End Function ' cWhite~&
  8156.  
  8157. Function cDarkBrown~& ()
  8158.     cDarkBrown = _RGB32(128, 64, 0)
  8159. End Function ' cDarkBrown~&
  8160.  
  8161. Function cLightBrown~& ()
  8162.     cLightBrown = _RGB32(196, 96, 0)
  8163. End Function ' cLightBrown~&
  8164.  
  8165. Function cKhaki~& ()
  8166.     cKhaki = _RGB32(240, 230, 140)
  8167. End Function ' cKhaki~&
  8168.  
  8169. Function cEmpty~& ()
  8170.     'cEmpty~& = -1
  8171.     cEmpty = _RGB32(0, 0, 0, 0)
  8172. End Function ' cEmpty~&
  8173.  
  8174. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8175. ' END COLOR FUNCTIONS
  8176. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8177.  
  8178. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8179. ' BEGIN CUSTOM COLOR FUNCTIONS
  8180. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8181.  
  8182. Sub GetGreenTreeColors ( ColorArray() As _Unsigned Long )
  8183.     ReDim ColorArray(-1) As _Unsigned Long
  8184.     AddColor ColorArray(), _RGB32(0, 71, 0)
  8185.     AddColor ColorArray(), _RGB32(0, 102, 0)
  8186.     AddColor ColorArray(), _RGB32(0, 153, 0)
  8187.     AddColor ColorArray(), _RGB32(0, 204, 0)
  8188.     AddColor ColorArray(), _RGB32(0, 255, 0)
  8189. End Sub ' GetGreenTreeColors
  8190.  
  8191. Sub AddColor (ColorArray() As _Unsigned Long, iColor As _Unsigned Long)
  8192.     ReDim _Preserve ColorArray(1 To UBound(ColorArray) + 1) As _Unsigned Long
  8193.     ColorArray(UBound(ColorArray)) = iColor
  8194. End Sub ' AddColor
  8195.  
  8196. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8197. ' END CUSTOM COLOR FUNCTIONS
  8198. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8199.  
  8200.  
  8201.  
  8202.  
  8203.  
  8204. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8205. ' BEGIN KEYBOARD CODE FUNCTIONS
  8206. ' NOTE: ALL CODES ARE FOR _BUTTON
  8207. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8208.  
  8209. Function KeyCode_CtrlLeft% ()
  8210.     KeyCode_CtrlLeft% = 30
  8211.  
  8212. Function KeyCode_CtrlRight% ()
  8213.     KeyCode_CtrlRight% = 286
  8214.  
  8215. Function KeyCode_Y% ()
  8216.     KeyCode_Y% = 22
  8217.  
  8218. Function KeyCode_Z% ()
  8219.     KeyCode_Z% = 45
  8220.  
  8221. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8222. ' END KEYBOARD CODE FUNCTIONS
  8223. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8224.  
  8225. ' #END
  8226. ' ################################################################################################################################################################
  8227.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: WIP: Isometric Demo re-revisited v3.02, more shape functions
« Reply #1 on: December 31, 2021, 07:28:52 pm »
Nice, Hey one of these days I am going to put panels on my cube drawing and give you some competition ;-))

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: WIP: Isometric Demo re-revisited v3.02, more shape functions
« Reply #2 on: January 02, 2022, 01:14:32 pm »
Nice, Hey one of these days I am going to put panels on my cube drawing and give you some competition ;-))

Ha! I actually would welcome someone programming a real 3D engine, to render a 3-Dimensional array of voxels at whatever camera angle, in isometric or first person. What I have is really just a bunch of experiments scotch taped together. The big problem it has, is rendering the whole X,Y,Z matrix gets slow the more points there are. Maybe some kind of ray tracing algorithm to identify and only draw the voxels that should be visible would speed it up? I'm not much of a math wizard, and these problems have been solved and improved on many times over by much smarter people than me. If there was a library or framework that we could just plug our 3-D array into and some parameters (perspective, camera angle, etc.) that would render it to the screen, that would make 3D so much easier... That goes double for VR apps!

« Last Edit: January 02, 2022, 01:26:02 pm by madscijr »