Author Topic: WIP: Isometric Demo re-revisited v2.90 (multi-simultaneous angles!)  (Read 3124 times)

0 Members and 1 Guest are viewing this topic.

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Another update, this one displays 4x split screen, each from a different angle!

https://www.qb64.org/forum/index.php?topic=4456.0
@madscijr
You should post in Programs in one thread as a work in progress. That way if amounts to something, and it should with continued progress, librarians have a single thread to reference. MasterGy is doing good job of that with "car simulator".
I wonder if you can make a Christmas tree of cubes or even a whole xmas scene?

Here is the latest, posted here in Programs per @bplus 's suggestion.

This is based on the Isometric Mapping Demo code from
https://www.qb64.org/forum/index.php?topic=1903.30

This version now lets you rotate the viewing angle
using the Insert/Delete keys (demo 3 from the menu).
* Maybe "rotate" isn't accurate, you can view from 6 different directions, though viewing from top/bottom angles are kind of screwy as the transparency for tiles that the player is hidden behind is messed up. I'll have to give that a look.
Also the viewing angle code isn't the most "optimized", I just do it the cheap & easy way by creating a copy of the array, but it works!

A future update will change the key mapping as you change the viewing angle, to be more intuitive. So the arrow keys would move the player on screen relative to the front viewing angle.
(Maybe I'll add an option to rotate the 2-D map accordingly when the viewing angle changes.)
For now, if you change the viewing angle, and find moving around to be confusing, just use the 2-D map as your reference to keep track of your movement.

I started a bigger overhaul to move to split screen for 1-4 players,
and added arrays and variables for that, but the demo isn't really using the mutiplayer
or split screen yet.

Finally @bplus , I'm working on some kind of Christmas-themed version. Stay tuned!

Hopefully someone will find this useful. Comments welcome!

Code: QB64: [Select]
  1. ' ################################################################################################################################################################
  2. ' Isomatric mapping demo re-revisited
  3. ' Version 2.90 by madscijr
  4.  
  5. ' Based on Isometric Mapping Demo
  6. ' by SMcNeill, bplus, and others at
  7. ' https://www.qb64.org/forum/index.php?topic=1903.30
  8.  
  9. ' This crude version uses a 3-dimensional array (32x32x32)
  10. ' to store cubes of different colors,
  11. ' and draws them to the screen in 2.5D "isometric".
  12.  
  13. ' -----------------------------------------------------------------------------
  14. ' DONE:
  15. ' * Render cubes that block the view of the player as transparent.
  16. ' * 2-D top down "map" view of the player's current Z slice.
  17. ' * variable grid size
  18. ' * change arrMap to global shared variable (for simpler code) & rename m_arrMap
  19. ' * allow player to rotate their view
  20. ' * preliminary multiplayer changes
  21. '   - move player info into array (upto 4 players)
  22. '   - key mapping variables
  23. ' * fixed some keyboard input (repeating keys, continuous motion)
  24. ' * fixed right point of view bug where x & y coordinates were reversed
  25. ' * preliminary multiplayer changes
  26. '   - split screen display (4, 6, or 8?)
  27. '     + for now display player 1's world rotated in each window (for editor)
  28. '       * x4: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
  29. '       * x6: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
  30. '       * x8: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, (none), (none)
  31. '     + will eventually be one per player
  32. ' * 2D minimap background = cKhaki&
  33. ' * , and . change minimap size
  34.  
  35. ' -----------------------------------------------------------------------------
  36. ' TO DO:
  37. ' * editor v1 = simple drawing program
  38. '   - add type RecordType to hold recording steps
  39. '   - add array m_arrRecord of RecordType to hold recording
  40. '   - display available tiles/colors/etc. at bottom of screen
  41. '     + 40 colors including empty
  42. '     + 07 tiles (empty, floor, wall)
  43. '   - cursor places tiles (ENTER = add/delete at current space)
  44. '   - 0-9 keys cycle through tiles/colors
  45. '   - save screens to file (stored as editable text)
  46. '     + FORMAT: [tile=t][color@x,y,z][color@x,y,z][color@x,y,z]...
  47. '   - load screens into array m_arrRecord
  48. '     + PARSER:
  49. '       1. replace all ][ with [
  50. '       2. split by "[" into simple 1D array
  51. '       3. each element is either "tile=t" or "plot=color@x,y,z"
  52. '       4. parse data into array to playback recording
  53. '          [n][0] = command
  54. '                   -1 = select tile "tile=t"
  55. '                   0+ = color to plot "color@x,y,z"
  56. '          [n][1] = parameter #1 = tile
  57. '          [n][2] = parameter #2 = x
  58. '          [n][3] = parameter #3 = y
  59. '          [n][3] = parameter #4 = z
  60. '   - run commands in m_arrRecord to plot tiles and display
  61. ' * rotating view changes orientation of keys (get it working)
  62.  
  63. ' -----------------------------------------------------------------------------
  64. ' * add parameters to tiles
  65. ' * - color scheme (for cycle colors)
  66.  
  67. ' * add tiles
  68. '   - transparent lights (blinking / cycle colors)
  69. '   - gravity tiles (fall if no tiles underneath)
  70.  
  71. ' * editor v2 = simple animation program
  72. '   - records cursor movements and adding/deleting tiles
  73. '   - press key to record a "frame"
  74. '     + flash screen + play a sound
  75. '   - can change animation speed
  76. '   - realtime=on command enables redrawing screen every step (until realtime=off command encountered)
  77. '   - playback mode recreates editing actions
  78. '   - playback updates screen every "update"
  79. '   - tweak save format (still editable text)
  80. '     + FORMAT: [cls][rotate=d][speed=n][tile=t][color@x,y,z][tile=t][color@x,y,z][update][tile=t][color@x,y,z][realtime=on][tile=t][color@x,y,z]...
  81. '     + PARSER:
  82. '       1. replace all ][ with [
  83. '       2. split by "[" into simple 1D array
  84. '       3. each element is either "color@x,y,z", "tile=t", "cls", "update", "speed=s", "realtime=on", "realtime=off", "rotate=d"
  85. '       4. parse array into array of LONG for playback
  86. '          [n].Command
  87. '                   -7 = rotate point of view (up, down, left, right, back, forward) "rotate=d"
  88. '                   -6 = disable screen update every step "realtime=off"
  89. '                   -5 = enable screen update every step "realtime=on"
  90. '                   -4 = set speed "speed=s"
  91. '                   -3 = update screen "update"
  92. '                   -2 = clear screen "cls"
  93. '                   -1 = select tile "tile=t"
  94. '                   0+ = color to plot "color@x,y,z"
  95. '          [n].Param1 = parameter #1 = tile, speed, direction
  96. '          [n].Param2 = parameter #2 = x
  97. '          [n].Param3 = parameter #3 = y
  98. '          [n].Param4 = parameter #4 = z
  99. '   - effects of gravity (from bottom up, ie z=0 to z=max)
  100.  
  101. ' -----------------------------------------------------------------------------
  102. ' * expand world to bigger than screen (2.5d scrolling view)
  103.  
  104. ' * editor v3 = mouse
  105. '   - mouse movement controls cursor x,y position
  106. '   - mouse wheel controls z position
  107. '   - left click draws a tile
  108. '   - right click erases a tile
  109. '   - ENTER records a frame
  110. '   - Add animation playback command:
  111. '          [n][0] = command
  112. '                   -8 = enable user to rotate image in realtime with mouse? "mouse=on"
  113.  
  114. ' -----------------------------------------------------------------------------
  115. ' TO DO (LATER):
  116. ' * local multiplayer (2-4 players)
  117. '   - split screen (x2 or x4)
  118.  
  119. ' * fix/control screen placement/rendering/scroll boundaries for grid sizes
  120. '   (to not overwrite other players, go off screen, etc., when grid size changes)
  121.  
  122. ' * auto-rotate view depending on direction player is facing
  123.  
  124. ' * control the x/y/z slice axis, for a cutaway view
  125.  
  126. ' * gravity (players stay on ground, can fall)
  127. ' * player can climb up to next level if it is 1 tile higher
  128. ' * add ability to jump over 1 space
  129.  
  130. ' * option to remap keys
  131. ' * support game controllers
  132. ' * game controller calibration/mapping function
  133.  
  134. ' * option to hide objects out of player's line-of-sight
  135.  
  136. ' * show player as a stick figure (like "Realm of Impossibility")
  137. ' * walking movement
  138.  
  139. ' * add tiles (water, ladders, steps, ropes, windows, doors, etc.)
  140. ' * add toggle tiles - door "opens" when triggered
  141. ' * triggers
  142. ' * add tiles
  143. '   - Water = transparent blue)
  144. '   - Window = more transparent cyan)
  145.  
  146. ' * add directional tiles (can be rotated?)
  147. '   - ladder
  148. '   - bridge
  149. '   - hand-over-hand bars?
  150. '   - Slope45 = 45° slope <- 4 or 6 directions?
  151. '   - InvSlope45 = 45° inverted slope <- 4 or 6 directions?
  152. '   - Pyramid45 = 45° pyramid "cap stone" <- 4 or 6 directions?
  153. '   - ramp (player can walk up/down slope45)
  154.  
  155. ' * add ability to climb ladders + climbing animation
  156. ' * add ability to walk up ramps with smooth z-movement inbetween tiles
  157. ' * add ability to climb monkey bars (animation like lode runner)
  158.  
  159. ' * simultaneously show additional 1st person view
  160. ' * add ability for tilting head up/down in first person
  161.  
  162. ' * simple open world (players can add/remove tiles, build in real time)
  163. ' * make simple games (maze craze, capture the flag, snake, surround, 2.5d pong)
  164. ' * make more complex games (berzerk, lode runner, atari combat / tank)
  165. ' * make awesome complex games (2.5d lunar lander, atari adventure, asteroids, gravitar, etc.)
  166. ' * text adventure features (to create graphic Infocom or Scott Adams style games)
  167.  
  168. ' ################################################################################################################################################################
  169.  
  170. ' =============================================================================
  171. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
  172. ' div: int1% = num1% \ den1%
  173. ' mod: rem1% = num1% MOD den1%
  174.  
  175. ' -----------------------------------------------------------------------------
  176. ' boolean constants
  177. ' -----------------------------------------------------------------------------
  178. Const FALSE = 0
  179. Const TRUE = Not FALSE
  180.  
  181. ' -----------------------------------------------------------------------------
  182. ' KeyDownConstants
  183. ' -----------------------------------------------------------------------------
  184. Const c_iKeyDown_Esc = 27
  185. Const c_iKeyDown_F1 = 15104
  186. Const c_iKeyDown_F2 = 15360
  187. Const c_iKeyDown_F3 = 15616
  188. Const c_iKeyDown_F4 = 15872
  189. Const c_iKeyDown_F5 = 16128
  190. Const c_iKeyDown_F6 = 16384
  191. Const c_iKeyDown_F7 = 16640
  192. Const c_iKeyDown_F8 = 16896
  193. Const c_iKeyDown_F9 = 17152
  194. Const c_iKeyDown_F10 = 17408
  195. Const c_iKeyDown_Tilde = 96
  196. Const c_iKeyDown_1 = 49
  197. Const c_iKeyDown_2 = 50
  198. Const c_iKeyDown_3 = 51
  199. Const c_iKeyDown_4 = 52
  200. Const c_iKeyDown_5 = 53
  201. Const c_iKeyDown_6 = 54
  202. Const c_iKeyDown_7 = 55
  203. Const c_iKeyDown_8 = 56
  204. Const c_iKeyDown_9 = 57
  205. Const c_iKeyDown_0 = 48
  206. Const c_iKeyDown_Minus = 45
  207. Const c_iKeyDown_EqualPlus = 61
  208. Const c_iKeyDown_BkSp = 8
  209. Const c_iKeyDown_Ins = 20992
  210. Const c_iKeyDown_Home = 18176
  211. Const c_iKeyDown_PgUp = 18688
  212. Const c_iKeyDown_Del = 21248
  213. Const c_iKeyDown_End = 20224
  214. Const c_iKeyDown_PgDn = 20736
  215. Const c_iKeyDown_KEYPAD_7_Home = 18176
  216. Const c_iKeyDown_KEYPAD_8_Up = 18432
  217. Const c_iKeyDown_KEYPAD_9_PgUp = 18688
  218. Const c_iKeyDown_KEYPAD_4_Left = 19200
  219. Const c_iKeyDown_KEYPAD_6_Right = 19712
  220. Const c_iKeyDown_KEYPAD_1_End = 20224
  221. Const c_iKeyDown_KEYPAD_2_Down = 20480
  222. Const c_iKeyDown_KEYPAD_3_PgDn = 20736
  223. Const c_iKeyDown_KEYPAD_0_Ins = 20992
  224. Const c_iKeyDown_KEYPAD_Period_Del = 21248
  225. Const c_iKeyDown_Tab = 9
  226. Const c_iKeyDown_Q = 113
  227. Const c_iKeyDown_W = 119
  228. Const c_iKeyDown_E = 101
  229. Const c_iKeyDown_R = 114
  230. Const c_iKeyDown_T = 116
  231. Const c_iKeyDown_Y = 121
  232. Const c_iKeyDown_U = 117
  233. Const c_iKeyDown_Pipe = 105
  234. Const c_iKeyDown_O = 111
  235. Const c_iKeyDown_P = 112
  236. Const c_iKeyDown_BracketLeft = 91
  237. Const c_iKeyDown_BracketRight = 93
  238. Const c_iKeyDown_Backslash = 92
  239. Const c_iKeyDown_A = 97
  240. Const c_iKeyDown_S = 115
  241. Const c_iKeyDown_D = 100
  242. Const c_iKeyDown_F = 102
  243. Const c_iKeyDown_G = 103
  244. Const c_iKeyDown_H = 104
  245. Const c_iKeyDown_J = 106
  246. Const c_iKeyDown_K = 107
  247. Const c_iKeyDown_L = 108
  248. Const c_iKeyDown_SemiColon = 59
  249. Const c_iKeyDown_Apostrophe = 39
  250. Const c_iKeyDown_Enter = 13
  251. Const c_iKeyDown_Z = 22
  252. Const c_iKeyDown_X = 120
  253. Const c_iKeyDown_C = 99
  254. Const c_iKeyDown_V = 118
  255. Const c_iKeyDown_B = 98
  256. Const c_iKeyDown_N = 110
  257. Const c_iKeyDown_M = 109
  258. Const c_iKeyDown_Comma = 44
  259. Const c_iKeyDown_Period = 46
  260. Const c_iKeyDown_Slash = 47
  261. Const c_iKeyDown_Up = 18432
  262. Const c_iKeyDown_Left = 19200
  263. Const c_iKeyDown_Down = 20480
  264. Const c_iKeyDown_Right = 19712
  265. Const c_iKeyDown_Spacebar = 32
  266.  
  267. ' -----------------------------------------------------------------------------
  268. ' Tile value constants for map (MapTileType.Typ)
  269. ' -----------------------------------------------------------------------------
  270. Const c_iMapType_Empty = 0
  271. Const c_iMapType_Floor_Tiled = 1
  272. Const c_iMapType_Wall = 2
  273. Const c_iMapType_Water = 3
  274. Const c_iMapType_Window = 4
  275. Const c_iMapType_Player1 = 5
  276. Const c_iMapType_Player2 = 6
  277. Const c_iMapType_Player3 = 7
  278. Const c_iMapType_Player4 = 8
  279. Const c_iMapType_Blinking_Light = 9
  280. Const c_iMapType_Gravity_Tile = 10
  281. Const c_iMapType_Slope45 = 11
  282. Const c_iMapType_InvSlope45 = 12
  283.  
  284. ' -----------------------------------------------------------------------------
  285. ' constants for 2.5D movement
  286. ' -----------------------------------------------------------------------------
  287. Const c_iDir_Down = 1
  288. Const c_iDir_Up = 2
  289. Const c_iDir_Left = 3
  290. Const c_iDir_Right = 4
  291. Const c_iDir_Back = 5
  292. Const c_iDir_Forward = 6
  293. Const c_iDir_Min = 1
  294. Const c_iDir_Max = 6
  295.  
  296. ' -----------------------------------------------------------------------------
  297. ' constants for drawing the 2.5D screen
  298. ' -----------------------------------------------------------------------------
  299. Const cGridOffsetX = 50
  300. Const cGridOffsetY = 50
  301. Const cGridOffsetZ = 0
  302. Const cScreenOffsetX = 500 ' 450
  303. Const cScreenOffsetY = 300 ' 50
  304. Const cScreenOffsetZ = 0
  305.  
  306. ' =============================================================================
  307. ' USER DEFINED TYPES
  308. ' =============================================================================
  309. Type MapTileType
  310.     Typ As Integer ' c_iMapType_Empty, c_iMap_Floor_Tiled, c_iMap_Wall, etc.
  311.     'Vis As Integer ' TRUE = visible, FALSE = don't render
  312.     'Lit As Long ' light offset
  313.     Color1 As Long ' main color
  314.     Color2 As Long ' secondary color if needed
  315.     Color3 As Long ' third color if needed
  316.     Alpha1 As Long ' transparency of tile Color1
  317.     Alpha2 As Long ' transparency of tile Color2
  318.     Alpha3 As Long ' transparency of tile Color3
  319.     AlphaOverride As Integer ' can be used to override alpha (0 treated as opaque)
  320. End Type ' MapTileType
  321.  
  322. Type RecordType
  323.     Command As Integer
  324.     Param1 As Integer
  325.     Param2 As Integer
  326.     Param3 As Integer
  327.     Param4 As Integer
  328. End Type ' RecordType
  329.  
  330. ' UDT TO HOLD THE INFO FOR A PLAYER
  331. TYPE PlayerType
  332.     IsEnabled AS Integer ' TRUE or FALSE
  333.     x AS Integer ' player x position
  334.     y AS Integer ' player y position
  335.     z AS Integer ' player z position
  336.     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
  337.     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
  338.     Tile1 As Long ' later we will instead use directional animation sequences
  339.    
  340.     Color1 As Long ' main color
  341.     'Color2 As Long ' secondary color if needed
  342.     'Color3 As Long ' third color if needed    
  343.    
  344.     Alpha1 As Long ' transparency of player Color1
  345.     'Alpha2 As Long ' transparency of player Color2
  346.     'Alpha3 As Long ' transparency of player Color3
  347.    
  348.     ColorScheme1 As Long ' for cycling colors
  349.     ColorSchemeSpeed1 As Long
  350.     ColorSchemeCount1 As Long
  351.    
  352.     'ColorScheme2 As Long ' for cycling colors
  353.     'ColorSchemeSpeed2 As Long
  354.     'ColorSchemeCount2 As Long
  355.    
  356.     'ColorScheme3 As Long ' for cycling colors
  357.     'ColorSchemeSpeed3 As Long
  358.     'ColorSchemeCount3 As Long
  359.    
  360.     AlphaOverride As Integer ' can be used to override alpha (0 treated as opaque)
  361.    
  362.     IsMoving As Integer ' TRUE/FALSE
  363.     IsMoved As Integer ' TRUE/FALSE
  364.    
  365.         GridSize As Integer
  366.         MapSize As Integer
  367.        
  368.     'hx AS Integer ' home base x position
  369.     'hy AS Integer ' home base y position
  370.     'ex AS Integer ' exit x position
  371.     'ey AS Integer ' exit y position
  372.     'wins AS Integer ' count # of wins
  373.     'points AS Long ' count points (more points for harder)
  374.     'difficulty AS Integer ' 1-5, from 1 (easiest, maze width 5) to 5 (hardest, maze width 1). Each win awards {difficulty} # of points.
  375.     'speed AS Integer ' the higher the faster
  376.     'delay AS Integer ' counter, player can move based on speed
  377.     'bit AS Integer ' bit value for masking player in map
  378.     'rows AS Integer ' # of rows in player's maze
  379.     'cols AS Integer ' # of columns in player's maze
  380. END TYPE ' PlayerType
  381.  
  382. ' KEY MAPPING v1
  383. ' UDT TO HOLD THE KEY MAPPINGS
  384. TYPE DirKeyMapType
  385.     KeyBack As Long
  386.     KeyForward As Long
  387.     KeyLeft As Long
  388.     KeyRight As Long
  389.     KeyUp As Long
  390.     KeyDown As Long
  391. END TYPE ' DirKeyMapType
  392.  
  393. ' SPLIT SCREEN OFFSETS
  394. TYPE SplitScreenType
  395.     GridOffsetX As Integer
  396.     GridOffsetY As Integer
  397.     GridOffsetZ As Integer
  398.     ScreenOffsetX As Integer
  399.     ScreenOffsetY As Integer
  400.     ScreenOffsetZ As Integer
  401. END TYPE ' SplitScreenType
  402.  
  403. ' =============================================================================
  404. ' GLOBAL VARIABLES
  405. Dim Shared m_ProgramPath$ : m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
  406. Dim Shared m_ProgramName$ : m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
  407. Dim Shared m_iGridSize As Integer : m_iGridSize = 8 ' 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 = 32
  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 = 32
  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 = 32
  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.  
  424. ' Max # tiles in (32x32x32) world = 32,768
  425. ' Max # tiles for 16 (32x32x32) worlds = 524,288
  426. ' Max # tiles for 256 (32x32x32) worlds = 8,388,608
  427. Dim Shared m_iRecordMin As Long : m_iRecordMin = 0
  428. Dim Shared m_iRecordMax As Long : m_iRecordMax = 524288
  429.  
  430. Dim Shared m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  431. Dim Shared m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  432. Dim Shared m_arrPlayer(m_iPlayerMin To m_iPlayerMax) As PlayerType
  433. Dim Shared m_arrRecord(m_iRecordMin To m_iRecordMax) As RecordType
  434.  
  435. ' For each player, map the 6 directional keys differently for each of the 6 directional orientations!
  436. Dim Shared m_arrDirKeyMap(m_iPlayerMin To m_iPlayerMax, c_iDir_Min To c_iDir_Max) As DirKeyMapType
  437.  
  438. ' Store offsets for splitscreen
  439. Dim Shared m_arrSplitScreen(m_iPlayerMin To m_iPlayerMax) As SplitScreenType
  440.  
  441. ' =============================================================================
  442. ' LOCAL VARIABLES
  443. Dim in$
  444.  
  445. ' ****************************************************************************************************************************************************************
  446. ' ACTIVATE DEBUGGING WINDOW
  447. _Echo "Started " + m_ProgramName$
  448. _Echo "Debugging on..."
  449. ' ****************************************************************************************************************************************************************
  450.  
  451. ' =============================================================================
  452. ' START THE MAIN ROUTINE
  453. main
  454.  
  455. ' =============================================================================
  456. ' FINISH
  457. System ' return control to the operating system
  458. Print m_ProgramName$ + " finished."
  459. Input "Press <ENTER> to continue", in$
  460.  
  461. ' ****************************************************************************************************************************************************************
  462. ' DEACTIVATE DEBUGGING WINDOW
  463. ' ****************************************************************************************************************************************************************
  464.  
  465.  
  466. ' /////////////////////////////////////////////////////////////////////////////
  467.  
  468. Sub main
  469.     Dim RoutineName as String : RoutineName = "main"
  470.     Dim in$
  471.     Dim result$
  472.    
  473.     Screen 0
  474.  
  475.     Do
  476.         Cls
  477.         Print m_ProgramName$
  478.         Print
  479.         Print "Isomatric Mapping Demo Re-visited"
  480.         Print "v2.90, by Softintheheadware (Dec, 2021)"
  481.         Print
  482.         'PRINT "CONTROLS: PRESS <ESC> TO RETURN TO MENU"
  483.         'PRINT "PLAYER  LEFT       RIGHT       UP        DOWN       "
  484.         'PRINT "1       CRSR LEFT  CRSR RIGHT  CRSR UP   CRSR DOWN  "
  485.         'PRINT "2       KEYPAD 4   KEYPAD 6    KEYPAD 8  KEYPAD 2   "
  486.         'PRINT "3       A          S           W         Z          "
  487.         'PRINT "4       J          K           I         M          "
  488.         'PRINT
  489.  
  490.         Print "1. IsometricDemo1"
  491.         Print "2. IsometricDemo2"
  492.         Print "3. Move around in 2.5D"
  493.         Print
  494.         Print "What to do? ('q' to exit)"
  495.  
  496.         Input in$: in$ = LCase$(Left$(in$, 1))
  497.  
  498.         If in$ = "1" Then
  499.             result$ = IsometricDemo1
  500.         ElseIf in$ = "2" Then
  501.             result$ = IsometricDemo2
  502.         ElseIf in$ = "3" Then
  503.             result$ = IsometricDemo3
  504.         End If
  505.        
  506.         If LEN(result$) > 0 Then
  507.             PRINT result$
  508.         End If
  509.        
  510.     Loop Until in$ = "q"
  511. End Sub ' main
  512.  
  513. ' /////////////////////////////////////////////////////////////////////////////
  514.  
  515. Function IsometricDemo1$
  516.     Dim RoutineName As String: RoutineName = "IsometricDemo1"
  517.     Dim sResult AS String : sResult = ""
  518.     Dim iGridSize As Integer
  519.         Dim iX%
  520.     Dim iY%
  521.     Dim iZ%
  522.     Dim iNextX%
  523.     Dim iNextY%
  524.     Dim iNextZ%
  525.     Dim iPosX1%
  526.     Dim iPosX2%
  527.     Dim iPosY1%
  528.     Dim iPosY2%
  529.     Dim iLoopX%
  530.     Dim iLoopY%
  531.     Dim iLoopZ%
  532.     Dim iNextColor&
  533.     Dim iColorScheme%
  534.     Dim bContinue As Integer
  535.     Dim iDirection%
  536.     Dim bFinished As Integer
  537.     Dim iCount%
  538.     Dim iOpen%
  539.     Dim iMove%
  540.     Dim iSegmentLength%
  541.     Dim iMaxLength%
  542.     Dim bFirst As Integer
  543.     Dim bQuit As Integer
  544.     Dim in$
  545.    
  546.     ' INITIALIZE
  547.     'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
  548.     Screen _NewImage(1280, 1024, 32) : _ScreenMove 0,0
  549.        
  550.     iGridSize = 10
  551.        
  552.     ' =============================================================================
  553.     ' MAIN LOOP
  554.     bQuit = FALSE
  555.     Do
  556.         Cls
  557.  
  558.         ' -----------------------------------------------------------------------------
  559.         ' INITIALIZE MAP TO EMPTY
  560.         ClearIsometricMap
  561.        
  562.         ' -----------------------------------------------------------------------------
  563.         ' DRAW FLOOR
  564.         iZ% = m_iMapMinZ
  565.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  566.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  567.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Floor_Tiled
  568.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = cGray&
  569.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color2 = cLightGray&
  570.             Next iLoopY%
  571.         Next iLoopX%
  572.        
  573.         ' -----------------------------------------------------------------------------
  574.         ' DRAW TILES TO CHECK ORIENTATION
  575.        
  576.         FOR iLoopZ% = m_iMapMinZ + 1 TO m_iMapMaxZ
  577.             m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
  578.             m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
  579.            
  580.             m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
  581.             m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
  582.            
  583.             m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
  584.             m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
  585.            
  586.             'm_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
  587.             'm_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
  588.            
  589.             'm_arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
  590.             'm_arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Color1 = cOrange&
  591.             '
  592.             'm_arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
  593.             'm_arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Color1 = cPurple&
  594.             '
  595.             'm_arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
  596.             'm_arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Color1 = cLime&
  597.             '
  598.             'm_arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
  599.             'm_arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Color1 = cCyan&
  600.         NEXT iLoopZ%
  601.        
  602.         ' -----------------------------------------------------------------------------
  603.         ' DRAW SOME OBJECTS
  604.         If TRUE = TRUE Then
  605.             iX% = 16
  606.             iY% = 3
  607.            
  608.             iNextColor& = cRed&
  609.             iLoopZ% = 1
  610.             iLoopY% = iY%
  611.             For iLoopX% = iX% To (iX% + 10)
  612.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
  613.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
  614.             Next iLoopX%
  615.            
  616.             iNextColor& = cBlue&
  617.             iLoopZ% = 1
  618.             iLoopY% = iY% + 8
  619.             For iLoopX% = iX% To (iX% + 10)
  620.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
  621.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
  622.             Next iLoopX%
  623.            
  624.             iNextColor& = cGreen&
  625.             iLoopZ% = 1
  626.             iLoopX% = iX% + 1
  627.             For iLoopY% = (iY% + 1) To (iY% + 7)
  628.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
  629.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
  630.             Next iLoopY%
  631.            
  632.             iNextColor& = cYellow&
  633.             iLoopZ% = 1
  634.             iLoopX% = iX% + 9
  635.             For iLoopY% = (iY% + 1) To (iY% + 7)
  636.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
  637.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
  638.             Next iLoopY%
  639.         End If
  640.        
  641.         ' -----------------------------------------------------------------------------
  642.         ' DRAW A PYRAMID
  643.         If TRUE = TRUE Then
  644.             iX% = 2
  645.             iY% = 18
  646.             iZ% = 1
  647.             iPosX1% = iX%
  648.             iPosX2% = iX% + 10
  649.             iPosY1% = iY%
  650.             iPosY2% = iY% + 10
  651.             iNextColor& = cRed&
  652.             iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
  653.            
  654.             bContinue = TRUE
  655.             Do
  656.                 ' PLOT NEXT LEVEL
  657.                 For iLoopX% = iPosX1% To iPosX2%
  658.                     For iLoopY% = iPosY1% To iPosY2%
  659.                         m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  660.                         m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  661.                     Next iLoopY%
  662.                 Next iLoopX%
  663.                
  664.                 ' MOVE UP A LEVEL
  665.                 iPosX1% = iPosX1% + 1
  666.                 iPosX2% = iPosX2% - 1
  667.                 iPosY1% = iPosY1% + 1
  668.                 iPosY2% = iPosY2% - 1
  669.                 DoCycleColor iColorScheme%, iNextColor&
  670.                
  671.                 ' QUIT AFTER WE REACH THE TOP
  672.                 If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
  673.                     iZ% = iZ% + 1
  674.                 Else
  675.                     bContinue = FALSE
  676.                 End If
  677.                
  678.             Loop Until bContinue = FALSE
  679.         End If
  680.  
  681.         ' -----------------------------------------------------------------------------
  682.         ' DRAW PIPES
  683.         If TRUE = TRUE Then
  684.             ' START POSITION
  685.             iX% = m_iMapMaxX ' 30 ' RandomNumber%(0, 32)
  686.             iY% = m_iMapMaxY ' 28 ' RandomNumber%(0, 32)
  687.             iZ% = 1 ' 32
  688.            
  689.             ' LENGTH OF PIPES
  690.             iSegmentLength% = 4
  691.             iMaxLength% = 64
  692.            
  693.             ' START COLOR + DEFINE HOW COLOR CHANGES
  694.             iNextColor& = cRed&
  695.             iColorScheme% = 2 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
  696.            
  697.             ' INITIALIZE
  698.             bFirst = TRUE
  699.             iCount% = 0
  700.             iMove% = 0
  701.             bFinished = FALSE
  702.             Do
  703.                 iNextX% = iX%
  704.                 iNextY% = iY%
  705.                 iNextZ% = iZ%
  706.                
  707.                 ' CHANGE DIRECTION EVERY iSegmentLength% SPACES
  708.                 iMove% = iMove% + 1
  709.                 If iMove% > iSegmentLength% Then
  710.                     iMove% = 0
  711.                    
  712.                     ' PICK A DIRECTION
  713.                     If bFirst = TRUE Then
  714.                         ' MOVE UP FOR FIRST MOVE
  715.                         iDirection% = c_iDir_Up
  716.                         bFirst = FALSE
  717.                     Else
  718.                         ' PICK A RANDOM DIRECTION
  719.                         iDirection% = RandomNumber(c_iDir_Min, c_iDir_Max)
  720.                     End If
  721.                 End If
  722.                
  723.                 Select Case iDirection%
  724.                     Case c_iDir_Down:
  725.                         If iNextZ% > 0 Then
  726.                             iNextZ% = iNextZ% - 1
  727.                         End If
  728.                     Case c_iDir_Up:
  729.                         If iNextZ% < 32 Then
  730.                             iNextZ% = iNextZ% + 1
  731.                         End If
  732.                     Case c_iDir_Left:
  733.                         If iNextX% > 0 Then
  734.                             iNextX% = iNextX% - 1
  735.                         End If
  736.                     Case c_iDir_Right:
  737.                         If iNextX% < 32 Then
  738.                             iNextX% = iNextX% + 1
  739.                         End If
  740.                     Case c_iDir_Back:
  741.                         If iNextY% > 0 Then
  742.                             iNextY% = iNextY% - 1
  743.                         End If
  744.                     Case Else: ' c_iDir_Forward
  745.                         If iNextY% < 32 Then
  746.                             iNextY% = iNextY% + 1
  747.                         End If
  748.                 End Select
  749.                
  750.                 ' CHECK IF NEXT SPACE IS EMPTY
  751.                 If m_arrMap(iNextX%, iNextY%, iNextZ%).Typ = c_iMapType_Empty Then
  752.                     ' SPACE IS EMPTY
  753.                     ' DRAW HERE
  754.                    
  755.                     iCount% = iCount% + 1
  756.                     iX% = iNextX%
  757.                     iY% = iNextY%
  758.                     iZ% = iNextZ%
  759.                    
  760.                     ' GET NEXT COLOR AND DRAW TILE
  761.                     DoCycleColor iColorScheme%, iNextColor&
  762.                     m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
  763.                     m_arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
  764.                    
  765.                     ' HAVE WE PLACED MAX # OF TILES?
  766.                     If iCount% > iMaxLength% Then
  767.                         bFinished = TRUE
  768.                     End If
  769.                 Else                    
  770.                     ' SPACE IS OCCUPIED
  771.                     ' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
  772.                     iOpen% = 0
  773.                     If iZ% > 0 Then
  774.                         If m_arrMap(iX%, iY%, iZ% - 1).Typ = c_iMapType_Empty Then
  775.                             iOpen% = iOpen% + 1
  776.                         End If
  777.                     End If
  778.                     If iZ% < 32 Then
  779.                         If m_arrMap(iX%, iY%, iZ% + 1).Typ = c_iMapType_Empty Then
  780.                             iOpen% = iOpen% + 1
  781.                         End If
  782.                     End If
  783.                     If iX% > 0 Then
  784.                         If m_arrMap(iX% - 1, iY%, iZ%).Typ = c_iMapType_Empty Then
  785.                             iOpen% = iOpen% + 1
  786.                         End If
  787.                     End If
  788.                     If iX% < 32 Then
  789.                         If m_arrMap(iX% + 1, iY%, iZ%).Typ = c_iMapType_Empty Then
  790.                             iOpen% = iOpen% + 1
  791.                         End If
  792.                     End If
  793.                     If iY% > 0 Then
  794.                         If m_arrMap(iX%, iY% - 1, iZ%).Typ = c_iMapType_Empty Then
  795.                             iOpen% = iOpen% + 1
  796.                         End If
  797.                     End If
  798.                     If iY% < 32 Then
  799.                         If m_arrMap(iX%, iY% + 1, iZ%).Typ = c_iMapType_Empty Then
  800.                             iOpen% = iOpen% + 1
  801.                         End If
  802.                     End If
  803.                    
  804.                     ' QUIT IF NO OPEN SPACES AVAILABLE
  805.                     If iOpen% = 0 Then
  806.                         ' NOWHERE TO GO, EXIT
  807.                         bFinished = TRUE
  808.                     End If
  809.                 End If
  810.                
  811.             Loop Until bFinished = TRUE
  812.         End If
  813.  
  814.         ' PLOT GRAPHICS TO SCREEN
  815.         'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY
  816.         'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, 0, 0, 0
  817.         DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, iGridSize, 0, 0, 0
  818.                
  819.         Input "PRESS <ENTER> TO DRAW ANOTHER, OR 'Q' TO QUIT? ", in$
  820.        
  821.         If LCase$(in$) = LCase$("q") Then
  822.             bQuit = TRUE
  823.         End If
  824.        
  825.     Loop Until bQuit = TRUE
  826.    
  827.     Screen 0
  828.    
  829.     IsometricDemo1 = sResult
  830. End Sub ' IsometricDemo1
  831.  
  832. ' /////////////////////////////////////////////////////////////////////////////
  833.  
  834. Function IsometricDemo2$
  835.     Dim RoutineName As String: RoutineName = "IsometricDemo2"
  836.     Dim sResult AS String : sResult = ""
  837.         Dim iGridSize As Integer
  838.     Dim iX%
  839.     Dim iY%
  840.     Dim iZ%
  841.     Dim iNextX%
  842.     Dim iNextY%
  843.     Dim iNextZ%
  844.     Dim iPosX1%
  845.     Dim iPosX2%
  846.     Dim iPosY1%
  847.     Dim iPosY2%
  848.     Dim iLoopX%
  849.     Dim iLoopY%
  850.     Dim iLoopZ%
  851.     Dim iNextColor&
  852.     Dim iColorScheme%
  853.     Dim bContinue As Integer
  854.     Dim iDirection%
  855.     Dim bFinished As Integer
  856.     Dim iCount%
  857.     Dim iOpen%
  858.     Dim iMove%
  859.     Dim iSegmentLength%
  860.     Dim iMaxLength%
  861.     Dim bFirst As Integer
  862.     Dim bQuit As Integer
  863.     Dim in$
  864.    
  865.     ' INITIALIZE
  866.     'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
  867.     Screen _NewImage(1280, 1024, 32) : _ScreenMove 0,0
  868.     iGridSize = 10
  869.        
  870.     ' =============================================================================
  871.     ' MAIN LOOP
  872.     bQuit = FALSE
  873.     Do
  874.         Cls
  875.  
  876.         ' -----------------------------------------------------------------------------
  877.         ' INITIALIZE MAP TO EMPTY
  878.         ClearIsometricMap
  879.        
  880.         ' -----------------------------------------------------------------------------
  881.         ' DRAW FLOOR
  882.         'For iLoopZ% = m_iMapMinZ To m_iMapMaxZ Step 8
  883.         For iLoopZ% = m_iMapMinZ To m_iMapMinZ
  884.             For iLoopX% = m_iMapMinX To m_iMapMaxX
  885.                 For iLoopY% = m_iMapMinY To m_iMapMaxY
  886.                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
  887.                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
  888.                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
  889.                 Next iLoopY%
  890.             Next iLoopX%
  891.         Next iLoopZ%
  892.        
  893.         ' -----------------------------------------------------------------------------
  894.         ' DRAW FRAME AROUND ENTIRE SPACE
  895.        
  896.         FOR iLoopZ% = m_iMapMinZ+1 TO m_iMapMaxZ
  897.             m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
  898.             m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
  899.            
  900.             m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
  901.             m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
  902.            
  903.             m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
  904.             m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
  905.            
  906.             m_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
  907.             m_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
  908.         NEXT iLoopZ%
  909.        
  910.         FOR iLoopX% = m_iMapMinX TO m_iMapMaxX
  911.             m_arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Typ = c_iMapType_Wall
  912.             m_arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Color1 = cOrange&
  913.            
  914.             m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Typ = c_iMapType_Wall
  915.             m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Color1 = cPurple&
  916.            
  917.             m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Typ = c_iMapType_Wall
  918.             m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Color1 = cLime&
  919.            
  920.             m_arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Typ = c_iMapType_Wall
  921.             m_arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Color1 = cCyan&
  922.         NEXT iLoopX%
  923.        
  924.         FOR iLoopY% = m_iMapMinY TO m_iMapMaxY
  925.             m_arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
  926.             m_arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Color1 = cDodgerBlue&
  927.            
  928.             m_arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
  929.             m_arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Color1 = cDeepPurple&
  930.            
  931.             m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
  932.             m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Color1 = cDarkRed&
  933.            
  934.             m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
  935.             m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Color1 = cGold&
  936.         NEXT iLoopY%
  937.        
  938.         ' -----------------------------------------------------------------------------
  939.         ' DRAW PIPES
  940.         If TRUE = TRUE Then
  941.             ' START POSITION
  942.             iX% = m_iMapMidX ' 30 ' RandomNumber(0, 32)
  943.             iY% = m_iMapMidY ' 28 ' RandomNumber(0, 32)
  944.             iZ% = m_iMapMidZ ' 1 ' 32
  945.            
  946.             ' LENGTH OF PIPES
  947.             iSegmentLength% = 8
  948.             iMaxLength% = 512
  949.            
  950.             ' START COLOR + DEFINE HOW COLOR CHANGES
  951.             iNextColor& = cRed&
  952.             iColorScheme% = 3 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
  953.            
  954.             ' INITIALIZE
  955.             bFirst = TRUE
  956.             iCount% = 0
  957.             iMove% = 0
  958.             bFinished = FALSE
  959.             Do
  960.                 iNextX% = iX%
  961.                 iNextY% = iY%
  962.                 iNextZ% = iZ%
  963.                
  964.                 ' CHANGE DIRECTION EVERY iSegmentLength% SPACES
  965.                 iMove% = iMove% + 1
  966.                 If iMove% > iSegmentLength% Then
  967.                     iMove% = 0
  968.                    
  969.                     ' PICK A DIRECTION
  970.                     If bFirst = TRUE Then
  971.                         ' MOVE UP FOR FIRST MOVE
  972.                         iDirection% = c_iDir_Up
  973.                         bFirst = FALSE
  974.                     Else
  975.                         ' PICK A RANDOM DIRECTION
  976.                         iDirection% = RandomNumber%(c_iDir_Min, c_iDir_Max)
  977.                     End If
  978.                 End If
  979.                
  980.                 Select Case iDirection%
  981.                     Case c_iDir_Down:
  982.                         If iNextZ% > 0 Then
  983.                             iNextZ% = iNextZ% - 1
  984.                         End If
  985.                     Case c_iDir_Up:
  986.                         If iNextZ% < 32 Then
  987.                             iNextZ% = iNextZ% + 1
  988.                         End If
  989.                     Case c_iDir_Left:
  990.                         If iNextX% > 0 Then
  991.                             iNextX% = iNextX% - 1
  992.                         End If
  993.                     Case c_iDir_Right:
  994.                         If iNextX% < 32 Then
  995.                             iNextX% = iNextX% + 1
  996.                         End If
  997.                     Case c_iDir_Back:
  998.                         If iNextY% > 0 Then
  999.                             iNextY% = iNextY% - 1
  1000.                         End If
  1001.                     Case Else: ' c_iDir_Forward
  1002.                         If iNextY% < 32 Then
  1003.                             iNextY% = iNextY% + 1
  1004.                         End If
  1005.                 End Select
  1006.                
  1007.                 ' CHECK IF NEXT SPACE IS EMPTY
  1008.                 If m_arrMap(iNextX%, iNextY%, iNextZ%).Typ = c_iMapType_Empty Then
  1009.                     ' SPACE IS EMPTY
  1010.                     ' DRAW HERE
  1011.                    
  1012.                     iCount% = iCount% + 1
  1013.                     iX% = iNextX%
  1014.                     iY% = iNextY%
  1015.                     iZ% = iNextZ%
  1016.                    
  1017.                     ' GET NEXT COLOR AND DRAW TILE
  1018.                     DoCycleColor iColorScheme%, iNextColor&
  1019.                     m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
  1020.                     m_arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
  1021.                    
  1022.                     ' HAVE WE PLACED MAX # OF TILES?
  1023.                     If iCount% > iMaxLength% Then
  1024.                         bFinished = TRUE
  1025.                     End If
  1026.                 Else                    
  1027.                     ' SPACE IS OCCUPIED
  1028.                     ' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
  1029.                     iOpen% = 0
  1030.                     If iZ% > 0 Then
  1031.                         If m_arrMap(iX%, iY%, iZ% - 1).Typ = c_iMapType_Empty Then
  1032.                             iOpen% = iOpen% + 1
  1033.                         End If
  1034.                     End If
  1035.                     If iZ% < 32 Then
  1036.                         If m_arrMap(iX%, iY%, iZ% + 1).Typ = c_iMapType_Empty Then
  1037.                             iOpen% = iOpen% + 1
  1038.                         End If
  1039.                     End If
  1040.                     If iX% > 0 Then
  1041.                         If m_arrMap(iX% - 1, iY%, iZ%).Typ = c_iMapType_Empty Then
  1042.                             iOpen% = iOpen% + 1
  1043.                         End If
  1044.                     End If
  1045.                     If iX% < 32 Then
  1046.                         If m_arrMap(iX% + 1, iY%, iZ%).Typ = c_iMapType_Empty Then
  1047.                             iOpen% = iOpen% + 1
  1048.                         End If
  1049.                     End If
  1050.                     If iY% > 0 Then
  1051.                         If m_arrMap(iX%, iY% - 1, iZ%).Typ = c_iMapType_Empty Then
  1052.                             iOpen% = iOpen% + 1
  1053.                         End If
  1054.                     End If
  1055.                     If iY% < 32 Then
  1056.                         If m_arrMap(iX%, iY% + 1, iZ%).Typ = c_iMapType_Empty Then
  1057.                             iOpen% = iOpen% + 1
  1058.                         End If
  1059.                     End If
  1060.                    
  1061.                     ' QUIT IF NO OPEN SPACES AVAILABLE
  1062.                     If iOpen% = 0 Then
  1063.                         ' NOWHERE TO GO, EXIT
  1064.                         bFinished = TRUE
  1065.                     End If
  1066.                 End If
  1067.                
  1068.             Loop Until bFinished = TRUE
  1069.         End If
  1070.  
  1071.         ' PLOT GRAPHICS TO SCREEN
  1072.         'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY
  1073.         'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, 0, 0, 0
  1074.         DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, iGridSize, 0, 0, 0
  1075.                
  1076.         Input "PRESS <ENTER> TO DRAW ANOTHER, OR 'Q' TO QUIT? ", in$
  1077.        
  1078.         If LCase$(in$) = LCase$("q") Then
  1079.             bQuit = TRUE
  1080.         End If
  1081.        
  1082.     Loop Until bQuit = TRUE
  1083.    
  1084.     Screen 0
  1085.    
  1086.     IsometricDemo2 = sResult
  1087. End Sub ' IsometricDemo2
  1088.  
  1089. ' /////////////////////////////////////////////////////////////////////////////
  1090.  
  1091. Function IsometricDemo3$
  1092.     Dim RoutineName As String: RoutineName = "IsometricDemo3"
  1093.     Dim sResult AS String : sResult = ""
  1094.     Dim sError As String: sError = ""
  1095.     Dim iX%
  1096.     Dim iY%
  1097.     Dim iZ%
  1098.     Dim iNewX%
  1099.     Dim iNewY%
  1100.     Dim iNewZ%
  1101.     Dim iMyColor&
  1102.     Dim iColorScheme%
  1103.     Dim iDirection%
  1104.     Dim bFound As Integer
  1105.     DIM bDone As Integer
  1106.     Dim in$
  1107.     Dim iTotal% ' compute total available spaces
  1108.     Dim iCount% ' count # of spaces searched
  1109.     Dim bEnableRepeatingKeys As Integer
  1110.     Dim iLastKey As Integer ' USED WHEN REPEATING KEYS DISABLED
  1111.    
  1112.     Dim iPosX1%
  1113.     Dim iPosX2%
  1114.     Dim iPosY1%
  1115.     Dim iPosY2%
  1116.     Dim iNextColor&
  1117.     Dim bContinue As Integer
  1118.     Dim iLoopX%
  1119.     Dim iLoopY%
  1120.     Dim iLoopZ%
  1121.     Dim iLevelCount%
  1122.     Dim iLevelSize%
  1123.    
  1124.     Dim iDrawX%
  1125.     Dim iDrawY%
  1126.    
  1127.     Dim iNumPlayers AS Integer ' # OF PLAYERS ACTIVE
  1128.     Dim iPlayerLoop AS Integer
  1129.     Dim iDirLoop AS Integer
  1130.    
  1131.     ' =============================================================================
  1132.     ' GET OPTIONS
  1133.     iNumPlayers = 1
  1134.     'iNumPlayers = PromptForIntegerInRange%("How many players ({min}-{max} or blank to quit)?", 1, 4, 0)
  1135.     'IF iNumPlayers = 0 THEN Goto CleanupAndExit
  1136.     bEnableRepeatingKeys = FALSE
  1137.    
  1138.     ' =============================================================================
  1139.     ' INITIALIZE GRAPHIC SCREEN
  1140.     'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
  1141.     Screen _NewImage(1280, 1024, 32) : _ScreenMove 0,0
  1142.    
  1143.     m_arrSplitScreen(1).GridOffsetX = 50
  1144.     m_arrSplitScreen(1).GridOffsetY = 50
  1145.     m_arrSplitScreen(1).GridOffsetZ = 0
  1146.     m_arrSplitScreen(1).ScreenOffsetX = 450
  1147.     m_arrSplitScreen(1).ScreenOffsetY = 200
  1148.     m_arrSplitScreen(1).ScreenOffsetZ = 0
  1149.    
  1150.     m_arrSplitScreen(2).GridOffsetX = 50
  1151.     m_arrSplitScreen(2).GridOffsetY = 50
  1152.     m_arrSplitScreen(2).GridOffsetZ = 0
  1153.     m_arrSplitScreen(2).ScreenOffsetX = 1000
  1154.     m_arrSplitScreen(2).ScreenOffsetY = 200
  1155.     m_arrSplitScreen(2).ScreenOffsetZ = 0
  1156.    
  1157.     m_arrSplitScreen(3).GridOffsetX = 50
  1158.     m_arrSplitScreen(3).GridOffsetY = 50
  1159.     m_arrSplitScreen(3).GridOffsetZ = 0
  1160.     m_arrSplitScreen(3).ScreenOffsetX = 450
  1161.     m_arrSplitScreen(3).ScreenOffsetY = 700
  1162.     m_arrSplitScreen(3).ScreenOffsetZ = 0
  1163.    
  1164.     m_arrSplitScreen(4).GridOffsetX = 50
  1165.     m_arrSplitScreen(4).GridOffsetY = 50
  1166.     m_arrSplitScreen(4).GridOffsetZ = 0
  1167.     m_arrSplitScreen(4).ScreenOffsetX = 1000
  1168.     m_arrSplitScreen(4).ScreenOffsetY = 700
  1169.     m_arrSplitScreen(4).ScreenOffsetZ = 0
  1170.    
  1171.     ' -----------------------------------------------------------------------------
  1172.     ' INITIALIZE MAP TO EMPTY
  1173.     ClearIsometricMap
  1174.    
  1175.     ' -----------------------------------------------------------------------------
  1176.     ' DRAW FLOOR
  1177.     For iLoopZ% = m_iMapMinZ To m_iMapMinZ
  1178.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  1179.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  1180.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
  1181.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
  1182.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
  1183.             Next iLoopY%
  1184.         Next iLoopX%
  1185.     Next iLoopZ%
  1186.  
  1187.     ' -----------------------------------------------------------------------------
  1188.     ' DRAW A TALL HOLLOW PYRAMID
  1189.     If TRUE = TRUE Then
  1190.         iX% = 5
  1191.         iY% = 10
  1192.         iZ% = 1
  1193.         iLevelSize% = 4
  1194.        
  1195.         iPosX1% = iX%
  1196.         iPosX2% = iX% + 7
  1197.         iPosY1% = iY%
  1198.         iPosY2% = iY% + 7
  1199.         iNextColor& = cRed&
  1200.         iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
  1201.         iLevelCount% = 0
  1202.        
  1203.         bContinue = TRUE
  1204.         Do
  1205.             ' PLOT NEXT LEVEL (SOLID)
  1206.             'For iLoopX% = iPosX1% To iPosX2%
  1207.             '    For iLoopY% = iPosY1% To iPosY2%
  1208.             '        m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  1209.             '        m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  1210.             '    Next iLoopY%
  1211.             'Next iLoopX%
  1212.            
  1213.             ' Draw front/back walls
  1214.             For iLoopX% = iPosX1% To iPosX2%
  1215.                 iLoopY% = iPosY1%
  1216.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  1217.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  1218.                 m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
  1219.                
  1220.                 iLoopY% = iPosY2%
  1221.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  1222.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  1223.                 m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
  1224.             Next iLoopX%
  1225.            
  1226.             ' Draw left/right walls
  1227.             For iLoopY% = iPosY1% To iPosY2%
  1228.                 iLoopX% = iPosX1%
  1229.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  1230.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  1231.                 m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
  1232.                
  1233.                 iLoopX% = iPosX2%
  1234.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
  1235.                 m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
  1236.                 m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
  1237.             Next iLoopY%
  1238.            
  1239.             ' Add a door to middle of right wall
  1240.             iX% = iPosX1% + ( (iPosX2% - iPosX1%) \ 2)
  1241.             m_arrMap(iX%, iPosY2%, iZ%).Typ = c_iMapType_Empty
  1242.            
  1243.             ' Add a door to middle of front wall
  1244.             iY% = iPosY1% + ( (iPosY2% - iPosY1%) \ 2)
  1245.             m_arrMap(iPosX2%, iY%, iZ%).Typ = c_iMapType_Empty
  1246.            
  1247.             ' MOVE UP A LEVEL
  1248.             iLevelCount% = iLevelCount% + 1
  1249.             IF iLevelCount% > iLevelSize% THEN
  1250.                 iLevelCount% = 0
  1251.                 iPosX1% = iPosX1% + 1
  1252.                 iPosX2% = iPosX2% - 1
  1253.                 iPosY1% = iPosY1% + 1
  1254.                 iPosY2% = iPosY2% - 1
  1255.             END IF
  1256.            
  1257.             ' QUIT AFTER WE REACH THE TOP
  1258.             If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
  1259.                 iZ% = iZ% + 1
  1260.                 DoCycleColor iColorScheme%, iNextColor&
  1261.                 If iZ% > m_iMapMaxZ Then
  1262.                     bContinue = FALSE
  1263.                 End If
  1264.             Else
  1265.                 bContinue = FALSE
  1266.             End If
  1267.            
  1268.         Loop Until bContinue = FALSE
  1269.     End If    
  1270.    
  1271.     ' -----------------------------------------------------------------------------
  1272.     ' DRAW FRAME AROUND ENTIRE SPACE (TOP)
  1273.    
  1274.     FOR iLoopX% = m_iMapMinX+3 TO m_iMapMaxX-3
  1275.         m_arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Typ = c_iMapType_Wall
  1276.         m_arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Color1 = cPurple&
  1277.        
  1278.         m_arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Typ = c_iMapType_Wall
  1279.         m_arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Color1 = cCyan&
  1280.     NEXT iLoopX%
  1281.    
  1282.     FOR iLoopY% = m_iMapMinY+3 TO m_iMapMaxY-3
  1283.         m_arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
  1284.         m_arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Color1 = cOrange&
  1285.        
  1286.         m_arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
  1287.         m_arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Color1 = cLime&
  1288.     NEXT iLoopY%
  1289.    
  1290.     ' -----------------------------------------------------------------------------
  1291.     ' DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
  1292.    
  1293.     FOR iLoopX% = m_iMapMinX+2 TO m_iMapMaxX-2
  1294.         m_arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Typ = c_iMapType_Wall
  1295.         m_arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Color1 = cDodgerBlue&
  1296.        
  1297.         m_arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Typ = c_iMapType_Wall
  1298.         m_arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Color1 = cDeepPurple&
  1299.     NEXT iLoopX%
  1300.    
  1301.     FOR iLoopY% = m_iMapMinY+2 TO m_iMapMaxY-2
  1302.         m_arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
  1303.         m_arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Color1 = cDarkRed&
  1304.        
  1305.         m_arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
  1306.         m_arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Color1 = cGold&
  1307.     NEXT iLoopY%
  1308.    
  1309.     ' -----------------------------------------------------------------------------
  1310.     ' DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
  1311.    
  1312.     FOR iLoopX% = m_iMapMinX+1 TO m_iMapMaxX-1
  1313.         m_arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Typ = c_iMapType_Wall
  1314.         m_arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Color1 = cSeaBlue&
  1315.        
  1316.         m_arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Typ = c_iMapType_Wall
  1317.         m_arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Color1 = cChartreuse&
  1318.     NEXT iLoopX%
  1319.    
  1320.     FOR iLoopY% = m_iMapMinY+1 TO m_iMapMaxY-1
  1321.         m_arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
  1322.         m_arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Color1 = cOrangeRed&
  1323.        
  1324.         m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
  1325.         m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Color1 = cDeepSkyBlue&
  1326.     NEXT iLoopY%
  1327.    
  1328.     ' =============================================================================
  1329.     ' PLACE PLAYER(S) <- ONLY ONE FOR THIS DEMO
  1330.    
  1331.     FOR iPlayerLoop = 1 TO iNumPlayers
  1332.        
  1333. 'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
  1334. 'TODO: WHATEVER THE KEYS MAPPED ARE, SWAP THEM NON-HARDCODED
  1335.         ' -----------------------------------------------------------------------------
  1336.         ' BEGIN Map the 6 directional keys
  1337.         ' -----------------------------------------------------------------------------
  1338.         ' differently for each of the 6 directional orientations!
  1339.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyBack = c_iKeyDown_Down
  1340.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyForward = c_iKeyDown_Up
  1341.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyLeft = c_iKeyDown_Left
  1342.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyRight = c_iKeyDown_Right
  1343.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyUp = c_iKeyDown_PgDn
  1344.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyDown = c_iKeyDown_PgUp
  1345.        
  1346.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyBack = c_iKeyDown_PgDn
  1347.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyForward = c_iKeyDown_PgUp
  1348.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyLeft = c_iKeyDown_Left
  1349.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyRight = c_iKeyDown_Right
  1350.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyUp = c_iKeyDown_Up
  1351.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyDown = c_iKeyDown_Down
  1352.        
  1353.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyBack = c_iKeyDown_Right
  1354.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyForward = c_iKeyDown_Left
  1355.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyLeft = c_iKeyDown_Down
  1356.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyRight = c_iKeyDown_Up
  1357.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyUp = c_iKeyDown_PgUp
  1358.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyDown = c_iKeyDown_PgDn
  1359.        
  1360.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyBack = c_iKeyDown_Left
  1361.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyForward = c_iKeyDown_Right
  1362.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyLeft = c_iKeyDown_Up
  1363.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyRight = c_iKeyDown_Down
  1364.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyUp = c_iKeyDown_PgUp
  1365.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyDown = c_iKeyDown_PgDn
  1366.        
  1367.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyBack = c_iKeyDown_Down
  1368.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyForward = c_iKeyDown_Up
  1369.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyLeft = c_iKeyDown_Right
  1370.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyRight = c_iKeyDown_Left
  1371.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyUp = c_iKeyDown_PgUp
  1372.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyDown = c_iKeyDown_PgDn
  1373.        
  1374.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyBack = c_iKeyDown_Up
  1375.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyForward = c_iKeyDown_Down
  1376.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyLeft = c_iKeyDown_Left
  1377.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyRight = c_iKeyDown_Right
  1378.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyUp = c_iKeyDown_PgUp
  1379.         m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyDown = c_iKeyDown_PgDn
  1380.         ' -----------------------------------------------------------------------------
  1381.         ' END Map the 6 directional keys
  1382.         ' -----------------------------------------------------------------------------
  1383.        
  1384.         ' FIND START POSITION
  1385.         iX% = RandomNumber(m_iMapMinX, m_iMapMaxX)
  1386.         iY% = RandomNumber(m_iMapMinY, m_iMapMaxY)
  1387.         iZ% = 1 ' RandomNumber(m_iMapMinZ, m_iMapMaxZ)
  1388.        
  1389.         ' MAKE SURE IT'S EMPTY
  1390.         IF m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty THEN
  1391.             bFound = TRUE
  1392.         ELSE
  1393.             ' IF NOT EMPTY THEN TRY TO FIND AN EMPTY SPOT
  1394.             iTotal% = ((m_iMapMaxX - m_iMapMinX)+1) * ((m_iMapMaxY - m_iMapMinY)+1) * ((m_iMapMaxZ - m_iMapMinZ)+1)
  1395.             iCount% = 0
  1396.             bFound = FALSE
  1397.             Do
  1398.                 iX% = iX% + 1
  1399.                 if iX% > m_iMapMaxX then
  1400.                     ' reset x and move to next y
  1401.                     iX% = m_iMapMinX
  1402.                     iY% = iY% + 1
  1403.                     if iY% > m_iMapMaxY then
  1404.                         ' reset y and move to next z
  1405.                         iY% = m_iMapMinY
  1406.                         iZ% = iZ% + 1
  1407.                         if iZ% > m_iMapMaxZ then
  1408.                             ' RESET Z AND SEE IF WE HAVE CHECKED EVERYTHING
  1409.                             iZ% = m_iMapMinZ
  1410.                             iCount% = iCount% + 1
  1411.                             if iCount% >= iTotal% then
  1412.                                 ' NONE FOUND, EXIT
  1413.                                 Exit Do
  1414.                             end if
  1415.                         else
  1416.                             iCount% = iCount% + 1
  1417.                         end if
  1418.                     else
  1419.                         iCount% = iCount% + 1
  1420.                     end if
  1421.                 else
  1422.                     iCount% = iCount% + 1
  1423.                 end if
  1424.                 IF m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty THEN
  1425.                     ' FOUND AN EMPTY SPACE, EXIT
  1426.                     bFound = TRUE
  1427.                     Exit Do
  1428.                 END IF
  1429.             Loop
  1430.         END IF
  1431.        
  1432.         If bFound = TRUE THEN
  1433.             ' PICK A DIRECTION (SIMPLE FOR NOW, LEFT OR RIGHT)
  1434.             if iX% <= m_iMapMidX then
  1435.                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  1436.             else
  1437.                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  1438.             end if
  1439.            
  1440.             m_arrPlayer(iPlayerLoop).Tile1 = c_iMapType_Player1
  1441.            
  1442.             ' SAVE COORDINATES TO PLAYER
  1443.             ' ****************************************************************************************************************************************************************
  1444.             ' for this demo we'll just use iX% instead of m_arrPlayer(iPlayerLoop).x, etc.
  1445.             ' to make it more readable
  1446.             ' ****************************************************************************************************************************************************************
  1447.             m_arrPlayer(iPlayerLoop).x = iX%
  1448.             m_arrPlayer(iPlayerLoop).y = iY%
  1449.             m_arrPlayer(iPlayerLoop).z = iZ%
  1450.             m_arrPlayer(iPlayerLoop).View = c_iDir_Forward
  1451.             m_arrPlayer(iPlayerLoop).Color1 = cRed&
  1452.             m_arrPlayer(iPlayerLoop).Alpha1 = 255
  1453.             m_arrPlayer(iPlayerLoop).AlphaOverride = 255
  1454.             m_arrPlayer(iPlayerLoop).ColorScheme1 = 2
  1455.             m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 = 5 ' change color every 5 frames
  1456.             m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
  1457.            
  1458.                         ' DISPLAY OPTIONS
  1459.                         m_arrPlayer(iPlayerLoop).GridSize = 8
  1460.                         m_arrPlayer(iPlayerLoop).MapSize = 4
  1461.                        
  1462.             ' RESET MOVEMENT VARIABLES
  1463.             m_arrPlayer(iPlayerLoop).IsMoving = FALSE
  1464.             m_arrPlayer(iPlayerLoop).IsMoved = FALSE
  1465.            
  1466.             ' DRAW PLAYER
  1467.             m_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
  1468.             m_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
  1469.             m_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
  1470.            
  1471.         Else
  1472.             sError = "Could not find an empty space to start player."    
  1473.             Exit For
  1474.         End If
  1475.        
  1476.     NEXT iPlayerLoop
  1477.    
  1478.     ' =============================================================================
  1479.     ' OTHER SETUP
  1480.     If Len(sError)=0 Then
  1481.         ' RESET INPUT
  1482.         WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
  1483.         iLastKey = c_iKeyDown_Enter
  1484.     End If
  1485.    
  1486.     ' =============================================================================
  1487.     ' MAIN LOOP
  1488.     If Len(sError)=0 Then
  1489.         bFinished = FALSE
  1490.         Do
  1491.             CLS ' is cls necessary?
  1492.            
  1493.             ' SHOW INSTRUCTIONS / COORDINATES ON SCREEN
  1494.             LOCATE  1, 1: PRINT "IsometricDemo3"
  1495.             LOCATE  3, 1: PRINT "CRSR RT/LF MOVES X = " + CSTR$(iX%)
  1496.             LOCATE  4, 1: PRINT "CRSR UP/DN MOVES Y = " + CSTR$(iY%)
  1497.             LOCATE  5, 1: PRINT "PAGE UP/DN MOVES Z = " + CSTR$(iZ%)
  1498.             LOCATE  6, 1: PRINT "=    / -   CHANGES GRID SIZE   = " + CSTR$(m_arrPlayer(1).GridSize)
  1499.             LOCATE  7, 1: PRINT "[    / ]   TOGGLES MOVEMENT    = " + IIFSTR$(m_arrPlayer(1).IsMoving, "TRUE", "FALSE")
  1500.             LOCATE  8, 1: PRINT "INS  / DEL TOGGLES REPEAT KEYS = " + IIFSTR$(bEnableRepeatingKeys, "TRUE", "FALSE")
  1501.             LOCATE  9, 1: PRINT "HOME / END CHANGES VIEW ANGLE  = " + GetDirection$(m_arrPlayer(1).View)
  1502.             LOCATE 10, 1: PRINT ",    / .   CHANGES MAP SIZE    = " + CSTR$(m_arrPlayer(1).MapSize)
  1503.             LOCATE 12, 1: PRINT "PRESS <ESC> TO QUIT"
  1504.            
  1505.             ' ****************************************************************************************************************************************************************
  1506.             ' BEGIN PLAYER LOOP
  1507.             ' ****************************************************************************************************************************************************************
  1508.             DrawScreen c_iDir_Forward, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  1509.             DrawScreen c_iDir_Back,    m_arrSplitScreen(2).ScreenOffsetX, m_arrSplitScreen(2).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  1510.             DrawScreen c_iDir_Left,    m_arrSplitScreen(3).ScreenOffsetX, m_arrSplitScreen(3).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  1511.             DrawScreen c_iDir_Right,   m_arrSplitScreen(4).ScreenOffsetX, m_arrSplitScreen(4).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
  1512.                        
  1513.             FOR iPlayerLoop = 1 TO iNumPlayers
  1514.                 'DrawScreen m_arrPlayer(iPlayerLoop).View, cScreenOffsetX, cScreenOffsetY, iX%, iY%, iZ%
  1515.                
  1516.                 ' -----------------------------------------------------------------------------
  1517.                 ' BEGIN SHOW 2D MINI MAP ON SCREEN
  1518.                 ' -----------------------------------------------------------------------------
  1519.                 ' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
  1520.                 FOR iLoopX% = m_iMapMinX TO m_iMapMaxX
  1521.                     FOR iLoopY% = m_iMapMinY TO m_iMapMaxY
  1522.                         'iDrawX% = (iLoopX% * 4) + 20
  1523.                                                 iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + 20
  1524.                                                
  1525.                         'iDrawY% = (iLoopY% * 4) + 200
  1526.                                                 iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + 200
  1527.                        
  1528.                         IF m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall THEN
  1529.                             'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1530.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1531.                            
  1532.                         ELSEIF m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Player1 THEN
  1533.                             'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1534.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1535.                         ELSEIF m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Player2 THEN
  1536.                             'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1537.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1538.                         ELSEIF m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Player3 THEN
  1539.                             'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1540.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1541.                         ELSEIF m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Player4 THEN
  1542.                             'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1543.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
  1544.                            
  1545.                         'TODO: ADD OTHER TYPES
  1546.                        
  1547.                         ELSE
  1548.                             'DrawBox iDrawX%, iDrawY%, 4, cBlack&
  1549.                                                         'DrawBox iDrawX%, iDrawY%, 4, cKhaki&
  1550.                                                         DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki&
  1551.                         END IF
  1552.                     NEXT iLoopY%
  1553.                 NEXT iLoopX%
  1554.                 ' -----------------------------------------------------------------------------
  1555.                 ' END SHOW 2D MINI MAP ON SCREEN
  1556.                 ' -----------------------------------------------------------------------------
  1557.                
  1558.                
  1559.                 ' -----------------------------------------------------------------------------
  1560.                 ' BEGIN GET DIRECTIONAL KEYBOARD INPUT
  1561.                 ' -----------------------------------------------------------------------------
  1562.                 If _KeyDown(c_iKeyDown_Up) Then
  1563.                     If iLastKey <> c_iKeyDown_Up OR bEnableRepeatingKeys=TRUE Then
  1564.                         iLastKey = c_iKeyDown_Up
  1565.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
  1566.                         bMoved = TRUE
  1567.                     End If
  1568.                 ElseIf _KeyDown(c_iKeyDown_Down) Then
  1569.                     If iLastKey <> c_iKeyDown_Down OR bEnableRepeatingKeys=TRUE Then
  1570.                         iLastKey = c_iKeyDown_Down
  1571.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
  1572.                         bMoved = TRUE
  1573.                     End If
  1574.                 ElseIf _KeyDown(c_iKeyDown_Left) Then
  1575.                     If iLastKey <> c_iKeyDown_Left OR bEnableRepeatingKeys=TRUE Then
  1576.                         iLastKey = c_iKeyDown_Left
  1577.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  1578.                         bMoved = TRUE
  1579.                     End If
  1580.                 ElseIf _KeyDown(c_iKeyDown_Right) Then
  1581.                     If iLastKey <> c_iKeyDown_Right OR bEnableRepeatingKeys=TRUE Then
  1582.                         iLastKey = c_iKeyDown_Right
  1583.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  1584.                         bMoved = TRUE
  1585.                     End If
  1586.                 ElseIf _KeyDown(c_iKeyDown_PgUp) Then
  1587.                     If iLastKey <> c_iKeyDown_PgUp OR bEnableRepeatingKeys=TRUE Then
  1588.                         iLastKey = c_iKeyDown_PgUp
  1589.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
  1590.                         bMoved = TRUE
  1591.                     End If
  1592.                 ElseIf _KeyDown(c_iKeyDown_PgDn) Then
  1593.                     If iLastKey <> c_iKeyDown_PgDn OR bEnableRepeatingKeys=TRUE Then
  1594.                         iLastKey = c_iKeyDown_PgDn
  1595.                         m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
  1596.                         bMoved = TRUE
  1597.                     End If                
  1598.                 ' -----------------------------------------------------------------------------
  1599.                 ' END GET DIRECTIONAL KEYBOARD INPUT
  1600.                 ' -----------------------------------------------------------------------------
  1601.                
  1602.                
  1603.                
  1604. 'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
  1605. '                ' -----------------------------------------------------------------------------
  1606. '                ' BEGIN GET VARIABLE DIRECTIONAL KEYBOARD INPUT
  1607. '                ' -----------------------------------------------------------------------------
  1608. '                If _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack) Then
  1609. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack OR bEnableRepeatingKeys=TRUE Then
  1610. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack
  1611. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
  1612. '                        bMoved = TRUE
  1613. '                    End If
  1614. '                ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward) Then
  1615. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward OR bEnableRepeatingKeys=TRUE Then
  1616. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward
  1617. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
  1618. '                        bMoved = TRUE
  1619. '                    End If
  1620. '                ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft) Then
  1621. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft OR bEnableRepeatingKeys=TRUE Then
  1622. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft
  1623. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  1624. '                        bMoved = TRUE
  1625. '                    End If
  1626. '                ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight) Then
  1627. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight OR bEnableRepeatingKeys=TRUE Then
  1628. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight
  1629. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  1630. '                        bMoved = TRUE
  1631. '                    End If
  1632. '                ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp) Then
  1633. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp OR bEnableRepeatingKeys=TRUE Then
  1634. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp
  1635. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
  1636. '                        bMoved = TRUE
  1637. '                    End If
  1638. '                ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown) Then
  1639. '                    If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown OR bEnableRepeatingKeys=TRUE Then
  1640. '                        iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown
  1641. '                        m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
  1642. '                        bMoved = TRUE
  1643. '                    End If
  1644. '                ' -----------------------------------------------------------------------------
  1645. '                ' END GET VARIABLE DIRECTIONAL KEYBOARD INPUT
  1646. '                ' -----------------------------------------------------------------------------
  1647.  
  1648.                 ' -----------------------------------------------------------------------------
  1649.                 ' BEGIN GET OTHER KEYBOARD INPUT
  1650.                 ' -----------------------------------------------------------------------------
  1651.                 ElseIf _KeyDown(c_iKeyDown_BracketLeft) Then
  1652.                     If iLastKey <> c_iKeyDown_BracketLeft OR bEnableRepeatingKeys=TRUE Then
  1653.                         iLastKey = c_iKeyDown_BracketLeft
  1654.                         m_arrPlayer(iPlayerLoop).IsMoving = TRUE
  1655.                     End If
  1656.                 ElseIf _KeyDown(c_iKeyDown_BracketRight) Then
  1657.                     If iLastKey <> c_iKeyDown_BracketRight OR bEnableRepeatingKeys=TRUE Then
  1658.                         iLastKey = c_iKeyDown_BracketRight
  1659.                         m_arrPlayer(iPlayerLoop).IsMoving = FALSE
  1660.                     End If
  1661.                    
  1662.                                        
  1663.                                        
  1664.                                        
  1665. 'yoda
  1666.                 ElseIf _KeyDown(c_iKeyDown_Comma) Then
  1667.                     If iLastKey <> c_iKeyDown_Comma OR bEnableRepeatingKeys=TRUE Then
  1668.                         iLastKey = c_iKeyDown_Comma
  1669.                         ' TODO: HAVE MAP SIZE PER PLAYER
  1670.                         m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize - 1
  1671.                         IF m_arrPlayer(iPlayerLoop).MapSize < 1 THEN
  1672.                             m_arrPlayer(iPlayerLoop).MapSize = 1
  1673.                         ELSE
  1674.                             bMoved = TRUE
  1675.                         END IF
  1676.                     End If
  1677.                 ElseIf _KeyDown(c_iKeyDown_Period) Then
  1678.                     If iLastKey <> c_iKeyDown_Period OR bEnableRepeatingKeys=TRUE Then
  1679.                         iLastKey = c_iKeyDown_Period
  1680.                         m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize + 1
  1681.                         IF m_arrPlayer(iPlayerLoop).MapSize > m_iGridSizeMax THEN
  1682.                             m_arrPlayer(iPlayerLoop).MapSize = m_iGridSizeMax
  1683.                         ELSE
  1684.                             bMoved = TRUE
  1685.                         END IF
  1686.                     End If
  1687.                                        
  1688.                                        
  1689.                                        
  1690.                                        
  1691.                                        
  1692.                                        
  1693.                 ElseIf _KeyDown(c_iKeyDown_Minus) Then
  1694.                     If iLastKey <> c_iKeyDown_Minus OR bEnableRepeatingKeys=TRUE Then
  1695.                         iLastKey = c_iKeyDown_Minus
  1696.                         ' TODO: HAVE SEPARATE GRID SIZE PER PLAYER / SPLIT SCREEN?
  1697.                         m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize - 1
  1698.                         IF m_arrPlayer(iPlayerLoop).GridSize < m_iGridSizeMin THEN
  1699.                             m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMin
  1700.                         ELSE
  1701.                             bMoved = TRUE
  1702.                         END IF
  1703.                     End If
  1704.                 ElseIf _KeyDown(c_iKeyDown_EqualPlus) Then
  1705.                     If iLastKey <> c_iKeyDown_EqualPlus OR bEnableRepeatingKeys=TRUE Then
  1706.                         iLastKey = c_iKeyDown_EqualPlus
  1707.                         m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize + 1
  1708.                         IF m_arrPlayer(iPlayerLoop).GridSize > m_iGridSizeMax THEN
  1709.                             m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMax
  1710.                         ELSE
  1711.                             bMoved = TRUE
  1712.                         END IF
  1713.                     End If
  1714.                    
  1715.                 ElseIf _KeyDown(c_iKeyDown_Home) Then
  1716.                     If iLastKey <> c_iKeyDown_Home OR bEnableRepeatingKeys=TRUE Then
  1717.                         iLastKey = c_iKeyDown_Home
  1718.                         ' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  1719.                         m_arrPlayer(iPlayerLoop).View = m_arrPlayer(iPlayerLoop).View - 1
  1720.                         IF m_arrPlayer(iPlayerLoop).View < c_iDir_Min THEN
  1721.                             m_arrPlayer(iPlayerLoop).View = c_iDir_Max
  1722.                         END IF
  1723.                     End If
  1724.                 ElseIf _KeyDown(c_iKeyDown_End) Then
  1725.                     If iLastKey <> c_iKeyDown_End OR bEnableRepeatingKeys=TRUE Then
  1726.                         iLastKey = c_iKeyDown_End
  1727.                         ' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
  1728.                         m_arrPlayer(iPlayerLoop).View = m_arrPlayer(iPlayerLoop).View + 1
  1729.                         IF m_arrPlayer(iPlayerLoop).View > c_iDir_Max THEN
  1730.                             m_arrPlayer(iPlayerLoop).View = c_iDir_Min
  1731.                         END IF
  1732.                     End If
  1733.                    
  1734.                 ElseIf _KeyDown(c_iKeyDown_Ins) Then
  1735.                     ' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
  1736.                     If iLastKey <> c_iKeyDown_Ins OR bEnableRepeatingKeys=TRUE Then
  1737.                         iLastKey = c_iKeyDown_Ins
  1738.                         bEnableRepeatingKeys = TRUE
  1739.                     End If
  1740.                    
  1741.                 ElseIf _KeyDown(c_iKeyDown_Del) Then
  1742.                     ' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
  1743.                     If iLastKey <> c_iKeyDown_Del OR bEnableRepeatingKeys=TRUE Then
  1744.                         iLastKey = c_iKeyDown_Del
  1745.                         bEnableRepeatingKeys = FALSE
  1746.                     End If
  1747.                    
  1748.                 ElseIf _KeyDown(c_iKeyDown_Esc) Then
  1749.                     Exit Do
  1750.                 Else
  1751.                     iLastKey = -1
  1752.                 End If
  1753.                 ' -----------------------------------------------------------------------------
  1754.                 ' END GET OTHER KEYBOARD INPUT
  1755.                 ' -----------------------------------------------------------------------------
  1756.                
  1757.                 ' --------------------------------------------------------------------------------
  1758.                 ' ERASE OLD POSITION
  1759.                 ' --------------------------------------------------------------------------------
  1760.                 m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty
  1761.                 m_arrMap(iX%, iY%, iZ%).Color1 = cEmpty&
  1762.                 m_arrMap(iX%, iY%, iZ%).AlphaOverride = 255
  1763.                
  1764.                 ' --------------------------------------------------------------------------------
  1765.                 ' MOVE PLAYER BASED ON DIRECTION
  1766.                 ' --------------------------------------------------------------------------------
  1767.                 IF m_arrPlayer(iPlayerLoop).IsMoving=TRUE OR bMoved=TRUE THEN
  1768.                     bMoved = FALSE
  1769.                    
  1770.                     SELECT CASE m_arrPlayer(iPlayerLoop).Direction
  1771.                         CASE c_iDir_Down:
  1772.                             iNewX% = iX%
  1773.                             iNewY% = iY%
  1774.                             iNewZ% = iZ% - 1
  1775.                             If iNewZ% < m_iMapMinZ Then
  1776.                                 iNewZ% = m_iMapMaxZ
  1777.                             End If
  1778.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1779.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
  1780.                                 iNewZ% = iZ%
  1781.                             End If
  1782.                            
  1783.                         CASE c_iDir_Up:
  1784.                             iNewX% = iX%
  1785.                             iNewY% = iY%
  1786.                             iNewZ% = iZ% + 1
  1787.                             If iNewZ% > m_iMapMaxZ Then
  1788.                                 iNewZ% = m_iMapMinZ
  1789.                             End If
  1790.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1791.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
  1792.                                 iNewZ% = iZ%
  1793.                             End If
  1794.                            
  1795.                         CASE c_iDir_Left:
  1796.                             iNewX% = iX% - 1
  1797.                             iNewY% = iY%
  1798.                             iNewZ% = iZ%
  1799.                             If iNewX% < m_iMapMinX Then
  1800.                                 iNewX% = m_iMapMaxX
  1801.                             End If
  1802.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1803.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
  1804.                                 iNewX% = iX%
  1805.                             End If
  1806.                            
  1807.                         CASE c_iDir_Right:
  1808.                             iNewX% = iX% + 1
  1809.                             iNewY% = iY%
  1810.                             iNewZ% = iZ%
  1811.                             If iNewX% > m_iMapMaxX Then
  1812.                                 iNewX% = m_iMapMinX
  1813.                             End If
  1814.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1815.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
  1816.                                 iNewX% = iX%
  1817.                             End If
  1818.                            
  1819.                         CASE c_iDir_Back:
  1820.                             iNewX% = iX%
  1821.                             iNewY% = iY% - 1
  1822.                             iNewZ% = iZ%
  1823.                             If iNewY% < m_iMapMinY Then
  1824.                                 iNewY% = m_iMapMaxY
  1825.                             End If
  1826.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1827.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
  1828.                                 iNewY% = iY%
  1829.                             End If
  1830.                            
  1831.                         CASE c_iDir_Forward:
  1832.                             iNewX% = iX%
  1833.                             iNewY% = iY% + 1
  1834.                             iNewZ% = iZ%
  1835.                             If iNewY% > m_iMapMaxY Then
  1836.                                 iNewY% = m_iMapMinY
  1837.                             End If
  1838.                             If m_arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
  1839.                                 m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
  1840.                                 iNewY% = iY%
  1841.                             End If
  1842.                            
  1843.                         CASE ELSE:
  1844.                             'iNewX% = iX%
  1845.                             'iNewY% = iY%
  1846.                             'iNewZ% = iZ%
  1847.                     END SELECT
  1848.                    
  1849.                     ' SAVE NEW POSITION
  1850.                     iX% = iNewX%
  1851.                     iY% = iNewY%
  1852.                     iZ% = iNewZ%
  1853.                    
  1854.                     ' FOR MULTIPLAYER WE WOULD USE:
  1855.                     'm_arrPlayer(iPlayerLoop).x = iNewX%
  1856.                     'm_arrPlayer(iPlayerLoop).y = iNewY%
  1857.                     'm_arrPlayer(iPlayerLoop).z = iNewZ%
  1858.                    
  1859.                 END IF
  1860.                
  1861.                 ' CYCLE COLOR
  1862.                 IF m_arrPlayer(iPlayerLoop).ColorScheme1 > 0 THEN
  1863.                     m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = m_arrPlayer(iPlayerLoop).ColorSchemeCount1 + 1
  1864.                     IF m_arrPlayer(iPlayerLoop).ColorSchemeCount1 > m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 THEN
  1865.                         m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
  1866.                         DoCycleColor m_arrPlayer(iPlayerLoop).ColorScheme1, m_arrPlayer(iPlayerLoop).Color1
  1867.                     END IF
  1868.                 END IF
  1869.                
  1870.                 ' REDRAW AT CURRENT POSITION
  1871.                 m_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
  1872.                 m_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
  1873.                 m_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
  1874.             NEXT iPlayerLoop
  1875.            
  1876.             ' ****************************************************************************************************************************************************************
  1877.             ' END PLAYER LOOP
  1878.             ' ****************************************************************************************************************************************************************
  1879.            
  1880.         _Limit 30
  1881.         _Display
  1882.        
  1883.         Loop
  1884.     END IF
  1885.    
  1886. CleanupAndExit:
  1887.     ' FINISH UP AND EXIT
  1888.     WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
  1889.     SCREEN 0
  1890.     IsometricDemo3$ = sResult
  1891. End Sub ' IsometricDemo3
  1892.  
  1893. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1894. ' BEGIN GRAPHICS FUNCTIONS
  1895. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1896.  
  1897. ' =============================================================================
  1898. ' LET'S GET THE COORDINATES STRAIGHT!
  1899. ' Coordinates are m_arrMap(x,y,z)
  1900. '           ________________
  1901. '          /|e            /|e
  1902. '         / |            / |
  1903. '        /  |           /  |z-axis
  1904. '       /   |          /   |
  1905. '      /    /---------/----/
  1906. '     /    / a       /   b/  
  1907. '    /    /         /    /        
  1908. '   |--------------|    /  
  1909. '   |f  /         g|   / y-axis
  1910. '   |  /           |  /
  1911. '   | /            | /
  1912. '   |/c           d|/
  1913. '   ----------------
  1914. '      x-axis
  1915. '
  1916. ' POINT    ( X, Y, Z)
  1917. ' a        ( 0, 0, 0)
  1918. ' b        (32, 0, 0)
  1919. ' c        ( 0,32, 0)
  1920. ' d        (32,32, 0)
  1921. ' e        ( 0, 0,32)
  1922. ' f        ( 0,32,32)
  1923. ' g        (32,32,32)
  1924. ' =============================================================================
  1925.  
  1926. ' /////////////////////////////////////////////////////////////////////////////
  1927. ' INITIALIZE MAP TO EMPTY
  1928.  
  1929. ' Requires shared global variable:
  1930. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  1931. Sub ClearIsometricMap
  1932.     Dim RoutineName As String: RoutineName = "ClearIsometricMap"
  1933.     Dim iLoopX%
  1934.     Dim iLoopY%
  1935.     Dim iLoopZ%
  1936.    
  1937.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  1938.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  1939.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  1940.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Empty
  1941.                 m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  1942.             Next iLoopY%
  1943.         Next iLoopX%
  1944.     Next iLoopZ%
  1945. End Sub ' ClearIsometricMap
  1946.  
  1947. ' /////////////////////////////////////////////////////////////////////////////
  1948. ' INITIALIZE RENDERING MAP TO EMPTY
  1949.  
  1950. ' Requires shared global variable:
  1951. ' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  1952.  
  1953. Sub ClearRenderMap
  1954.     Dim RoutineName As String: RoutineName = "ClearRenderMap"
  1955.     Dim iLoopX%
  1956.     Dim iLoopY%
  1957.     Dim iLoopZ%
  1958.    
  1959.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  1960.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  1961.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  1962.                 m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Empty
  1963.                 m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  1964.             Next iLoopY%
  1965.         Next iLoopX%
  1966.     Next iLoopZ%
  1967. End Sub ' ClearRenderMap
  1968.  
  1969. ' /////////////////////////////////////////////////////////////////////////////
  1970. ' Determine which squares are visible in isometric map
  1971.  
  1972. ' Original operates directly on the main map array m_arrMap
  1973. ' and not the copy (m_arrRender) used to rotate the perspective.
  1974.  
  1975. ' Requires shared global variable (3D array of map):
  1976. ' m_arrMap(x,y,z) = 3D array map of world
  1977. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  1978.  
  1979. ' RECEIVES:
  1980. ' iX% = player's X positon
  1981. ' iY% = player's Y position
  1982. ' iZ% = player's Z position
  1983.  
  1984. ' Direction is assumed to be c_iDir_Forward.
  1985.  
  1986. ' If iX% < 0 then we just render everything with its normal alpha value.
  1987.  
  1988. Sub ComputeVisible (iX%, iY%, iZ%, iGridSize)
  1989.     Dim RoutineName As String: RoutineName = "ComputeVisible"
  1990.     Dim iLoopX%
  1991.     Dim iLoopY%
  1992.     Dim iLoopZ%
  1993.    
  1994.     Dim iPX1%
  1995.     Dim iPY1%
  1996.     Dim iPZ1%
  1997.     Dim iPlayer2Dx As Integer
  1998.     Dim iPlayer2Dy As Integer
  1999.     Dim iTile2Dx As Integer
  2000.     Dim iTile2Dy As Integer
  2001.    
  2002.     IF iX% > -1 THEN
  2003.         ' CALCULATE PLAYER'S 2-D POSITION
  2004.         iPX1% = iX% * iGridSize + cGridOffsetX
  2005.         iPY1% = iY% * iGridSize + cGridOffsetY
  2006.         iPZ1% = iZ% * iGridSize + cGridOffsetZ
  2007.         iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  2008.         iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  2009.         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)    
  2010.        
  2011.         ' LOOK AT EACH TILE
  2012.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2013.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2014.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2015.                    
  2016.                     ' *****************************************************************************
  2017.                     ' IF SPACE HAS A TILE
  2018.                     ' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
  2019.                     ' THEN MAKE THE TILE TRANSPARENT
  2020.                     ' *****************************************************************************
  2021.                     ' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
  2022.                     If m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall OR m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled Then
  2023.                         ' CALCULATE TILE'S 2-D POSITION
  2024.                         iPX1% = iLoopX% * iGridSize + cGridOffsetX
  2025.                         iPY1% = iLoopY% * iGridSize + cGridOffsetY
  2026.                         iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  2027.                         iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  2028.                         iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  2029.                         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)    
  2030.                        
  2031.                         'If iLoopZ% >= iZ% Then
  2032.                             'If iLoopX% >= iX% Then
  2033.                                
  2034.                                 ' FOR TILES FORWARD OF PLAYER
  2035.                                 If iLoopY% > iY% Then
  2036.                                    
  2037.                                     ' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
  2038.                                     If ( iPlayer2Dy >= (iTile2Dy - iGridSize) ) AND ( iPlayer2Dy <= (iTile2Dy + iGridSize) ) Then
  2039.                                        
  2040.                                         ' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
  2041.                                         If ( iPlayer2Dx >= (iTile2Dx - iGridSize) ) AND ( iPlayer2Dx <= (iTile2Dx + iGridSize) ) Then
  2042.                                             ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
  2043.                                             ' TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE
  2044.                                             m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
  2045.                                         Else
  2046.                                             ' LEAVE THE TILE OPAQUE
  2047.                                             ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2048.                                             m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2049.                                         End If
  2050.                                     Else
  2051.                                         ' LEAVE THE TILE OPAQUE
  2052.                                         ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2053.                                         m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2054.                                     End If
  2055.                                 Else
  2056.                                     ' LEAVE THE TILE OPAQUE
  2057.                                     ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2058.                                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2059.                                 End If
  2060.                             'End If
  2061.                         'End If
  2062.                     Else
  2063.                         ' LEAVE THE TILE OPAQUE
  2064.                         ' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2065.                         m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2066.                     End If
  2067.                 Next iLoopZ%
  2068.             Next iLoopY%
  2069.         Next iLoopX%
  2070.     ELSE
  2071.         ' JUST MAKE ALL TILES VISIBLE
  2072.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2073.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2074.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2075.                     ' LEAVE THE TILE OPAQUE
  2076.                     m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2077.                    
  2078.                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2079.                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2080.                     'm_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2081.                    
  2082.                 Next iLoopZ%
  2083.             Next iLoopY%
  2084.         Next iLoopX%
  2085.     END IF
  2086. End Sub ' ComputeVisible
  2087.  
  2088. ' /////////////////////////////////////////////////////////////////////////////
  2089. ' Determine which squares are visible in isometric map
  2090.  
  2091. ' Same as ComputeVisible except uses the rotated copy
  2092. ' (m_arrRender instead of m_arrMap)
  2093.  
  2094. ' Requires shared global variable (3D array of map):
  2095. ' m_arrRender(x,y,z) = rotated copy of 3D array map of world
  2096. ' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  2097.  
  2098. ' RECEIVES:
  2099. ' iX% = player's X positon
  2100. ' iY% = player's Y position
  2101. ' iZ% = player's Z position
  2102.  
  2103. ' If iX% < 0 then we just render everything with its normal alpha value.
  2104.  
  2105. ' TODO: FIX FOR c_iDir_Down and c_iDir_Up DIRECTIONS
  2106. '       "FOR TILES FORWARD OF PLAYER" SECTION BELOW
  2107. '       NEEDS TO LOOK AT Z AXIS INSTEAD OF Y ?
  2108.  
  2109. Sub ComputeRenderVisible (iX%, iY%, iZ%, iGridSize)
  2110.     Dim RoutineName As String: RoutineName = "ComputeRenderVisible"
  2111.     Dim iLoopX%
  2112.     Dim iLoopY%
  2113.     Dim iLoopZ%
  2114.    
  2115.     Dim iPX1%
  2116.     Dim iPY1%
  2117.     Dim iPZ1%
  2118.     Dim iPlayer2Dx As Integer
  2119.     Dim iPlayer2Dy As Integer
  2120.     Dim iTile2Dx As Integer
  2121.     Dim iTile2Dy As Integer
  2122.    
  2123.     IF iX% > -1 THEN
  2124.         ' CALCULATE PLAYER'S 2-D POSITION
  2125.         iPX1% = iX% * iGridSize + cGridOffsetX
  2126.         iPY1% = iY% * iGridSize + cGridOffsetY
  2127.         iPZ1% = iZ% * iGridSize + cGridOffsetZ
  2128.         iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  2129.         iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  2130.         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)    
  2131.        
  2132.         ' LOOK AT EACH TILE
  2133.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2134.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2135.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2136.                    
  2137.                     ' *****************************************************************************
  2138.                     ' IF SPACE HAS A TILE
  2139.                     ' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
  2140.                     ' THEN MAKE THE TILE TRANSPARENT
  2141.                     ' *****************************************************************************
  2142.                     ' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
  2143.                     If m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall OR m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled Then
  2144.                         ' CALCULATE TILE'S 2-D POSITION
  2145.                         iPX1% = iLoopX% * iGridSize + cGridOffsetX
  2146.                         iPY1% = iLoopY% * iGridSize + cGridOffsetY
  2147.                         iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  2148.                         iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
  2149.                         iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
  2150.                         'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)    
  2151.                        
  2152.                         'If iLoopZ% >= iZ% Then
  2153.                             'If iLoopX% >= iX% Then
  2154.                                
  2155.                                 ' FOR TILES FORWARD OF PLAYER
  2156.                                 If iLoopY% > iY% Then
  2157.                                    
  2158.                                     ' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
  2159.                                     If ( iPlayer2Dy >= (iTile2Dy - iGridSize) ) AND ( iPlayer2Dy <= (iTile2Dy + iGridSize) ) Then
  2160.                                        
  2161.                                         ' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
  2162.                                         If ( iPlayer2Dx >= (iTile2Dx - iGridSize) ) AND ( iPlayer2Dx <= (iTile2Dx + iGridSize) ) Then
  2163.                                             ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
  2164.                                             'TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE?
  2165.                                             m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
  2166.                                         Else
  2167.                                             ' LEAVE THE TILE OPAQUE
  2168.                                             m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2169.                                            
  2170.                                             'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2171.                                             'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2172.                                             'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2173.                                         End If
  2174.                                     Else
  2175.                                         ' LEAVE THE TILE OPAQUE
  2176.                                         m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2177.                                        
  2178.                                         'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2179.                                         'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2180.                                         'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2181.                                     End If
  2182.                                 Else
  2183.                                     ' LEAVE THE TILE OPAQUE
  2184.                                     m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2185.                                    
  2186.                                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2187.                                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2188.                                     'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2189.                                 End If
  2190.                             'End If
  2191.                         'End If
  2192.                     Else
  2193.                         m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2194.                        
  2195.                         'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2196.                         'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2197.                     End If
  2198.                 Next iLoopZ%
  2199.             Next iLoopY%
  2200.         Next iLoopX%
  2201.     ELSE
  2202.         ' JUST MAKE ALL TILES VISIBLE
  2203.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2204.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2205.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2206.                     m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
  2207.                    
  2208.                     'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
  2209.                     'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
  2210.                     'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
  2211.                 Next iLoopZ%
  2212.             Next iLoopY%
  2213.         Next iLoopX%
  2214.     END IF
  2215. End Sub ' ComputeRenderVisible
  2216.  
  2217. ' /////////////////////////////////////////////////////////////////////////////
  2218. ' Draw the map in 3D Isometic Perspective
  2219. ' from the forward (default) perspective.
  2220.  
  2221. ' Requires shared global variable
  2222. ' m_arrMap(x,y,z) = 3D array map of world
  2223. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  2224.  
  2225. ' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
  2226. ' params instead of constants:
  2227. ' Const cScreenOffsetX = 500 ' 450
  2228. ' Const cScreenOffsetY = 300 ' 50
  2229. ' Const cScreenOffsetZ = 0
  2230.  
  2231. ' what about?
  2232. ' Const cGridOffsetX = 50
  2233. ' Const cGridOffsetY = 50
  2234. ' Const cGridOffsetZ = 0
  2235.  
  2236. Sub DrawIsometricScreen(iScreenOffsetX, iScreenOffsetY, iGridSize)
  2237.     Dim RoutineName As String: RoutineName = "DrawIsometricScreen"
  2238.     Dim bTile As Integer
  2239.     Dim iLoopX%
  2240.     Dim iLoopY%
  2241.     Dim iLoopZ%
  2242.     Dim iColor As _Unsigned Long
  2243.     Dim iPosX1%
  2244.     Dim iPosX2%
  2245.     Dim iPosY1%
  2246.     Dim iPosY2%
  2247.     Dim iPosZ1%
  2248.     Dim alpha&
  2249.    
  2250.     alpha& = 255
  2251.     bTile = FALSE
  2252.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2253.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2254.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2255.                
  2256.                 ' CALCULATE POSITION
  2257.                 iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  2258.                 iPosX1% = iLoopX% * iGridSize + cGridOffsetX
  2259.                 iPosY1% = iLoopY% * iGridSize + cGridOffsetY
  2260.                 iPosX2% = iPosX1% + iGridSize
  2261.                 iPosY2% = iPosY1% + iGridSize
  2262.                
  2263.                 ' DETERMINE COLOR
  2264.                 If m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled Then
  2265.                     If bTile = TRUE Then
  2266.                         iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2267.                         bTile = FALSE
  2268.                     Else
  2269.                         iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
  2270.                         bTile = TRUE
  2271.                     End If
  2272.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall Then
  2273.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2274.                     alpha& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
  2275.                    
  2276.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player1 Then
  2277.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2278.                     alpha& = 255
  2279.                    
  2280.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player2 Then
  2281.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2282.                     alpha& = 255
  2283.                    
  2284.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player3 Then
  2285.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2286.                     alpha& = 255
  2287.                    
  2288.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player4 Then
  2289.                     iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2290.                     alpha& = 255
  2291.                    
  2292.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Water Then
  2293.                     'TODO: transparent for water
  2294.                     iColor = cEmpty&
  2295.                     alpha& = 64
  2296.                    
  2297.                 ElseIf m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Window Then
  2298.                     'TODO: transparent for windows
  2299.                     iColor = cEmpty&
  2300.                     alpha& = 64
  2301.                    
  2302.                 Else
  2303.                     iColor = cEmpty&
  2304.                 End If
  2305.                
  2306.                 ' PLOT NEXT TILE
  2307.                 If iColor <> cEmpty& Then
  2308.                     'IsoLine3D(x,      y,       x2,      y2,      z,       iHeight,     xoffset,        yoffset,        iColor As _Unsigned Long, alpha&)
  2309.                     'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
  2310.                     IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
  2311.                 End If
  2312.                
  2313.             Next iLoopY%
  2314.         Next iLoopX%
  2315.     Next iLoopZ%
  2316. End Sub ' DrawIsometricScreen
  2317.  
  2318. ' /////////////////////////////////////////////////////////////////////////////
  2319. ' Draw the map in 3D Isometic Perspective
  2320. ' from the forward (default) perspective.
  2321.  
  2322. ' Same as DrawIsometricScreen except uses the rotated copy
  2323. ' (m_arrRender instead of m_arrMap)
  2324.  
  2325. ' Requires shared global variable
  2326. ' m_arrRender(x,y,z) = 3D array map of world
  2327. ' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  2328.  
  2329. Sub DrawRenderScreen(iScreenOffsetX, iScreenOffsetY, iGridSize)
  2330.     Dim RoutineName As String: RoutineName = "DrawRenderScreen"
  2331.     Dim bTile As Integer
  2332.     Dim iLoopX%
  2333.     Dim iLoopY%
  2334.     Dim iLoopZ%
  2335.     Dim iColor As _Unsigned Long
  2336.     Dim iPosX1%
  2337.     Dim iPosX2%
  2338.     Dim iPosY1%
  2339.     Dim iPosY2%
  2340.     Dim iPosZ1%
  2341.     Dim alpha&
  2342.    
  2343.     alpha& = 255
  2344.     bTile = FALSE
  2345.     For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2346.         For iLoopX% = m_iMapMinX To m_iMapMaxX
  2347.             For iLoopY% = m_iMapMinY To m_iMapMaxY
  2348.                
  2349.                 ' CALCULATE POSITION
  2350.                 iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
  2351.                 iPosX1% = iLoopX% * iGridSize + cGridOffsetX
  2352.                 iPosY1% = iLoopY% * iGridSize + cGridOffsetY
  2353.                 iPosX2% = iPosX1% + iGridSize
  2354.                 iPosY2% = iPosY1% + iGridSize
  2355.                
  2356.                 ' DETERMINE COLOR
  2357.                 If m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled Then
  2358.                     If bTile = TRUE Then
  2359.                         iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2360.                         bTile = FALSE
  2361.                     Else
  2362.                         iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color2
  2363.                         bTile = TRUE
  2364.                     End If
  2365.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall Then
  2366.                     iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2367.                     alpha& = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
  2368.                    
  2369.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player1 Then
  2370.                     iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2371.                     alpha& = 255
  2372.                    
  2373.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player2 Then
  2374.                     iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2375.                     alpha& = 255
  2376.                    
  2377.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player3 Then
  2378.                     iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2379.                     alpha& = 255
  2380.                    
  2381.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player4 Then
  2382.                     iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
  2383.                     alpha& = 255
  2384.                    
  2385.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Water Then
  2386.                     'TODO: transparent for water
  2387.                     iColor = cEmpty&
  2388.                     alpha& = 64
  2389.                    
  2390.                 ElseIf m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Window Then
  2391.                     'TODO: transparent for windows
  2392.                     iColor = cEmpty&
  2393.                     alpha& = 64
  2394.                    
  2395.                 Else
  2396.                     iColor = cEmpty&
  2397.                 End If
  2398.                
  2399.                 ' PLOT NEXT TILE
  2400.                 If iColor <> cEmpty& Then
  2401.                     'IsoLine3D(x,      y,       x2,      y2,      z,       iHeight,     xoffset,        yoffset,        iColor As _Unsigned Long, alpha&)
  2402.                     'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
  2403.                     IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
  2404.                 End If
  2405.                
  2406.             Next iLoopY%
  2407.         Next iLoopX%
  2408.     Next iLoopZ%
  2409. End Sub ' DrawRenderScreen
  2410.  
  2411. ' /////////////////////////////////////////////////////////////////////////////
  2412. ' Draw the map in 3D Isometic Perspective
  2413. ' from a different direction.
  2414.  
  2415. ' This is the lazy man's version which simply copies the tiles to
  2416. ' a temporary array, rotated to the specified direction/orientation.
  2417. ' A more efficient + faster method would operate directly on the
  2418. ' main array, but I am too bogged down to figure that out right now!
  2419.  
  2420. ' RECEIVES:
  2421. ' iDirection% = point of view to render from
  2422. '     i.e. the direction we are looking at the scene FROM
  2423. '     iDirection% can be one of the following:
  2424. '     c_iDir_Down
  2425. '     c_iDir_Up
  2426. '     c_iDir_Left
  2427. '     c_iDir_Right
  2428. '     c_iDir_Back
  2429. '     c_iDir_Forward = default
  2430. '    
  2431. '     If iDirection% = c_iDir_Forward, just call DrawIsometricScreen instead (faster).
  2432. '
  2433. ' iScreenOffsetX, iScreenOffsetY = where on display to draw
  2434. '
  2435. ' iX%, iY%, iZ% = player's position, used for ComputeRenderVisible
  2436. '     to compute which tiles to hide / make transparent
  2437. '     (tiles that might be hiding the player)
  2438. '     If these are <0, then ComputeRenderVisible uses original alpha values.
  2439.  
  2440. ' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
  2441. ' params instead of constants:
  2442. ' Const cScreenOffsetX = 500 ' 450
  2443. ' Const cScreenOffsetY = 300 ' 50
  2444. ' Const cScreenOffsetZ = 0
  2445.  
  2446. ' what about?
  2447. ' Const cGridOffsetX = 50
  2448. ' Const cGridOffsetY = 50
  2449. ' Const cGridOffsetZ = 0
  2450.  
  2451. Sub DrawScreen(iDirection%, iScreenOffsetX, iScreenOffsetY, iGridSize, iX%, iY%, iZ%)
  2452.     Dim RoutineName As String: RoutineName = "DrawScreen"
  2453.     Dim bTile As Integer
  2454.     Dim iLoopX%
  2455.     Dim iLoopY%
  2456.     Dim iLoopZ%
  2457.     Dim iColor As _Unsigned Long
  2458.     Dim iPosX1%
  2459.     Dim iPosX2%
  2460.     Dim iPosY1%
  2461.     Dim iPosY2%
  2462.     Dim iPosZ1%
  2463.     Dim alpha&
  2464.    
  2465.     IF iDirection% = c_iDir_Forward THEN
  2466.         ' NO NEED TO ROTATE, JUST USE THE ORIGINAL ROUTINE
  2467.         ComputeVisible iX%, iY%, iZ%, iGridSize
  2468.         DrawIsometricScreen iScreenOffsetX, iScreenOffsetY, iGridSize
  2469.     ELSE
  2470.         ' USE A TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
  2471.         ClearRenderMap
  2472.         SELECT CASE iDirection%
  2473.             CASE c_iDir_Down:
  2474.                 ' SCENE IS FLIPPED UP (TOP FACE NOW FACING AWAY FROM US)
  2475.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2476.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2477.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2478.                             m_arrRender(iLoopX%,m_iMapMaxZ-iLoopZ%,iLoopY%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2479.                         Next iLoopY%
  2480.                     Next iLoopX%
  2481.                 Next iLoopZ%
  2482.                 ComputeRenderVisible iX%, m_iMapMaxZ-iZ%, iY%, iGridSize
  2483.             CASE c_iDir_Up:
  2484.                 ' SCENE IS FLIPPED DOWN (TOP FACE NOW FACING TOWARD US)
  2485.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2486.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2487.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2488.                             m_arrRender(iLoopX%,iLoopZ%,m_iMapMaxY-iLoopY%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2489.                         Next iLoopY%
  2490.                     Next iLoopX%
  2491.                 Next iLoopZ%
  2492.                 ComputeRenderVisible iX%, iZ%, m_iMapMaxY-iY%, iGridSize
  2493.             CASE c_iDir_Left:
  2494.                 ' SCENE IS ROTATED COUNTER CLOCKWISE FROM TOP (LEFT FACE NOW FACING TOWARD US)
  2495.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2496.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2497.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2498.                             m_arrRender(iLoopY%,m_iMapMaxX-iLoopX%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2499.                         Next iLoopY%
  2500.                     Next iLoopX%
  2501.                 Next iLoopZ%
  2502.                 ComputeRenderVisible iY%, m_iMapMaxX-iX%, iZ%, iGridSize
  2503.             CASE c_iDir_Right:
  2504.                 ' SCENE IS ROTATED CLOCKWISE FROM TOP (RIGHT FACE NOW FACING TOWARD US)
  2505.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2506.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2507.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2508.                             m_arrRender(m_iMapMaxY-iLoopY%,iLoopX%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2509.                         Next iLoopY%
  2510.                     Next iLoopX%
  2511.                 Next iLoopZ%
  2512.                 ComputeRenderVisible m_iMapMaxY-iY%, iX%, iZ%, iGridSize
  2513.             CASE c_iDir_Back:
  2514.                 ' SCENE IS TURNED AROUND (FRONT FACE NOW FACING AWAY FROM US)
  2515.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2516.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2517.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2518.                             m_arrRender(m_iMapMaxX-iLoopX%,m_iMapMaxY-iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2519.                         Next iLoopY%
  2520.                     Next iLoopX%
  2521.                 Next iLoopZ%
  2522.                 ComputeRenderVisible m_iMapMaxX-iX%, m_iMapMaxY-iY%, iZ%, iGridSize
  2523.             CASE ELSE:
  2524.                 ' DIRECTION UNKNOWN: for now just draw default (forward)
  2525.                 For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
  2526.                     For iLoopX% = m_iMapMinX To m_iMapMaxX
  2527.                         For iLoopY% = m_iMapMinY To m_iMapMaxY
  2528.                             m_arrRender(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
  2529.                         Next iLoopY%
  2530.                     Next iLoopX%
  2531.                 Next iLoopZ%
  2532.                 ComputeRenderVisible iX%, iY%, iZ%, iGridSize
  2533.         END SELECT
  2534.         DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
  2535.     END IF
  2536. End Sub ' DrawScreen
  2537.  
  2538. ' /////////////////////////////////////////////////////////////////////////////
  2539. ' RETURNS MAP AS TEXT
  2540.  
  2541. ' Requires shared global variable
  2542. ' m_arrMap(x,y,z) = 3D array map of world
  2543. ' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
  2544.  
  2545. ' USAGE:
  2546. 'Input "See a text dump (y/n)? ", in$
  2547. 'If LCase$(in$) = LCase$("y") Then
  2548. '    Print MapToText$
  2549. 'End If
  2550.  
  2551. Function MapToText$
  2552.     Dim RoutineName As String: RoutineName = "MapToText$"
  2553.     Dim sResult As String
  2554.     Dim iLoopX%
  2555.     Dim iLoopY%
  2556.     Dim iLoopZ%
  2557.     Dim iMinX%
  2558.     Dim iMaxX%
  2559.     Dim iMinY%
  2560.     Dim iMaxY%
  2561.     Dim iMinZ%
  2562.     Dim iMaxZ%
  2563.     Dim sLine As String
  2564.     Dim iType%
  2565.     Dim iColor1&
  2566.     Dim iColor2&
  2567.     Dim iColor3&
  2568.     Dim in$
  2569.  
  2570.     sResult = ""
  2571.  
  2572.     ' FIND USED BOUNDARIES OF MAP
  2573.     iMinX% = -1
  2574.     iMaxX% = -1
  2575.     iMinY% = -1
  2576.     iMaxY% = -1
  2577.     iMinZ% = -1
  2578.     iMaxZ% = -1
  2579.     For iLoopZ% = 0 To 32
  2580.         For iLoopX% = 0 To 32
  2581.             For iLoopY% = 0 To 32
  2582.                 iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
  2583.                 If iType% <> c_iMapType_Empty And iType% <> c_iMapType_Floor_Tiled Then
  2584.                     If iMinX% = -1 Then
  2585.                         iMinX% = iLoopX%
  2586.                     End If
  2587.                     If iMinY% = -1 Then
  2588.                         iMinY% = iLoopY%
  2589.                     End If
  2590.                     If iMinZ% = -1 Then
  2591.                         iMinZ% = iLoopZ%
  2592.                     End If
  2593.                     If iLoopX% > iMaxX% Then
  2594.                         iMaxX% = iLoopX%
  2595.                     End If
  2596.                     If iLoopY% > iMaxY% Then
  2597.                         iMaxY% = iLoopY%
  2598.                     End If
  2599.                     If iLoopZ% > iMaxZ% Then
  2600.                         iMaxZ% = iLoopZ%
  2601.                     End If
  2602.                 End If
  2603.             Next iLoopY%
  2604.         Next iLoopX%
  2605.     Next iLoopZ%
  2606.  
  2607.     ' GENERATE OUTPUT
  2608.     For iLoopZ% = iMinZ% To iMaxZ%
  2609.         sResult = sResult + "-------------------------------------------------------------------------------" + Chr$(13)
  2610.         sResult = sResult + "Map Z=" + cstr$(iLoopZ%) + ":" + Chr$(13)
  2611.         sResult = sResult + "-------------------------------------------------------------------------------" + Chr$(13)
  2612.         For iLoopY% = iMinY% To iMaxY%
  2613.             sLine = ""
  2614.             For iLoopX% = iMinX% To iMaxX%
  2615.                 iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
  2616.                 iColor1& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
  2617.                 iColor2& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
  2618.                 iColor3& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color3
  2619.                
  2620.                 If iType% = c_iMapType_Empty Then
  2621.                     sLine = sLine + " "
  2622.                 Else
  2623.                     If iColor1& = cEmpty& Then
  2624.                         sLine = sLine + " "
  2625.                     Else
  2626.                         sLine = sLine + "#"
  2627.                     End If
  2628.                 End If
  2629.             Next iLoopX%
  2630.             sResult = sResult + sLine + Chr$(13)
  2631.         Next iLoopY%
  2632.  
  2633.         sResult = sResult + Chr$(13)
  2634.     Next iLoopZ%
  2635.  
  2636.     MapToText$ = sResult
  2637. End Function ' MapToText$
  2638.  
  2639. ' /////////////////////////////////////////////////////////////////////////////
  2640. ' Return string description for 2.5D movement constants
  2641.  
  2642. FUNCTION GetDirection$(iDir AS INTEGER)
  2643.     DIM sDir AS STRING
  2644.     SELECT CASE iDir
  2645.         CASE c_iDir_Down:
  2646.             sDir = "Down"
  2647.         CASE c_iDir_Up:
  2648.             sDir = "Up"
  2649.         CASE c_iDir_Left:
  2650.             sDir = "Left"
  2651.         CASE c_iDir_Right:
  2652.             sDir = "Right"
  2653.         CASE c_iDir_Back:
  2654.             sDir = "Back"
  2655.         CASE c_iDir_Forward:
  2656.             sDir = "Forward"
  2657.         CASE ELSE:
  2658.             sDir = "Unknown"
  2659.     END SELECT
  2660.     GetDirection$ = sDir
  2661. END FUNCTION ' GetDirection$
  2662.  
  2663. ' /////////////////////////////////////////////////////////////////////////////
  2664.  
  2665. Function CX2I (x As Long, y As Long) 'Convert Cartesian X To Isometic coordinates
  2666.     CX2I = x - y
  2667. End Function ' CX2I
  2668.  
  2669. ' /////////////////////////////////////////////////////////////////////////////
  2670.  
  2671. Function CY2I (x As Long, y As Long) 'Convert Cartesian Y To Isometic coordinates
  2672.     CY2I = (x + y) / 2
  2673. End Function ' CY2I
  2674.  
  2675. ' /////////////////////////////////////////////////////////////////////////////
  2676. ' since we're drawing a diamond and not a square box, we can't use Line BF.
  2677. ' We have to manually down the 4 points of the line.
  2678.  
  2679. Sub IsoLine (x, y, x2, y2, xoffset, yoffset, iColor As _Unsigned Long)
  2680.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), iColor
  2681.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), iColor
  2682.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), iColor
  2683.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), iColor
  2684.     Paint (CX2I(x, y) + xoffset, CY2I(x, y) + 4), iColor 'and fill the diamond solid
  2685.     Line (CX2I(x, y) + xoffset, CY2I(x, y) + yoffset)-(CX2I(x2, y) + xoffset, CY2I(x2, y) + yoffset), &HFFFFFFFF
  2686.     Line -(CX2I(x2, y2) + xoffset, CY2I(x2, y2) + yoffset), &HFFFFFFFF
  2687.     Line -(CX2I(x, y2) + xoffset, CY2I(x, y2) + yoffset), &HFFFFFFFF
  2688.     Line -(CX2I(x, y) + xoffset, CY2I(x, y) + yoffset), &HFFFFFFFF
  2689. End Sub ' IsoLine
  2690.  
  2691. ' /////////////////////////////////////////////////////////////////////////////
  2692. ' Like IsoLine, we're going to have to draw our lines manually.
  2693. ' only in this case, we also need a Z coordinate to tell us how
  2694. ' THICK/TALL/HIGH to make our tile
  2695.  
  2696. ' MODIFIED by madscijr to draw a single tile of height iHeight at Z axis
  2697. ' MODIFIED by madscijr to accept an alpha& value to control transparency (where 0=fully transparent, 255=opaque)
  2698.  
  2699. ''Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
  2700. 'Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
  2701. Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
  2702.     dim r as integer
  2703.     dim g as integer
  2704.     dim b as integer
  2705.     'dim iNewColor As _Unsigned Long
  2706.    
  2707.     r = _Red32(iColor)
  2708.     g = _Green32(iColor)
  2709.     b = _Blue32(iColor)
  2710.    
  2711.     ' Let's just do all the math first this time.
  2712.     ' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
  2713.     TempX1 = CX2I(x, y) + xoffset
  2714.     TempY1 = CY2I(x, y) + yoffset
  2715.     TempX2 = CX2I(x2, y) + xoffset
  2716.     TempY2 = CY2I(x2, y) + yoffset
  2717.     TempX3 = CX2I(x2, y2) + xoffset
  2718.     TempY3 = CY2I(x2, y2) + yoffset
  2719.     TempX4 = CX2I(x, y2) + xoffset
  2720.     TempY4 = CY2I(x, y2) + yoffset
  2721.    
  2722.     ' The top
  2723.     'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
  2724.     fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
  2725.    
  2726.     If z <> 0 Then
  2727.         ' TODO: maybe change which sides gets shaded depending on the direction of the light source?
  2728.        
  2729.         ' draw the left side, shaded 75%
  2730.         'fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b)
  2731.         fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b, alpha&)
  2732.        
  2733.         ' draw the right side,s haded 50%
  2734.         'fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b)
  2735.         fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b, alpha&)
  2736.     Else
  2737.         ' no need to draw any height, if there isn't any.
  2738.     End If
  2739. End Sub ' IsoLine3D
  2740.  
  2741. ' /////////////////////////////////////////////////////////////////////////////
  2742. ' found at abandoned, outdated and now likely malicious qb64 dot net website
  2743. ' don’t go there: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  2744.  
  2745. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  2746.     Dim D As Long
  2747.     Dim a&
  2748.  
  2749.     D = _Dest
  2750.     a& = _NewImage(1, 1, 32)
  2751.     _Dest a&
  2752.     PSet (0, 0), K
  2753.     _Dest D
  2754.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  2755.     _FreeImage a& ' <<< this is important!
  2756. End Sub ' ftri
  2757.  
  2758. ' /////////////////////////////////////////////////////////////////////////////
  2759. ' 2019-11-20 Steve saves some time with STATIC
  2760. ' and saves and restores last dest
  2761.  
  2762. Sub ftri1 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  2763.     Dim D As Long
  2764.     Static a&
  2765.  
  2766.     D = _Dest
  2767.     If a& = 0 Then
  2768.         a& = _NewImage(1, 1, 32)
  2769.     End If
  2770.     _Dest a&
  2771.     _DontBlend a&
  2772.     PSet (0, 0), K
  2773.     _Blend a&
  2774.     _Dest D
  2775.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  2776. End Sub ' ftri1
  2777.  
  2778. ' /////////////////////////////////////////////////////////////////////////////
  2779. ' original fill quad that may be at fault using Steve's fTri version
  2780. ' need 4 non linear points (not all on 1 line) list them clockwise
  2781. ' so x2, y2 is opposite of x4, y4
  2782.  
  2783. Sub fquad1 (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  2784.     ftri1 x1, y1, x2, y2, x4, y4, K
  2785.     ftri1 x3, y3, x2, y2, x4, y4, K
  2786. End Sub ' fquad1
  2787.  
  2788. ' /////////////////////////////////////////////////////////////////////////////
  2789. ' update 2019-12-16 needs orig fTri
  2790. ' need 4 non linear points (not all on 1 line)
  2791. ' list them clockwise so x2, y2 is opposite of x4, y4
  2792.  
  2793. Sub fquad (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
  2794.     ftri x1, y1, x2, y2, x3, y3, K
  2795.     ftri x3, y3, x4, y4, x1, y1, K
  2796. End Sub ' fquad
  2797.  
  2798. ' /////////////////////////////////////////////////////////////////////////////
  2799. ' DRAW A 2-D BOX
  2800.  
  2801. 'SUB DrawBox (iX%, iY%, iSize%, iColor%)
  2802. SUB DrawBox (iX%, iY%, iSize%, iColor&)
  2803.     LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor&, BF ' Draw a solid box
  2804.     'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
  2805.     'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
  2806. END SUB ' DrawBox
  2807.  
  2808. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2809. ' END GRAPHICS FUNCTIONS
  2810. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2811.  
  2812. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2813. ' BEGIN GENERAL PURPOSE FUNCTIONS
  2814. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2815.  
  2816. ' /////////////////////////////////////////////////////////////////////////////
  2817.  
  2818. Function cstr$ (myValue)
  2819.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  2820.     cstr$ = _Trim$(Str$(myValue))
  2821. End Function ' cstr$
  2822.  
  2823. ' /////////////////////////////////////////////////////////////////////////////
  2824.  
  2825. Function cstrl$ (myValue As Long)
  2826.     cstrl$ = _Trim$(Str$(myValue))
  2827. End Function ' cstrl$
  2828.  
  2829. ' /////////////////////////////////////////////////////////////////////////////
  2830.  
  2831. Function cstrs$ (myValue As Single)
  2832.     ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
  2833.     cstrs$ = _Trim$(Str$(myValue))
  2834. End Function ' cstrs$
  2835.  
  2836. ' /////////////////////////////////////////////////////////////////////////////
  2837.  
  2838. Function IIF (Condition, IfTrue, IfFalse)
  2839.     If Condition Then IIF = IfTrue Else IIF = IfFalse
  2840.  
  2841. ' /////////////////////////////////////////////////////////////////////////////
  2842.  
  2843. Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
  2844.     If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
  2845.  
  2846. ' /////////////////////////////////////////////////////////////////////////////
  2847. ' From: Bitwise Manipulations By Steven Roman
  2848. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  2849.  
  2850. ' Returns the 8-bit binary representation
  2851. ' of an integer iInput where 0 <= iInput <= 255
  2852.  
  2853. Function GetBinary$ (iInput1 As Integer)
  2854.     Dim sResult As String
  2855.     Dim iLoop As Integer
  2856.     Dim iInput As Integer: iInput = iInput1
  2857.  
  2858.     sResult = ""
  2859.  
  2860.     If iInput >= 0 And iInput <= 255 Then
  2861.         For iLoop = 1 To 8
  2862.             sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
  2863.             iInput = iInput \ 2
  2864.             'If iLoop = 4 Then sResult = " " + sResult
  2865.         Next iLoop
  2866.     End If
  2867.  
  2868.     GetBinary$ = sResult
  2869. End Function ' GetBinary$
  2870.  
  2871. ' /////////////////////////////////////////////////////////////////////////////
  2872. ' wonderfully inefficient way to read if a bit is set
  2873. ' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
  2874.  
  2875. ' See also: GetBit256%, SetBit256%
  2876.  
  2877. Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
  2878.     Dim iResult As Integer
  2879.     Dim sNum As String
  2880.     Dim sBit As String
  2881.     Dim iLoop As Integer
  2882.     Dim bContinue As Integer
  2883.     'DIM iTemp AS INTEGER
  2884.     Dim iNum As Integer: iNum = iNum1
  2885.     Dim iBit As Integer: iBit = iBit1
  2886.  
  2887.     iResult = FALSE
  2888.     bContinue = TRUE
  2889.  
  2890.     If iNum < 256 And iBit <= 128 Then
  2891.         sNum = GetBinary$(iNum)
  2892.         sBit = GetBinary$(iBit)
  2893.         For iLoop = 1 To 8
  2894.             If Mid$(sBit, iLoop, 1) = "1" Then
  2895.                 'if any of the bits in iBit are false, return false
  2896.                 If Mid$(sNum, iLoop, 1) = "0" Then
  2897.                     iResult = FALSE
  2898.                     bContinue = FALSE
  2899.                     Exit For
  2900.                 End If
  2901.             End If
  2902.         Next iLoop
  2903.         If bContinue = TRUE Then
  2904.             iResult = TRUE
  2905.         End If
  2906.     End If
  2907.  
  2908.     GetBit256% = iResult
  2909. End Function ' GetBit256%
  2910.  
  2911. ' /////////////////////////////////////////////////////////////////////////////
  2912. ' From: Bitwise Manipulations By Steven Roman
  2913. ' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
  2914.  
  2915. ' Returns the integer that corresponds to a binary string of length 8
  2916.  
  2917. Function GetIntegerFromBinary% (sBinary1 As String)
  2918.     Dim iResult As Integer
  2919.     Dim iLoop As Integer
  2920.     Dim strBinary As String
  2921.     Dim sBinary As String: sBinary = sBinary1
  2922.  
  2923.     iResult = 0
  2924.     strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
  2925.     For iLoop = 0 To Len(strBinary) - 1
  2926.         iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
  2927.     Next iLoop
  2928.  
  2929.     GetIntegerFromBinary% = iResult
  2930. End Function ' GetIntegerFromBinary%
  2931.  
  2932. ' /////////////////////////////////////////////////////////////////////////////
  2933. ' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
  2934.  
  2935. Function IsNum% (text$)
  2936.     Dim a$
  2937.     Dim b$
  2938.     a$ = _Trim$(text$)
  2939.     b$ = _Trim$(Str$(Val(text$)))
  2940.     If a$ = b$ Then
  2941.         IsNum% = TRUE
  2942.     Else
  2943.         IsNum% = FALSE
  2944.     End If
  2945. End Function ' IsNum%
  2946.  
  2947. ' /////////////////////////////////////////////////////////////////////////////
  2948. ' Split and join strings
  2949. ' https://www.qb64.org/forum/index.php?topic=1073.0
  2950.  
  2951. 'Combine all elements of in$() into a single string with delimiter$ separating the elements.
  2952.  
  2953. Function join$ (in$(), delimiter$)
  2954.     result$ = in$(LBound(in$))
  2955.     For i = LBound(in$) + 1 To UBound(in$)
  2956.         result$ = result$ + delimiter$ + in$(i)
  2957.     Next i
  2958.     join$ = result$
  2959. End Function ' join$
  2960.  
  2961. ' /////////////////////////////////////////////////////////////////////////////
  2962. ' ABS was returning strange values with type LONG
  2963. ' so I created this which does not.
  2964.  
  2965. Function LongABS& (lngValue As Long)
  2966.     If Sgn(lngValue) = -1 Then
  2967.         LongABS& = 0 - lngValue
  2968.     Else
  2969.         LongABS& = lngValue
  2970.     End If
  2971. End Function ' LongABS&
  2972.  
  2973. ' /////////////////////////////////////////////////////////////////////////////
  2974. ' Re: Does a Is Number function exist in QB64?
  2975. ' https://www.qb64.org/forum/index.php?topic=896.15
  2976.  
  2977. ' MWheatley
  2978. ' « Reply #18 on: January 01, 2019, 11:24:30 AM »
  2979.  
  2980. ' returns 1 if string is an integer, 0 if not
  2981. Function IsNumber (text$)
  2982.     Dim i As Integer
  2983.  
  2984.     IsNumber = 1
  2985.     For i = 1 To Len(text$)
  2986.         If Asc(Mid$(text$, i, 1)) < 45 Or Asc(Mid$(text$, i, 1)) >= 58 Then
  2987.             IsNumber = 0
  2988.             Exit For
  2989.         ElseIf Asc(Mid$(text$, i, 1)) = 47 Then
  2990.             IsNumber = 0
  2991.             Exit For
  2992.         End If
  2993.     Next i
  2994. End Function ' IsNumber
  2995.  
  2996. ' /////////////////////////////////////////////////////////////////////////////
  2997. ' iNum% = PromptForIntegerInRange%("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
  2998.  
  2999. Function PromptForIntegerInRange% (sPrompt$, iMin%, iMax%, iDefault%)
  3000.     Dim iValue%
  3001.     Dim bFinished%
  3002.     Dim sPrompt1$
  3003.     Dim in$
  3004.  
  3005.     If Len(sPrompt$) > 0 Then
  3006.         sPrompt1$ = sPrompt$
  3007.     Else
  3008.         sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
  3009.     End If
  3010.  
  3011.     sPrompt1$ = Replace$(sPrompt1$, "{min}", cstr$(iMin%))
  3012.     sPrompt1$ = Replace$(sPrompt1$, "{max}", cstr$(iMax%))
  3013.  
  3014.     bFinished% = FALSE
  3015.     Do
  3016.         Print sPrompt1$
  3017.  
  3018.         Input in$
  3019.         in$ = _Trim$(in$)
  3020.         If Len(in$) > 0 Then
  3021.             If IsNumber(in$) Then
  3022.                 iValue% = Val(in$)
  3023.                 If iValue% >= iMin% And iValue% <= iMax% Then
  3024.                     'bFinished% = TRUE
  3025.                     Exit Do
  3026.                 Else
  3027.                     Print "Number out of range."
  3028.                     Print
  3029.                 End If
  3030.             Else
  3031.                 Print "Not a valid number."
  3032.                 Print
  3033.             End If
  3034.         Else
  3035.             iValue% = iDefault%
  3036.             Exit Do
  3037.             'bFinished% = TRUE
  3038.         End If
  3039.     Loop Until bFinished% = TRUE
  3040.  
  3041.     PromptForIntegerInRange% = iValue%
  3042. End Function ' PromptForIntegerInRange%
  3043.  
  3044. ' /////////////////////////////////////////////////////////////////////////////
  3045. ' iNum& = PromptForLongInRange&("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
  3046.  
  3047. Function PromptForLongInRange& (sPrompt$, iMin&, iMax&, iDefault&)
  3048.     Dim iValue&
  3049.     Dim bFinished&
  3050.     Dim sPrompt1$
  3051.     Dim in$
  3052.    
  3053.     bFinished& = FALSE
  3054.     Do
  3055.         If Len(sPrompt$) > 0 Then
  3056.             sPrompt1$ = sPrompt$
  3057.         Else
  3058.             sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
  3059.         End If
  3060.        
  3061.         sPrompt1$ = Replace$ (sPrompt1$, "{min}", cstrl$(iMin&))
  3062.         sPrompt1$ = Replace$ (sPrompt1$, "{max}", cstrl$(iMax&))
  3063.        
  3064.         Input in$
  3065.         in$ = _Trim$(in$)
  3066.         If Len(in$) > 0 Then
  3067.             If IsNumber(in$) Then
  3068.                 iValue& = Val(in$)
  3069.                 If iValue& >= iMin& And iValue& <= iMax& Then
  3070.                     bFinished& = TRUE
  3071.                 Else
  3072.                     Print "Number out of range."
  3073.                     Print
  3074.                 End If
  3075.             Else
  3076.                 Print "Not a valid number."
  3077.                 Print
  3078.             End If
  3079.         Else
  3080.             iValue& = iDefault&
  3081.             bFinished& = TRUE
  3082.         End If
  3083.     Loop Until bFinished&
  3084.    
  3085.     PromptForLongInRange& = iValue&
  3086. End Function ' PromptForLongInRange&
  3087.  
  3088. ' /////////////////////////////////////////////////////////////////////////////
  3089. ' Returns blank if successful else returns error message.
  3090.  
  3091. Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
  3092.     'x = 1: y = 2: z$ = "Three"
  3093.  
  3094.     Dim sError As String: sError = ""
  3095.  
  3096.     If Len(sError) = 0 Then
  3097.         If (bAppend = TRUE) Then
  3098.             If _FileExists(sFileName) Then
  3099.                 Open sFileName For Append As #1 ' opens an existing file for appending
  3100.             Else
  3101.                 sError = "Error in PrintFile$ : File not found. Cannot append."
  3102.             End If
  3103.         Else
  3104.             Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
  3105.         End If
  3106.     End If
  3107.     If Len(sError) = 0 Then
  3108.         ' WRITE places text in quotes in the file
  3109.         'WRITE #1, x, y, z$
  3110.         'WRITE #1, sText
  3111.  
  3112.         ' PRINT does not put text inside quotes
  3113.         Print #1, sText
  3114.  
  3115.         Close #1
  3116.  
  3117.         'PRINT "File created with data. Press a key!"
  3118.         'K$ = INPUT$(1) 'press a key
  3119.  
  3120.         'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
  3121.         'INPUT #2, a, b, c$
  3122.         'CLOSE #2
  3123.  
  3124.         'PRINT a, b, c$
  3125.         'WRITE a, b, c$
  3126.     End If
  3127.  
  3128.     PrintFile$ = sError
  3129. End Function ' PrintFile$
  3130.  
  3131. ' /////////////////////////////////////////////////////////////////////////////
  3132. ' Generate random value between Min and Max.
  3133. Function RandomNumber% (Min%, Max%)
  3134.     Dim NumSpread%
  3135.  
  3136.     ' SET RANDOM SEED
  3137.     'Randomize ' Initialize random-number generator.
  3138.  
  3139.     ' GET RANDOM # Min%-Max%
  3140.     'RandomNumber = Int((Max * Rnd) + Min) ' generate number
  3141.  
  3142.     NumSpread% = (Max% - Min%) + 1
  3143.  
  3144.     RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
  3145.  
  3146. End Function ' RandomNumber%
  3147.  
  3148. ' /////////////////////////////////////////////////////////////////////////////
  3149.  
  3150. Sub RandomNumberTest
  3151.     Dim iCols As Integer: iCols = 10
  3152.     Dim iRows As Integer: iRows = 20
  3153.     Dim iLoop As Integer
  3154.     Dim iX As Integer
  3155.     Dim iY As Integer
  3156.     Dim sError As String
  3157.     Dim sFileName As String
  3158.     Dim sText As String
  3159.     Dim bAppend As Integer
  3160.     Dim iMin As Integer
  3161.     Dim iMax As Integer
  3162.     Dim iNum As Integer
  3163.     Dim iErrorCount As Integer
  3164.     Dim sInput$
  3165.  
  3166.     sFileName = "c:\temp\maze_test_1.txt"
  3167.     sText = "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random"
  3168.     bAppend = FALSE
  3169.     sError = PrintFile$(sFileName, sText, bAppend)
  3170.     If Len(sError) = 0 Then
  3171.         bAppend = TRUE
  3172.         iErrorCount = 0
  3173.  
  3174.         iMin = 0
  3175.         iMax = iCols - 1
  3176.         For iLoop = 1 To 100
  3177.             iNum = RandomNumber%(iMin, iMax)
  3178.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  3179.             sError = PrintFile$(sFileName, sText, bAppend)
  3180.             If Len(sError) > 0 Then
  3181.                 iErrorCount = iErrorCount + 1
  3182.                 Print Str$(iLoop) + ". ERROR"
  3183.                 Print "    " + "iMin=" + Str$(iMin)
  3184.                 Print "    " + "iMax=" + Str$(iMax)
  3185.                 Print "    " + "iNum=" + Str$(iNum)
  3186.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  3187.                 Print "    " + sError
  3188.             End If
  3189.         Next iLoop
  3190.  
  3191.         iMin = 0
  3192.         iMax = iRows - 1
  3193.         For iLoop = 1 To 100
  3194.             iNum = RandomNumber%(iMin, iMax)
  3195.             sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
  3196.             sError = PrintFile$(sFileName, sText, bAppend)
  3197.             If Len(sError) > 0 Then
  3198.                 iErrorCount = iErrorCount + 1
  3199.                 Print Str$(iLoop) + ". ERROR"
  3200.                 Print "    " + "iMin=" + Str$(iMin)
  3201.                 Print "    " + "iMax=" + Str$(iMax)
  3202.                 Print "    " + "iNum=" + Str$(iNum)
  3203.                 Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
  3204.                 Print "    " + sError
  3205.             End If
  3206.         Next iLoop
  3207.  
  3208.         Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
  3209.     Else
  3210.         Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
  3211.         Print sError
  3212.     End If
  3213.  
  3214.     Input "Press <ENTER> to continue", sInput$
  3215. End Sub ' RandomNumberTest
  3216.  
  3217. ' /////////////////////////////////////////////////////////////////////////////
  3218. ' FROM: String Manipulation
  3219. ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
  3220. '
  3221. 'SUMMARY:
  3222. '   Purpose:  A library of custom functions that transform strings.
  3223. '   Author:   Dustinian Camburides (dustinian@gmail.com)
  3224. '   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
  3225. '   Revision: 1.6
  3226. '   Updated:  5/28/2012
  3227.  
  3228. 'SUMMARY:
  3229. '[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
  3230. 'INPUT:
  3231. 'Text: The input string; the text that's being manipulated.
  3232. 'Find: The specified sub-string; the string sought within the [Text] string.
  3233. 'Add: The sub-string that's being added to the [Text] string.
  3234.  
  3235. Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
  3236.     ' VARIABLES:
  3237.     Dim Text2 As String
  3238.     Dim Find2 As String
  3239.     Dim Add2 As String
  3240.     Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
  3241.     Dim strBefore As String ' The characters before the string to be replaced.
  3242.     Dim strAfter As String ' The characters after the string to be replaced.
  3243.  
  3244.     ' INITIALIZE:
  3245.     ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
  3246.     Text2 = Text1
  3247.     Find2 = Find1
  3248.     Add2 = Add1
  3249.  
  3250.     lngLocation = InStr(1, Text2, Find2)
  3251.  
  3252.     ' PROCESSING:
  3253.     ' While [Find2] appears in [Text2]...
  3254.     While lngLocation
  3255.         ' Extract all Text2 before the [Find2] substring:
  3256.         strBefore = Left$(Text2, lngLocation - 1)
  3257.  
  3258.         ' Extract all text after the [Find2] substring:
  3259.         strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
  3260.  
  3261.         ' Return the substring:
  3262.         Text2 = strBefore + Add2 + strAfter
  3263.  
  3264.         ' Locate the next instance of [Find2]:
  3265.         lngLocation = InStr(1, Text2, Find2)
  3266.  
  3267.         ' Next instance of [Find2]...
  3268.     Wend
  3269.  
  3270.     ' OUTPUT:
  3271.     Replace$ = Text2
  3272. End Function ' Replace$
  3273.  
  3274. ' /////////////////////////////////////////////////////////////////////////////
  3275. ' fantastically inefficient way to set a bit
  3276.  
  3277. ' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
  3278.  
  3279. ' See also: GetBit256%, SetBit256%
  3280.  
  3281. ' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
  3282. Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
  3283.     Dim sNum As String
  3284.     Dim sBit As String
  3285.     Dim sVal As String
  3286.     Dim iLoop As Integer
  3287.     Dim strResult As String
  3288.     Dim iResult As Integer
  3289.     Dim iNum As Integer: iNum = iNum1
  3290.     Dim iBit As Integer: iBit = iBit1
  3291.     Dim bVal As Integer: bVal = bVal1
  3292.  
  3293.     If iNum < 256 And iBit <= 128 Then
  3294.         sNum = GetBinary$(iNum)
  3295.         sBit = GetBinary$(iBit)
  3296.         If bVal = TRUE Then
  3297.             sVal = "1"
  3298.         Else
  3299.             sVal = "0"
  3300.         End If
  3301.         strResult = ""
  3302.         For iLoop = 1 To 8
  3303.             If Mid$(sBit, iLoop, 1) = "1" Then
  3304.                 strResult = strResult + sVal
  3305.             Else
  3306.                 strResult = strResult + Mid$(sNum, iLoop, 1)
  3307.             End If
  3308.         Next iLoop
  3309.         iResult = GetIntegerFromBinary%(strResult)
  3310.     Else
  3311.         iResult = iNum
  3312.     End If
  3313.  
  3314.     SetBit256% = iResult
  3315. End Function ' SetBit256%
  3316.  
  3317. ' /////////////////////////////////////////////////////////////////////////////
  3318. ' Split and join strings
  3319. ' https://www.qb64.org/forum/index.php?topic=1073.0
  3320. '
  3321. ' FROM luke, QB64 Developer
  3322. ' Date: February 15, 2019, 04:11:07 AM »
  3323. '
  3324. ' Given a string of words separated by spaces (or any other character),
  3325. ' splits it into an array of the words. I've no doubt many people have
  3326. ' written a version of this over the years and no doubt there's a million
  3327. ' ways to do it, but I thought I'd put mine here so we have at least one
  3328. ' version. There's also a join function that does the opposite
  3329. ' array -> single string.
  3330. '
  3331. ' Code is hopefully reasonably self explanatory with comments and a little demo.
  3332. ' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
  3333.  
  3334. 'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
  3335. 'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
  3336. '
  3337. 'delimiter$ must be one character long.
  3338. 'result$() must have been REDIMmed previously.
  3339.  
  3340. Sub split (in$, delimiter$, result$())
  3341.     ReDim result$(-1)
  3342.     start = 1
  3343.     Do
  3344.         While Mid$(in$, start, 1) = delimiter$
  3345.             start = start + 1
  3346.             If start > Len(in$) Then Exit Sub
  3347.         Wend
  3348.         finish = InStr(start, in$, delimiter$)
  3349.         If finish = 0 Then finish = Len(in$) + 1
  3350.         ReDim _Preserve result$(0 To UBound(result$) + 1)
  3351.         result$(UBound(result$)) = Mid$(in$, start, finish - start)
  3352.         start = finish + 1
  3353.     Loop While start <= Len(in$)
  3354. End Sub ' split
  3355.  
  3356. ' /////////////////////////////////////////////////////////////////////////////
  3357.  
  3358. Sub SplitTest
  3359.  
  3360.     Dim in$
  3361.     Dim delim$
  3362.     ReDim arrTest$(0)
  3363.     Dim iLoop%
  3364.  
  3365.     delim$ = Chr$(10)
  3366.     in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
  3367.     Print "in$ = " + Chr$(34) + in$ + Chr$(34)
  3368.     Print "delim$ = " + Chr$(34) + delimeter$ + Chr$(34)
  3369.     split in$, delim$, arrTest$()
  3370.  
  3371.     For iLoop% = LBound(arrTest$) To UBound(arrTest$)
  3372.         Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
  3373.     Next iLoop%
  3374.     Print
  3375.     Print "Split test finished."
  3376. End Sub ' SplitTest
  3377.  
  3378. ' /////////////////////////////////////////////////////////////////////////////
  3379.  
  3380. Sub WaitForEnter
  3381.     Dim in$
  3382.     Input "Press <ENTER> to continue", in$
  3383. End Sub ' WaitForEnter
  3384.  
  3385. ' /////////////////////////////////////////////////////////////////////////////
  3386. ' WaitForKey "Press <ESC> to continue", 27, 0
  3387. ' WaitForKey "Press <ENTER> to begin;", 13, 0
  3388. ' waitforkey "", 65, 5
  3389.  
  3390. Sub WaitForKey (prompt$, KeyCode&, DelaySeconds%)
  3391.     ' SHOW PROMPT (IF SPECIFIED)
  3392.     If Len(prompt$) > 0 Then
  3393.         If Right$(prompt$, 1) <> ";" Then
  3394.             Print prompt$
  3395.         Else
  3396.             Print Right$(prompt$, Len(prompt$) - 1);
  3397.         End If
  3398.     End If
  3399.  
  3400.     ' WAIT FOR KEY
  3401.     Do: Loop Until _KeyDown(KeyCode&) ' leave loop when specified key pressed
  3402.  
  3403.     ' PAUSE AFTER (IF SPECIFIED)
  3404.     If DelaySeconds% < 1 Then
  3405.         _KeyClear: '_DELAY 1
  3406.     Else
  3407.         _KeyClear: _Delay DelaySeconds%
  3408.     End If
  3409. End Sub ' WaitForKey
  3410.  
  3411. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3412. ' END GENERAL PURPOSE FUNCTIONS
  3413. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3414.  
  3415. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3416. ' BEGIN COLOR ROUTINES
  3417. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3418.  
  3419. ' /////////////////////////////////////////////////////////////////////////////
  3420. ' Receives:
  3421. ' cycleColor = determines how foreColor, backColor are modified
  3422. ' foreColor  = the foreground color
  3423. ' backColor  = the background color (if needed)
  3424.  
  3425. ' /////////////////////////////////////////////////////////////////////////////
  3426. ' DoCycleColor colorScheme%, myColor&
  3427.  
  3428. ' colorScheme = color scheme (value is alternated on subsequent calls)
  3429. ' myColor     = the current color (value is incremented/decremented on subsequent calls)
  3430.  
  3431. ' colorScheme values:
  3432. '  1 Rainbow6 #1
  3433. '  9 Rainbow6 #2
  3434. '  2 Rainbow18 #1
  3435. ' 10 Rainbow18 #2
  3436. '  3 Grayscale #1
  3437. ' 11 Grayscale #2
  3438. '  4 Grayscale #1
  3439. ' 12 Grayscale #2
  3440.  
  3441. Sub DoCycleColor (colorScheme As Integer, myColor As Long)
  3442.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
  3443.     ' CYCLE FORE COLOR
  3444.  
  3445.     ' 1, 5, 9 = simple rainbow
  3446.     If colorScheme = 1 Or colorScheme = 9 Then
  3447.         Select Case myColor
  3448.             Case cRed&:
  3449.                 myColor = cOrange&
  3450.             Case cOrange&:
  3451.                 myColor = cYellow&
  3452.             Case cYellow&:
  3453.                 myColor = cGreen&
  3454.             Case cGreen&:
  3455.                 myColor = cBlue&
  3456.             Case cBlue&:
  3457.                 myColor = cPurple&
  3458.             Case Else:
  3459.                 myColor = cRed&
  3460.         End Select
  3461.  
  3462.     ' 2, 6, 10 = complex rainbow
  3463.     ElseIf colorScheme = 2 Or colorScheme = 10 Then
  3464.         Select Case myColor
  3465.             Case cRed&:
  3466.                 myColor = cOrangeRed&
  3467.             Case cOrangeRed&:
  3468.                 myColor = cDarkOrange&
  3469.             Case cDarkOrange&:
  3470.                 myColor = cOrange&
  3471.             Case cOrange&:
  3472.                 myColor = cGold&
  3473.             Case cGold&:
  3474.                 myColor = cYellow&
  3475.             Case cYellow&:
  3476.                 myColor = cChartreuse&
  3477.             Case cChartreuse&:
  3478.                 myColor = cLime&
  3479.             Case cLime&:
  3480.                 myColor = cMediumSpringGreen&
  3481.             Case cMediumSpringGreen&:
  3482.                 myColor = cCyan&
  3483.             Case cCyan&:
  3484.                 myColor = cDeepSkyBlue&
  3485.             Case cDeepSkyBlue&:
  3486.                 myColor = cDodgerBlue&
  3487.             Case cDodgerBlue&:
  3488.                 myColor = cSeaBlue&
  3489.             Case cSeaBlue&:
  3490.                 myColor = cBlue&
  3491.             Case cBlue&:
  3492.                 myColor = cBluePurple&
  3493.             Case cBluePurple&:
  3494.                 myColor = cDeepPurple&
  3495.             Case cDeepPurple&:
  3496.                 myColor = cPurple&
  3497.             Case cPurple&:
  3498.                 myColor = cPurpleRed&
  3499.             Case Else:
  3500.                 myColor = cRed&
  3501.         End Select
  3502.  
  3503.     ' 3, 7, 11 = grayscale, ascending
  3504.     ElseIf colorScheme = 3 Or colorScheme = 11 Then
  3505.         Select Case myColor
  3506.             Case cBlack&:
  3507.                 myColor = cDarkGray&
  3508.             Case cDarkGray&:
  3509.                 myColor = cDimGray&
  3510.             Case cDimGray&:
  3511.                 myColor = cGray&
  3512.             Case cGray&:
  3513.                 myColor = cLightGray&
  3514.             Case cLightGray&:
  3515.                 myColor = cSilver&
  3516.             Case cSilver&:
  3517.                 myColor = cWhite&
  3518.             Case Else:
  3519.                 'myColor = cBlack&
  3520.                 myColor = cSilver&
  3521.  
  3522.                 ' go in the other direction!
  3523.                 If colorScheme = 3 Then
  3524.                     colorScheme = 4
  3525.                 Else
  3526.                     colorScheme = 12
  3527.                 End If
  3528.  
  3529.         End Select
  3530.  
  3531.     ' 4, 8, 12 = grayscale, descending
  3532.     ElseIf colorScheme = 4 Or colorScheme = 12 Then
  3533.         Select Case myColor
  3534.             Case cWhite&:
  3535.                 myColor = cSilver&
  3536.             Case cSilver&:
  3537.                 myColor = cLightGray&
  3538.             Case cLightGray&:
  3539.                 myColor = cGray&
  3540.             Case cGray&:
  3541.                 myColor = cDimGray&
  3542.             Case cDimGray&:
  3543.                 myColor = cDarkGray&
  3544.             Case cDarkGray&:
  3545.                 myColor = cBlack&
  3546.             Case Else:
  3547.                 myColor = cDarkGray&
  3548.  
  3549.                 ' go in the other direction!
  3550.                 If colorScheme = 4 Then
  3551.                     colorScheme = 3
  3552.                 Else
  3553.                     colorScheme = 11
  3554.                 End If
  3555.         End Select
  3556.  
  3557.     End If
  3558.    
  3559. End Sub ' DoCycleColor
  3560.  
  3561. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3562. ' END COLOR ROUTINES
  3563. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3564.  
  3565. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3566. ' BEGIN COLOR FUNCTIONS
  3567. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3568.  
  3569. ' NOTE: these are mostly negative numbers
  3570. '       and have to be forced to positive
  3571. '       when stored in the dictionary
  3572. '       (only cEmpty& should be negative)
  3573.  
  3574. Function cRed& ()
  3575.     cRed& = _RGB32(255, 0, 0)
  3576.  
  3577. Function cOrangeRed& ()
  3578.     cOrangeRed& = _RGB32(255, 69, 0)
  3579. End Function ' cOrangeRed&
  3580.  
  3581. Function cDarkOrange& ()
  3582.     cDarkOrange& = _RGB32(255, 140, 0)
  3583. End Function ' cDarkOrange&
  3584.  
  3585. Function cOrange& ()
  3586.     cOrange& = _RGB32(255, 165, 0)
  3587. End Function ' cOrange&
  3588.  
  3589. Function cGold& ()
  3590.     cGold& = _RGB32(255, 215, 0)
  3591. End Function ' cGold&
  3592.  
  3593. Function cYellow& ()
  3594.     cYellow& = _RGB32(255, 255, 0)
  3595. End Function ' cYellow&
  3596.  
  3597. Function cChartreuse& ()
  3598.     cChartreuse& = _RGB32(127, 255, 0)
  3599. End Function ' cChartreuse&
  3600.  
  3601. Function cLime& ()
  3602.     cLime& = _RGB32(0, 255, 0)
  3603. End Function ' cLime&
  3604.  
  3605. Function cMediumSpringGreen& ()
  3606.     cMediumSpringGreen& = _RGB32(0, 250, 154)
  3607. End Function ' cMediumSpringGreen&
  3608.  
  3609. Function cCyan& ()
  3610.     cCyan& = _RGB32(0, 255, 255)
  3611. End Function ' cCyan&
  3612.  
  3613. Function cDeepSkyBlue& ()
  3614.     cDeepSkyBlue& = _RGB32(0, 191, 255)
  3615. End Function ' cDeepSkyBlue&
  3616.  
  3617. Function cDodgerBlue& ()
  3618.     cDodgerBlue& = _RGB32(30, 144, 255)
  3619. End Function ' cDodgerBlue&
  3620.  
  3621. Function cSeaBlue& ()
  3622.     cSeaBlue& = _RGB32(0, 64, 255)
  3623. End Function ' cSeaBlue&
  3624.  
  3625. Function cBlue& ()
  3626.     cBlue& = _RGB32(0, 0, 255)
  3627. End Function ' cBlue&
  3628.  
  3629. Function cBluePurple& ()
  3630.     cBluePurple& = _RGB32(64, 0, 255)
  3631. End Function ' cBluePurple&
  3632.  
  3633. Function cDeepPurple& ()
  3634.     cDeepPurple& = _RGB32(96, 0, 255)
  3635. End Function ' cDeepPurple&
  3636.  
  3637. Function cPurple& ()
  3638.     cPurple& = _RGB32(128, 0, 255)
  3639. End Function ' cPurple&
  3640.  
  3641. Function cPurpleRed& ()
  3642.     cPurpleRed& = _RGB32(128, 0, 192)
  3643. End Function ' cPurpleRed&
  3644.  
  3645. Function cDarkRed& ()
  3646.     cDarkRed& = _RGB32(160, 0, 64)
  3647. End Function ' cDarkRed&
  3648.  
  3649. Function cBrickRed& ()
  3650.     cBrickRed& = _RGB32(192, 0, 32)
  3651. End Function ' cBrickRed&
  3652.  
  3653. Function cDarkGreen& ()
  3654.     cDarkGreen& = _RGB32(0, 100, 0)
  3655. End Function ' cDarkGreen&
  3656.  
  3657. Function cGreen& ()
  3658.     cGreen& = _RGB32(0, 128, 0)
  3659. End Function ' cGreen&
  3660.  
  3661. Function cOliveDrab& ()
  3662.     cOliveDrab& = _RGB32(107, 142, 35)
  3663. End Function ' cOliveDrab&
  3664.  
  3665. Function cLightPink& ()
  3666.     cLightPink& = _RGB32(255, 182, 193)
  3667. End Function ' cLightPink&
  3668.  
  3669. Function cHotPink& ()
  3670.     cHotPink& = _RGB32(255, 105, 180)
  3671. End Function ' cHotPink&
  3672.  
  3673. Function cDeepPink& ()
  3674.     cDeepPink& = _RGB32(255, 20, 147)
  3675. End Function ' cDeepPink&
  3676.  
  3677. Function cMagenta& ()
  3678.     cMagenta& = _RGB32(255, 0, 255)
  3679. End Function ' cMagenta&
  3680.  
  3681. Function cBlack& ()
  3682.     cBlack& = _RGB32(0, 0, 0)
  3683. End Function ' cBlack&
  3684.  
  3685. Function cDimGray& ()
  3686.     cDimGray& = _RGB32(105, 105, 105)
  3687. End Function ' cDimGray&
  3688.  
  3689. Function cGray& ()
  3690.     cGray& = _RGB32(128, 128, 128)
  3691. End Function ' cGray&
  3692.  
  3693. Function cDarkGray& ()
  3694.     cDarkGray& = _RGB32(169, 169, 169)
  3695. End Function ' cDarkGray&
  3696.  
  3697. Function cSilver& ()
  3698.     cSilver& = _RGB32(192, 192, 192)
  3699. End Function ' cSilver&
  3700.  
  3701. Function cLightGray& ()
  3702.     cLightGray& = _RGB32(211, 211, 211)
  3703. End Function ' cLightGray&
  3704.  
  3705. Function cGainsboro& ()
  3706.     cGainsboro& = _RGB32(220, 220, 220)
  3707. End Function ' cGainsboro&
  3708.  
  3709. Function cWhiteSmoke& ()
  3710.     cWhiteSmoke& = _RGB32(245, 245, 245)
  3711. End Function ' cWhiteSmoke&
  3712.  
  3713. Function cWhite& ()
  3714.     cWhite& = _RGB32(255, 255, 255)
  3715. End Function ' cWhite&
  3716.  
  3717. Function cDarkBrown& ()
  3718.     cDarkBrown& = _RGB32(128, 64, 0)
  3719. End Function ' cDarkBrown&
  3720.  
  3721. Function cLightBrown& ()
  3722.     cLightBrown& = _RGB32(196, 96, 0)
  3723. End Function ' cLightBrown&
  3724.  
  3725. Function cKhaki& ()
  3726.     cKhaki& = _RGB32(240, 230, 140)
  3727. End Function ' cKhaki&
  3728.  
  3729. Function cEmpty& ()
  3730.     cEmpty& = -1
  3731. End Function ' cEmpty&
  3732.  
  3733. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3734. ' END COLOR FUNCTIONS
  3735. ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3736.  
  3737.  
« Last Edit: December 09, 2021, 11:31:46 pm by madscijr »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: WIP: Isometric Demo re-revisited v2.82 (can now change viewing angle)
« Reply #1 on: December 09, 2021, 02:27:03 pm »
A minor point, it's actually = not + that increases size.

I look forward to Christmas themed scene, I am pretty sure you can do a tree as a square pyramid but if you stack circles of various diameter... :)

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
Re: WIP: Isometric Demo re-revisited v2.82 (can now change viewing angle)
« Reply #2 on: December 09, 2021, 04:45:26 pm »
A minor point, it's actually = not + that increases size.

True. I just updated the code above with that and some other minor changes.

The variable keymapping was all messed up: the direction a given key moves you should change based on your viewing orientation, but it was doing weird stuff like moving the cursor diagonally, off the grid, etc. I have idea yet what's wrong with it, so I just reverted to the hardcoded values so it works. Will return to that later.


I look forward to Christmas themed scene, I am pretty sure you can do a tree as a square pyramid but if you stack circles of various diameter... :)

Now that the base functionality is down, I can begin...
« Last Edit: December 09, 2021, 06:42:49 pm by madscijr »

Offline madscijr

  • Seasoned Forum Regular
  • Posts: 295
    • View Profile
One last update for this post, fixed a couple annoying bugs/non-features with the keyboard input.
Repeating keys now works.