' ################################################################################################################################################################
' Isomatric mapping demo re-revisited
' Version 2.90 by madscijr
' Based on Isometric Mapping Demo
' by SMcNeill, bplus, and others at
' https://www.qb64.org/forum/index.php?topic=1903.30
' This crude version uses a 3-dimensional array (32x32x32)
' to store cubes of different colors,
' and draws them to the screen in 2.5D "isometric".
' -----------------------------------------------------------------------------
' DONE:
' * Render cubes that block the view of the player as transparent.
' * 2-D top down "map" view of the player's current Z slice.
' * variable grid size
' * change arrMap to global shared variable (for simpler code) & rename m_arrMap
' * allow player to rotate their view
' * preliminary multiplayer changes
' - move player info into array (upto 4 players)
' - key mapping variables
' * fixed some keyboard input (repeating keys, continuous motion)
' * fixed right point of view bug where x & y coordinates were reversed
' * preliminary multiplayer changes
' - split screen display (4, 6, or 8?)
' + for now display player 1's world rotated in each window (for editor)
' * x4: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
' * x6: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
' * x8: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, (none), (none)
' + will eventually be one per player
' * 2D minimap background = cKhaki&
' * , and . change minimap size
' -----------------------------------------------------------------------------
' TO DO:
' * editor v1 = simple drawing program
' - add type RecordType to hold recording steps
' - add array m_arrRecord of RecordType to hold recording
' - display available tiles/colors/etc. at bottom of screen
' + 40 colors including empty
' + 07 tiles (empty, floor, wall)
' - cursor places tiles (ENTER = add/delete at current space)
' - 0-9 keys cycle through tiles/colors
' - save screens to file (stored as editable text)
' + FORMAT: [tile=t][color@x,y,z][color@x,y,z][color@x,y,z]...
' - load screens into array m_arrRecord
' + PARSER:
' 1. replace all ][ with [
' 2. split by "[" into simple 1D array
' 3. each element is either "tile=t" or "plot=color@x,y,z"
' 4. parse data into array to playback recording
' [n][0] = command
' -1 = select tile "tile=t"
' 0+ = color to plot "color@x,y,z"
' [n][1] = parameter #1 = tile
' [n][2] = parameter #2 = x
' [n][3] = parameter #3 = y
' [n][3] = parameter #4 = z
' - run commands in m_arrRecord to plot tiles and display
' * rotating view changes orientation of keys (get it working)
' -----------------------------------------------------------------------------
' * add parameters to tiles
' * - color scheme (for cycle colors)
' * add tiles
' - transparent lights (blinking / cycle colors)
' - gravity tiles (fall if no tiles underneath)
' * editor v2 = simple animation program
' - records cursor movements and adding/deleting tiles
' - press key to record a "frame"
' + flash screen + play a sound
' - can change animation speed
' - realtime=on command enables redrawing screen every step (until realtime=off command encountered)
' - playback mode recreates editing actions
' - playback updates screen every "update"
' - tweak save format (still editable text)
' + 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]...
' + PARSER:
' 1. replace all ][ with [
' 2. split by "[" into simple 1D array
' 3. each element is either "color@x,y,z", "tile=t", "cls", "update", "speed=s", "realtime=on", "realtime=off", "rotate=d"
' 4. parse array into array of LONG for playback
' [n].Command
' -7 = rotate point of view (up, down, left, right, back, forward) "rotate=d"
' -6 = disable screen update every step "realtime=off"
' -5 = enable screen update every step "realtime=on"
' -4 = set speed "speed=s"
' -3 = update screen "update"
' -2 = clear screen "cls"
' -1 = select tile "tile=t"
' 0+ = color to plot "color@x,y,z"
' [n].Param1 = parameter #1 = tile, speed, direction
' [n].Param2 = parameter #2 = x
' [n].Param3 = parameter #3 = y
' [n].Param4 = parameter #4 = z
' - effects of gravity (from bottom up, ie z=0 to z=max)
' -----------------------------------------------------------------------------
' * expand world to bigger than screen (2.5d scrolling view)
' * editor v3 = mouse
' - mouse movement controls cursor x,y position
' - mouse wheel controls z position
' - left click draws a tile
' - right click erases a tile
' - ENTER records a frame
' - Add animation playback command:
' [n][0] = command
' -8 = enable user to rotate image in realtime with mouse? "mouse=on"
' -----------------------------------------------------------------------------
' TO DO (LATER):
' * local multiplayer (2-4 players)
' - split screen (x2 or x4)
' * fix/control screen placement/rendering/scroll boundaries for grid sizes
' (to not overwrite other players, go off screen, etc., when grid size changes)
' * auto-rotate view depending on direction player is facing
' * control the x/y/z slice axis, for a cutaway view
' * gravity (players stay on ground, can fall)
' * player can climb up to next level if it is 1 tile higher
' * add ability to jump over 1 space
' * option to remap keys
' * support game controllers
' * game controller calibration/mapping function
' * option to hide objects out of player's line-of-sight
' * show player as a stick figure (like "Realm of Impossibility")
' * walking movement
' * add tiles (water, ladders, steps, ropes, windows, doors, etc.)
' * add toggle tiles - door "opens" when triggered
' * triggers
' * add tiles
' - Water = transparent blue)
' - Window = more transparent cyan)
' * add directional tiles (can be rotated?)
' - ladder
' - bridge
' - hand-over-hand bars?
' - Slope45 = 45° slope <- 4 or 6 directions?
' - InvSlope45 = 45° inverted slope <- 4 or 6 directions?
' - Pyramid45 = 45° pyramid "cap stone" <- 4 or 6 directions?
' - ramp (player can walk up/down slope45)
' * add ability to climb ladders + climbing animation
' * add ability to walk up ramps with smooth z-movement inbetween tiles
' * add ability to climb monkey bars (animation like lode runner)
' * simultaneously show additional 1st person view
' * add ability for tilting head up/down in first person
' * simple open world (players can add/remove tiles, build in real time)
' * make simple games (maze craze, capture the flag, snake, surround, 2.5d pong)
' * make more complex games (berzerk, lode runner, atari combat / tank)
' * make awesome complex games (2.5d lunar lander, atari adventure, asteroids, gravitar, etc.)
' * text adventure features (to create graphic Infocom or Scott Adams style games)
' ################################################################################################################################################################
' =============================================================================
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' -----------------------------------------------------------------------------
' boolean constants
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' KeyDownConstants
' -----------------------------------------------------------------------------
Const c_iKeyDown_Esc
= 27 Const c_iKeyDown_F1
= 15104 Const c_iKeyDown_F2
= 15360 Const c_iKeyDown_F3
= 15616 Const c_iKeyDown_F4
= 15872 Const c_iKeyDown_F5
= 16128 Const c_iKeyDown_F6
= 16384 Const c_iKeyDown_F7
= 16640 Const c_iKeyDown_F8
= 16896 Const c_iKeyDown_F9
= 17152 Const c_iKeyDown_F10
= 17408 Const c_iKeyDown_Tilde
= 96 Const c_iKeyDown_Minus
= 45 Const c_iKeyDown_EqualPlus
= 61 Const c_iKeyDown_BkSp
= 8 Const c_iKeyDown_Ins
= 20992 Const c_iKeyDown_Home
= 18176 Const c_iKeyDown_PgUp
= 18688 Const c_iKeyDown_Del
= 21248 Const c_iKeyDown_End
= 20224 Const c_iKeyDown_PgDn
= 20736 Const c_iKeyDown_KEYPAD_7_Home
= 18176 Const c_iKeyDown_KEYPAD_8_Up
= 18432 Const c_iKeyDown_KEYPAD_9_PgUp
= 18688 Const c_iKeyDown_KEYPAD_4_Left
= 19200 Const c_iKeyDown_KEYPAD_6_Right
= 19712 Const c_iKeyDown_KEYPAD_1_End
= 20224 Const c_iKeyDown_KEYPAD_2_Down
= 20480 Const c_iKeyDown_KEYPAD_3_PgDn
= 20736 Const c_iKeyDown_KEYPAD_0_Ins
= 20992 Const c_iKeyDown_KEYPAD_Period_Del
= 21248 Const c_iKeyDown_Pipe
= 105 Const c_iKeyDown_BracketLeft
= 91 Const c_iKeyDown_BracketRight
= 93 Const c_iKeyDown_Backslash
= 92 Const c_iKeyDown_SemiColon
= 59 Const c_iKeyDown_Apostrophe
= 39 Const c_iKeyDown_Enter
= 13 Const c_iKeyDown_Comma
= 44 Const c_iKeyDown_Period
= 46 Const c_iKeyDown_Slash
= 47 Const c_iKeyDown_Up
= 18432 Const c_iKeyDown_Left
= 19200 Const c_iKeyDown_Down
= 20480 Const c_iKeyDown_Right
= 19712 Const c_iKeyDown_Spacebar
= 32
' -----------------------------------------------------------------------------
' Tile value constants for map (MapTileType.Typ)
' -----------------------------------------------------------------------------
Const c_iMapType_Empty
= 0 Const c_iMapType_Floor_Tiled
= 1 Const c_iMapType_Wall
= 2 Const c_iMapType_Water
= 3 Const c_iMapType_Window
= 4 Const c_iMapType_Player1
= 5 Const c_iMapType_Player2
= 6 Const c_iMapType_Player3
= 7 Const c_iMapType_Player4
= 8 Const c_iMapType_Blinking_Light
= 9 Const c_iMapType_Gravity_Tile
= 10 Const c_iMapType_Slope45
= 11 Const c_iMapType_InvSlope45
= 12
' -----------------------------------------------------------------------------
' constants for 2.5D movement
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' constants for drawing the 2.5D screen
' -----------------------------------------------------------------------------
Const cScreenOffsetX
= 500 ' 450 Const cScreenOffsetY
= 300 ' 50
' =============================================================================
' USER DEFINED TYPES
' =============================================================================
Typ
As Integer ' c_iMapType_Empty, c_iMap_Floor_Tiled, c_iMap_Wall, etc. 'Vis As Integer ' TRUE = visible, FALSE = don't render
'Lit As Long ' light offset
Color2
As Long ' secondary color if needed Color3
As Long ' third color if needed Alpha1
As Long ' transparency of tile Color1 Alpha2
As Long ' transparency of tile Color2 Alpha3
As Long ' transparency of tile Color3 AlphaOverride
As Integer ' can be used to override alpha (0 treated as opaque)
' UDT TO HOLD THE INFO FOR A PLAYER
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 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 Tile1
As Long ' later we will instead use directional animation sequences
'Color2 As Long ' secondary color if needed
'Color3 As Long ' third color if needed
Alpha1
As Long ' transparency of player Color1 'Alpha2 As Long ' transparency of player Color2
'Alpha3 As Long ' transparency of player Color3
ColorScheme1
As Long ' for cycling colors
'ColorScheme2 As Long ' for cycling colors
'ColorSchemeSpeed2 As Long
'ColorSchemeCount2 As Long
'ColorScheme3 As Long ' for cycling colors
'ColorSchemeSpeed3 As Long
'ColorSchemeCount3 As Long
AlphaOverride
As Integer ' can be used to override alpha (0 treated as opaque)
'hx AS Integer ' home base x position
'hy AS Integer ' home base y position
'ex AS Integer ' exit x position
'ey AS Integer ' exit y position
'wins AS Integer ' count # of wins
'points AS Long ' count points (more points for harder)
'difficulty AS Integer ' 1-5, from 1 (easiest, maze width 5) to 5 (hardest, maze width 1). Each win awards {difficulty} # of points.
'speed AS Integer ' the higher the faster
'delay AS Integer ' counter, player can move based on speed
'bit AS Integer ' bit value for masking player in map
'rows AS Integer ' # of rows in player's maze
'cols AS Integer ' # of columns in player's maze
' KEY MAPPING v1
' UDT TO HOLD THE KEY MAPPINGS
' SPLIT SCREEN OFFSETS
' =============================================================================
' GLOBAL VARIABLES
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!
' Max # tiles in (32x32x32) world = 32,768
' Max # tiles for 16 (32x32x32) worlds = 524,288
' Max # tiles for 256 (32x32x32) worlds = 8,388,608
Dim Shared m_arrMap
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrRender
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrPlayer
(m_iPlayerMin
To m_iPlayerMax
) As PlayerType
Dim Shared m_arrRecord
(m_iRecordMin
To m_iRecordMax
) As RecordType
' For each player, map the 6 directional keys differently for each of the 6 directional orientations!
Dim Shared m_arrDirKeyMap
(m_iPlayerMin
To m_iPlayerMax
, c_iDir_Min
To c_iDir_Max
) As DirKeyMapType
' Store offsets for splitscreen
Dim Shared m_arrSplitScreen
(m_iPlayerMin
To m_iPlayerMax
) As SplitScreenType
' =============================================================================
' LOCAL VARIABLES
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
_Echo "Started " + m_ProgramName$
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
System ' return control to the operating system Print m_ProgramName$
+ " finished." Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
' /////////////////////////////////////////////////////////////////////////////
Print "Isomatric Mapping Demo Re-visited" Print "v2.90, by Softintheheadware (Dec, 2021)" 'PRINT "CONTROLS: PRESS <ESC> TO RETURN TO MENU"
'PRINT "PLAYER LEFT RIGHT UP DOWN "
'PRINT "1 CRSR LEFT CRSR RIGHT CRSR UP CRSR DOWN "
'PRINT "2 KEYPAD 4 KEYPAD 6 KEYPAD 8 KEYPAD 2 "
'PRINT "3 A S W Z "
'PRINT "4 J K I M "
'PRINT
Print "1. IsometricDemo1" Print "2. IsometricDemo2" Print "3. Move around in 2.5D" Print "What to do? ('q' to exit)"
result$ = IsometricDemo1
result$ = IsometricDemo2
result$ = IsometricDemo3
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "IsometricDemo1"
' INITIALIZE
'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
iGridSize = 10
' =============================================================================
' MAIN LOOP
bQuit = FALSE
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
ClearIsometricMap
' -----------------------------------------------------------------------------
' DRAW FLOOR
iZ% = m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Floor_Tiled
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = cGray&
m_arrMap(iLoopX%, iLoopY%, iZ%).Color2 = cLightGray&
' -----------------------------------------------------------------------------
' DRAW TILES TO CHECK ORIENTATION
FOR iLoopZ%
= m_iMapMinZ
+ 1 TO m_iMapMaxZ
m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
'm_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
'm_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
'm_arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
'm_arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Color1 = cOrange&
'
'm_arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
'm_arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Color1 = cPurple&
'
'm_arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
'm_arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Color1 = cLime&
'
'm_arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
'm_arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Color1 = cCyan&
' -----------------------------------------------------------------------------
' DRAW SOME OBJECTS
iX% = 16
iY% = 3
iNextColor& = cRed&
iLoopZ% = 1
iLoopY% = iY%
For iLoopX%
= iX%
To (iX%
+ 10) m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
iNextColor& = cBlue&
iLoopZ% = 1
iLoopY% = iY% + 8
For iLoopX%
= iX%
To (iX%
+ 10) m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
iNextColor& = cGreen&
iLoopZ% = 1
iLoopX% = iX% + 1
For iLoopY%
= (iY%
+ 1) To (iY%
+ 7) m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
iNextColor& = cYellow&
iLoopZ% = 1
iLoopX% = iX% + 9
For iLoopY%
= (iY%
+ 1) To (iY%
+ 7) m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
' -----------------------------------------------------------------------------
' DRAW A PYRAMID
iX% = 2
iY% = 18
iZ% = 1
iPosX1% = iX%
iPosX2% = iX% + 10
iPosY1% = iY%
iPosY2% = iY% + 10
iNextColor& = cRed&
iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
bContinue = TRUE
' PLOT NEXT LEVEL
For iLoopX%
= iPosX1%
To iPosX2%
For iLoopY%
= iPosY1%
To iPosY2%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
' MOVE UP A LEVEL
iPosX1% = iPosX1% + 1
iPosX2% = iPosX2% - 1
iPosY1% = iPosY1% + 1
iPosY2% = iPosY2% - 1
DoCycleColor iColorScheme%, iNextColor&
' QUIT AFTER WE REACH THE TOP
If (iPosX1%
<= iPosX2%
) And (iPosY1%
<= iPosY2%
) Then iZ% = iZ% + 1
bContinue = FALSE
' -----------------------------------------------------------------------------
' DRAW PIPES
' START POSITION
iX% = m_iMapMaxX ' 30 ' RandomNumber%(0, 32)
iY% = m_iMapMaxY ' 28 ' RandomNumber%(0, 32)
iZ% = 1 ' 32
' LENGTH OF PIPES
iSegmentLength% = 4
iMaxLength% = 64
' START COLOR + DEFINE HOW COLOR CHANGES
iNextColor& = cRed&
iColorScheme% = 2 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
' INITIALIZE
bFirst = TRUE
iCount% = 0
iMove% = 0
bFinished = FALSE
iNextX% = iX%
iNextY% = iY%
iNextZ% = iZ%
' CHANGE DIRECTION EVERY iSegmentLength% SPACES
iMove% = iMove% + 1
If iMove%
> iSegmentLength%
Then iMove% = 0
' PICK A DIRECTION
' MOVE UP FOR FIRST MOVE
iDirection% = c_iDir_Up
bFirst = FALSE
' PICK A RANDOM DIRECTION
iDirection% = RandomNumber(c_iDir_Min, c_iDir_Max)
iNextZ% = iNextZ% - 1
iNextZ% = iNextZ% + 1
iNextX% = iNextX% - 1
iNextX% = iNextX% + 1
iNextY% = iNextY% - 1
iNextY% = iNextY% + 1
' CHECK IF NEXT SPACE IS EMPTY
If m_arrMap
(iNextX%
, iNextY%
, iNextZ%
).Typ
= c_iMapType_Empty
Then ' SPACE IS EMPTY
' DRAW HERE
iCount% = iCount% + 1
iX% = iNextX%
iY% = iNextY%
iZ% = iNextZ%
' GET NEXT COLOR AND DRAW TILE
DoCycleColor iColorScheme%, iNextColor&
m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
' HAVE WE PLACED MAX # OF TILES?
bFinished = TRUE
' SPACE IS OCCUPIED
' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
iOpen% = 0
If m_arrMap
(iX%
, iY%
, iZ%
- 1).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
, iZ%
+ 1).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
- 1, iY%
, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
+ 1, iY%
, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
- 1, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
+ 1, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
' QUIT IF NO OPEN SPACES AVAILABLE
' NOWHERE TO GO, EXIT
bFinished = TRUE
' PLOT GRAPHICS TO SCREEN
'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY
'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, 0, 0, 0
DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, iGridSize, 0, 0, 0
Input "PRESS <ENTER> TO DRAW ANOTHER, OR 'Q' TO QUIT? ", in$
bQuit = TRUE
IsometricDemo1 = sResult
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "IsometricDemo2"
' INITIALIZE
'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
iGridSize = 10
' =============================================================================
' MAIN LOOP
bQuit = FALSE
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
ClearIsometricMap
' -----------------------------------------------------------------------------
' DRAW FLOOR
'For iLoopZ% = m_iMapMinZ To m_iMapMaxZ Step 8
For iLoopZ%
= m_iMapMinZ
To m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE
FOR iLoopZ%
= m_iMapMinZ
+1 TO m_iMapMaxZ
m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
m_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
FOR iLoopX%
= m_iMapMinX
TO m_iMapMaxX
m_arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Color1 = cOrange&
m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Color1 = cPurple&
m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Color1 = cLime&
m_arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Color1 = cCyan&
FOR iLoopY%
= m_iMapMinY
TO m_iMapMaxY
m_arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Color1 = cDodgerBlue&
m_arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Color1 = cDeepPurple&
m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Color1 = cDarkRed&
m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Color1 = cGold&
' -----------------------------------------------------------------------------
' DRAW PIPES
' START POSITION
iX% = m_iMapMidX ' 30 ' RandomNumber(0, 32)
iY% = m_iMapMidY ' 28 ' RandomNumber(0, 32)
iZ% = m_iMapMidZ ' 1 ' 32
' LENGTH OF PIPES
iSegmentLength% = 8
iMaxLength% = 512
' START COLOR + DEFINE HOW COLOR CHANGES
iNextColor& = cRed&
iColorScheme% = 3 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
' INITIALIZE
bFirst = TRUE
iCount% = 0
iMove% = 0
bFinished = FALSE
iNextX% = iX%
iNextY% = iY%
iNextZ% = iZ%
' CHANGE DIRECTION EVERY iSegmentLength% SPACES
iMove% = iMove% + 1
If iMove%
> iSegmentLength%
Then iMove% = 0
' PICK A DIRECTION
' MOVE UP FOR FIRST MOVE
iDirection% = c_iDir_Up
bFirst = FALSE
' PICK A RANDOM DIRECTION
iDirection% = RandomNumber%(c_iDir_Min, c_iDir_Max)
iNextZ% = iNextZ% - 1
iNextZ% = iNextZ% + 1
iNextX% = iNextX% - 1
iNextX% = iNextX% + 1
iNextY% = iNextY% - 1
iNextY% = iNextY% + 1
' CHECK IF NEXT SPACE IS EMPTY
If m_arrMap
(iNextX%
, iNextY%
, iNextZ%
).Typ
= c_iMapType_Empty
Then ' SPACE IS EMPTY
' DRAW HERE
iCount% = iCount% + 1
iX% = iNextX%
iY% = iNextY%
iZ% = iNextZ%
' GET NEXT COLOR AND DRAW TILE
DoCycleColor iColorScheme%, iNextColor&
m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
' HAVE WE PLACED MAX # OF TILES?
bFinished = TRUE
' SPACE IS OCCUPIED
' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
iOpen% = 0
If m_arrMap
(iX%
, iY%
, iZ%
- 1).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
, iZ%
+ 1).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
- 1, iY%
, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
+ 1, iY%
, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
- 1, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
If m_arrMap
(iX%
, iY%
+ 1, iZ%
).Typ
= c_iMapType_Empty
Then iOpen% = iOpen% + 1
' QUIT IF NO OPEN SPACES AVAILABLE
' NOWHERE TO GO, EXIT
bFinished = TRUE
' PLOT GRAPHICS TO SCREEN
'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY
'DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, 0, 0, 0
DrawScreen c_iDir_Forward, cScreenOffsetX, cScreenOffsetY, iGridSize, 0, 0, 0
Input "PRESS <ENTER> TO DRAW ANOTHER, OR 'Q' TO QUIT? ", in$
bQuit = TRUE
IsometricDemo2 = sResult
' /////////////////////////////////////////////////////////////////////////////
Dim RoutineName
As String: RoutineName
= "IsometricDemo3" Dim iTotal%
' compute total available spaces Dim iCount%
' count # of spaces searched
' =============================================================================
' GET OPTIONS
iNumPlayers = 1
'iNumPlayers = PromptForIntegerInRange%("How many players ({min}-{max} or blank to quit)?", 1, 4, 0)
'IF iNumPlayers = 0 THEN Goto CleanupAndExit
bEnableRepeatingKeys = FALSE
' =============================================================================
' INITIALIZE GRAPHIC SCREEN
'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
m_arrSplitScreen(1).GridOffsetX = 50
m_arrSplitScreen(1).GridOffsetY = 50
m_arrSplitScreen(1).GridOffsetZ = 0
m_arrSplitScreen(1).ScreenOffsetX = 450
m_arrSplitScreen(1).ScreenOffsetY = 200
m_arrSplitScreen(1).ScreenOffsetZ = 0
m_arrSplitScreen(2).GridOffsetX = 50
m_arrSplitScreen(2).GridOffsetY = 50
m_arrSplitScreen(2).GridOffsetZ = 0
m_arrSplitScreen(2).ScreenOffsetX = 1000
m_arrSplitScreen(2).ScreenOffsetY = 200
m_arrSplitScreen(2).ScreenOffsetZ = 0
m_arrSplitScreen(3).GridOffsetX = 50
m_arrSplitScreen(3).GridOffsetY = 50
m_arrSplitScreen(3).GridOffsetZ = 0
m_arrSplitScreen(3).ScreenOffsetX = 450
m_arrSplitScreen(3).ScreenOffsetY = 700
m_arrSplitScreen(3).ScreenOffsetZ = 0
m_arrSplitScreen(4).GridOffsetX = 50
m_arrSplitScreen(4).GridOffsetY = 50
m_arrSplitScreen(4).GridOffsetZ = 0
m_arrSplitScreen(4).ScreenOffsetX = 1000
m_arrSplitScreen(4).ScreenOffsetY = 700
m_arrSplitScreen(4).ScreenOffsetZ = 0
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
ClearIsometricMap
' -----------------------------------------------------------------------------
' DRAW FLOOR
For iLoopZ%
= m_iMapMinZ
To m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
' -----------------------------------------------------------------------------
' DRAW A TALL HOLLOW PYRAMID
iX% = 5
iY% = 10
iZ% = 1
iLevelSize% = 4
iPosX1% = iX%
iPosX2% = iX% + 7
iPosY1% = iY%
iPosY2% = iY% + 7
iNextColor& = cRed&
iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
iLevelCount% = 0
bContinue = TRUE
' PLOT NEXT LEVEL (SOLID)
'For iLoopX% = iPosX1% To iPosX2%
' For iLoopY% = iPosY1% To iPosY2%
' m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
' m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
' Next iLoopY%
'Next iLoopX%
' Draw front/back walls
For iLoopX%
= iPosX1%
To iPosX2%
iLoopY% = iPosY1%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
iLoopY% = iPosY2%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
' Draw left/right walls
For iLoopY%
= iPosY1%
To iPosY2%
iLoopX% = iPosX1%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
iLoopX% = iPosX2%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
' Add a door to middle of right wall
iX% = iPosX1% + ( (iPosX2% - iPosX1%) \ 2)
m_arrMap(iX%, iPosY2%, iZ%).Typ = c_iMapType_Empty
' Add a door to middle of front wall
iY% = iPosY1% + ( (iPosY2% - iPosY1%) \ 2)
m_arrMap(iPosX2%, iY%, iZ%).Typ = c_iMapType_Empty
' MOVE UP A LEVEL
iLevelCount% = iLevelCount% + 1
IF iLevelCount%
> iLevelSize%
THEN iLevelCount% = 0
iPosX1% = iPosX1% + 1
iPosX2% = iPosX2% - 1
iPosY1% = iPosY1% + 1
iPosY2% = iPosY2% - 1
' QUIT AFTER WE REACH THE TOP
If (iPosX1%
<= iPosX2%
) And (iPosY1%
<= iPosY2%
) Then iZ% = iZ% + 1
DoCycleColor iColorScheme%, iNextColor&
bContinue = FALSE
bContinue = FALSE
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE (TOP)
FOR iLoopX%
= m_iMapMinX
+3 TO m_iMapMaxX
-3 m_arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Color1 = cPurple&
m_arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Color1 = cCyan&
FOR iLoopY%
= m_iMapMinY
+3 TO m_iMapMaxY
-3 m_arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Color1 = cOrange&
m_arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Color1 = cLime&
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
FOR iLoopX%
= m_iMapMinX
+2 TO m_iMapMaxX
-2 m_arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Color1 = cDodgerBlue&
m_arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Color1 = cDeepPurple&
FOR iLoopY%
= m_iMapMinY
+2 TO m_iMapMaxY
-2 m_arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Color1 = cDarkRed&
m_arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Color1 = cGold&
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
FOR iLoopX%
= m_iMapMinX
+1 TO m_iMapMaxX
-1 m_arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Color1 = cSeaBlue&
m_arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Color1 = cChartreuse&
FOR iLoopY%
= m_iMapMinY
+1 TO m_iMapMaxY
-1 m_arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Color1 = cOrangeRed&
m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Color1 = cDeepSkyBlue&
' =============================================================================
' PLACE PLAYER(S) <- ONLY ONE FOR THIS DEMO
FOR iPlayerLoop
= 1 TO iNumPlayers
'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
'TODO: WHATEVER THE KEYS MAPPED ARE, SWAP THEM NON-HARDCODED
' -----------------------------------------------------------------------------
' BEGIN Map the 6 directional keys
' -----------------------------------------------------------------------------
' differently for each of the 6 directional orientations!
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyBack = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyForward = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyUp = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyDown = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyBack = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyForward = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyUp = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyDown = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyBack = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyForward = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyLeft = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyRight = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyBack = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyForward = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyLeft = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyRight = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyBack = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyForward = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyLeft = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyRight = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyBack = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyForward = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyDown = c_iKeyDown_PgDn
' -----------------------------------------------------------------------------
' END Map the 6 directional keys
' -----------------------------------------------------------------------------
' FIND START POSITION
iX% = RandomNumber(m_iMapMinX, m_iMapMaxX)
iY% = RandomNumber(m_iMapMinY, m_iMapMaxY)
iZ% = 1 ' RandomNumber(m_iMapMinZ, m_iMapMaxZ)
' MAKE SURE IT'S EMPTY
IF m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iMapType_Empty
THEN bFound = TRUE
' IF NOT EMPTY THEN TRY TO FIND AN EMPTY SPOT
iTotal% = ((m_iMapMaxX - m_iMapMinX)+1) * ((m_iMapMaxY - m_iMapMinY)+1) * ((m_iMapMaxZ - m_iMapMinZ)+1)
iCount% = 0
bFound = FALSE
iX% = iX% + 1
' reset x and move to next y
iX% = m_iMapMinX
iY% = iY% + 1
' reset y and move to next z
iY% = m_iMapMinY
iZ% = iZ% + 1
' RESET Z AND SEE IF WE HAVE CHECKED EVERYTHING
iZ% = m_iMapMinZ
iCount% = iCount% + 1
' NONE FOUND, EXIT
iCount% = iCount% + 1
iCount% = iCount% + 1
iCount% = iCount% + 1
IF m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iMapType_Empty
THEN ' FOUND AN EMPTY SPACE, EXIT
bFound = TRUE
' PICK A DIRECTION (SIMPLE FOR NOW, LEFT OR RIGHT)
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
m_arrPlayer(iPlayerLoop).Tile1 = c_iMapType_Player1
' SAVE COORDINATES TO PLAYER
' ****************************************************************************************************************************************************************
' for this demo we'll just use iX% instead of m_arrPlayer(iPlayerLoop).x, etc.
' to make it more readable
' ****************************************************************************************************************************************************************
m_arrPlayer(iPlayerLoop).x = iX%
m_arrPlayer(iPlayerLoop).y = iY%
m_arrPlayer(iPlayerLoop).z = iZ%
m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Forward
m_arrPlayer(iPlayerLoop).Color1 = cRed&
m_arrPlayer(iPlayerLoop).Alpha1 = 255
m_arrPlayer(iPlayerLoop).AlphaOverride = 255
m_arrPlayer(iPlayerLoop).ColorScheme1 = 2
m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 = 5 ' change color every 5 frames
m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
' DISPLAY OPTIONS
m_arrPlayer(iPlayerLoop).GridSize = 8
m_arrPlayer(iPlayerLoop).MapSize = 4
' RESET MOVEMENT VARIABLES
m_arrPlayer(iPlayerLoop).IsMoving = FALSE
m_arrPlayer(iPlayerLoop).IsMoved = FALSE
' DRAW PLAYER
m_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
m_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
m_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
sError = "Could not find an empty space to start player."
' =============================================================================
' OTHER SETUP
' RESET INPUT
iLastKey = c_iKeyDown_Enter
' =============================================================================
' MAIN LOOP
bFinished = FALSE
' SHOW INSTRUCTIONS / COORDINATES ON SCREEN
LOCATE 3, 1:
PRINT "CRSR RT/LF MOVES X = " + CSTR$
(iX%
) LOCATE 4, 1:
PRINT "CRSR UP/DN MOVES Y = " + CSTR$
(iY%
) LOCATE 5, 1:
PRINT "PAGE UP/DN MOVES Z = " + CSTR$
(iZ%
) LOCATE 6, 1:
PRINT "= / - CHANGES GRID SIZE = " + CSTR$
(m_arrPlayer
(1).GridSize
) LOCATE 7, 1:
PRINT "[ / ] TOGGLES MOVEMENT = " + IIFSTR$
(m_arrPlayer
(1).IsMoving
, "TRUE", "FALSE") LOCATE 8, 1:
PRINT "INS / DEL TOGGLES REPEAT KEYS = " + IIFSTR$
(bEnableRepeatingKeys
, "TRUE", "FALSE") LOCATE 9, 1:
PRINT "HOME / END CHANGES VIEW ANGLE = " + GetDirection$
(m_arrPlayer
(1).
View) LOCATE 10, 1:
PRINT ", / . CHANGES MAP SIZE = " + CSTR$
(m_arrPlayer
(1).MapSize
)
' ****************************************************************************************************************************************************************
' BEGIN PLAYER LOOP
' ****************************************************************************************************************************************************************
DrawScreen c_iDir_Forward, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
DrawScreen c_iDir_Back, m_arrSplitScreen(2).ScreenOffsetX, m_arrSplitScreen(2).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
DrawScreen c_iDir_Left, m_arrSplitScreen(3).ScreenOffsetX, m_arrSplitScreen(3).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
DrawScreen c_iDir_Right, m_arrSplitScreen(4).ScreenOffsetX, m_arrSplitScreen(4).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
FOR iPlayerLoop
= 1 TO iNumPlayers
'DrawScreen m_arrPlayer(iPlayerLoop).View, cScreenOffsetX, cScreenOffsetY, iX%, iY%, iZ%
' -----------------------------------------------------------------------------
' BEGIN SHOW 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
FOR iLoopX%
= m_iMapMinX
TO m_iMapMaxX
FOR iLoopY%
= m_iMapMinY
TO m_iMapMaxY
'iDrawX% = (iLoopX% * 4) + 20
iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + 20
'iDrawY% = (iLoopY% * 4) + 200
iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + 200
IF m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iMapType_Wall
THEN 'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ELSEIF m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iMapType_Player1
THEN 'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ELSEIF m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iMapType_Player2
THEN 'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ELSEIF m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iMapType_Player3
THEN 'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ELSEIF m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iMapType_Player4
THEN 'DrawBox iDrawX%, iDrawY%, 4, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
'TODO: ADD OTHER TYPES
'DrawBox iDrawX%, iDrawY%, 4, cBlack&
'DrawBox iDrawX%, iDrawY%, 4, cKhaki&
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki&
' -----------------------------------------------------------------------------
' END SHOW 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN GET DIRECTIONAL KEYBOARD INPUT
' -----------------------------------------------------------------------------
If iLastKey
<> c_iKeyDown_Up
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Up
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Down
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Down
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Left
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Left
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Right
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Right
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
bMoved = TRUE
If iLastKey
<> c_iKeyDown_PgUp
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_PgUp
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
bMoved = TRUE
If iLastKey
<> c_iKeyDown_PgDn
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_PgDn
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
bMoved = TRUE
' -----------------------------------------------------------------------------
' END GET DIRECTIONAL KEYBOARD INPUT
' -----------------------------------------------------------------------------
'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
' ' -----------------------------------------------------------------------------
' ' BEGIN GET VARIABLE DIRECTIONAL KEYBOARD INPUT
' ' -----------------------------------------------------------------------------
' If _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyBack
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
' bMoved = TRUE
' End If
' ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyForward
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
' bMoved = TRUE
' End If
' ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyLeft
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
' bMoved = TRUE
' End If
' ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyRight
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
' bMoved = TRUE
' End If
' ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyUp
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
' bMoved = TRUE
' End If
' ElseIf _KeyDown(m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown) Then
' If iLastKey <> m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown OR bEnableRepeatingKeys=TRUE Then
' iLastKey = m_arrDirKeyMap(iPlayerLoop, m_arrPlayer(iPlayerLoop).Direction).KeyDown
' m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
' bMoved = TRUE
' End If
' ' -----------------------------------------------------------------------------
' ' END GET VARIABLE DIRECTIONAL KEYBOARD INPUT
' ' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN GET OTHER KEYBOARD INPUT
' -----------------------------------------------------------------------------
If iLastKey
<> c_iKeyDown_BracketLeft
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_BracketLeft
m_arrPlayer(iPlayerLoop).IsMoving = TRUE
If iLastKey
<> c_iKeyDown_BracketRight
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_BracketRight
m_arrPlayer(iPlayerLoop).IsMoving = FALSE
'yoda
If iLastKey
<> c_iKeyDown_Comma
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Comma
' TODO: HAVE MAP SIZE PER PLAYER
m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize - 1
IF m_arrPlayer
(iPlayerLoop
).MapSize
< 1 THEN m_arrPlayer(iPlayerLoop).MapSize = 1
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Period
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Period
m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize + 1
IF m_arrPlayer
(iPlayerLoop
).MapSize
> m_iGridSizeMax
THEN m_arrPlayer(iPlayerLoop).MapSize = m_iGridSizeMax
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Minus
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Minus
' TODO: HAVE SEPARATE GRID SIZE PER PLAYER / SPLIT SCREEN?
m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize - 1
IF m_arrPlayer
(iPlayerLoop
).GridSize
< m_iGridSizeMin
THEN m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMin
bMoved = TRUE
If iLastKey
<> c_iKeyDown_EqualPlus
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_EqualPlus
m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize + 1
IF m_arrPlayer
(iPlayerLoop
).GridSize
> m_iGridSizeMax
THEN m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMax
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Home
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Home
' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
m_arrPlayer
(iPlayerLoop
).
View = m_arrPlayer
(iPlayerLoop
).
View - 1 IF m_arrPlayer
(iPlayerLoop
).
View < c_iDir_Min
THEN m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Max
If iLastKey
<> c_iKeyDown_End
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_End
' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
m_arrPlayer
(iPlayerLoop
).
View = m_arrPlayer
(iPlayerLoop
).
View + 1 IF m_arrPlayer
(iPlayerLoop
).
View > c_iDir_Max
THEN m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Min
' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
If iLastKey
<> c_iKeyDown_Ins
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Ins
bEnableRepeatingKeys = TRUE
' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
If iLastKey
<> c_iKeyDown_Del
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_Del
bEnableRepeatingKeys = FALSE
iLastKey = -1
' -----------------------------------------------------------------------------
' END GET OTHER KEYBOARD INPUT
' -----------------------------------------------------------------------------
' --------------------------------------------------------------------------------
' ERASE OLD POSITION
' --------------------------------------------------------------------------------
m_arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty
m_arrMap(iX%, iY%, iZ%).Color1 = cEmpty&
m_arrMap(iX%, iY%, iZ%).AlphaOverride = 255
' --------------------------------------------------------------------------------
' MOVE PLAYER BASED ON DIRECTION
' --------------------------------------------------------------------------------
IF m_arrPlayer
(iPlayerLoop
).IsMoving
=TRUE
OR bMoved
=TRUE
THEN bMoved = FALSE
iNewX% = iX%
iNewY% = iY%
iNewZ% = iZ% - 1
iNewZ% = m_iMapMaxZ
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
iNewZ% = iZ%
iNewX% = iX%
iNewY% = iY%
iNewZ% = iZ% + 1
iNewZ% = m_iMapMinZ
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
iNewZ% = iZ%
iNewX% = iX% - 1
iNewY% = iY%
iNewZ% = iZ%
iNewX% = m_iMapMaxX
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
iNewX% = iX%
iNewX% = iX% + 1
iNewY% = iY%
iNewZ% = iZ%
iNewX% = m_iMapMinX
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
iNewX% = iX%
iNewX% = iX%
iNewY% = iY% - 1
iNewZ% = iZ%
iNewY% = m_iMapMaxY
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
iNewY% = iY%
iNewX% = iX%
iNewY% = iY% + 1
iNewZ% = iZ%
iNewY% = m_iMapMinY
If m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iMapType_Empty
Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
iNewY% = iY%
'iNewX% = iX%
'iNewY% = iY%
'iNewZ% = iZ%
' SAVE NEW POSITION
iX% = iNewX%
iY% = iNewY%
iZ% = iNewZ%
' FOR MULTIPLAYER WE WOULD USE:
'm_arrPlayer(iPlayerLoop).x = iNewX%
'm_arrPlayer(iPlayerLoop).y = iNewY%
'm_arrPlayer(iPlayerLoop).z = iNewZ%
' CYCLE COLOR
IF m_arrPlayer
(iPlayerLoop
).ColorScheme1
> 0 THEN m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = m_arrPlayer(iPlayerLoop).ColorSchemeCount1 + 1
IF m_arrPlayer
(iPlayerLoop
).ColorSchemeCount1
> m_arrPlayer
(iPlayerLoop
).ColorSchemeSpeed1
THEN m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
DoCycleColor m_arrPlayer(iPlayerLoop).ColorScheme1, m_arrPlayer(iPlayerLoop).Color1
' REDRAW AT CURRENT POSITION
m_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
m_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
m_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
' ****************************************************************************************************************************************************************
' END PLAYER LOOP
' ****************************************************************************************************************************************************************
CleanupAndExit:
' FINISH UP AND EXIT
IsometricDemo3$ = sResult
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' =============================================================================
' LET'S GET THE COORDINATES STRAIGHT!
' Coordinates are m_arrMap(x,y,z)
' ________________
' /|e /|e
' / | / |
' / | / |z-axis
' / | / |
' / /---------/----/
' / / a / b/
' / / / /
' |--------------| /
' |f / g| / y-axis
' | / | /
' | / | /
' |/c d|/
' ----------------
' x-axis
'
' POINT ( X, Y, Z)
' a ( 0, 0, 0)
' b (32, 0, 0)
' c ( 0,32, 0)
' d (32,32, 0)
' e ( 0, 0,32)
' f ( 0,32,32)
' g (32,32,32)
' =============================================================================
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE MAP TO EMPTY
' Requires shared global variable:
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearIsometricMap"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Empty
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE RENDERING MAP TO EMPTY
' Requires shared global variable:
' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearRenderMap"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Empty
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' /////////////////////////////////////////////////////////////////////////////
' Determine which squares are visible in isometric map
' Original operates directly on the main map array m_arrMap
' and not the copy (m_arrRender) used to rotate the perspective.
' Requires shared global variable (3D array of map):
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' RECEIVES:
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
' Direction is assumed to be c_iDir_Forward.
' If iX% < 0 then we just render everything with its normal alpha value.
Sub ComputeVisible
(iX%
, iY%
, iZ%
, iGridSize
) Dim RoutineName
As String: RoutineName
= "ComputeVisible"
' CALCULATE PLAYER'S 2-D POSITION
iPX1% = iX% * iGridSize + cGridOffsetX
iPY1% = iY% * iGridSize + cGridOffsetY
iPZ1% = iZ% * iGridSize + cGridOffsetZ
iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
' LOOK AT EACH TILE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' *****************************************************************************
' IF SPACE HAS A TILE
' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
' THEN MAKE THE TILE TRANSPARENT
' *****************************************************************************
' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
If m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Wall
OR m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Floor_Tiled
Then ' CALCULATE TILE'S 2-D POSITION
iPX1% = iLoopX% * iGridSize + cGridOffsetX
iPY1% = iLoopY% * iGridSize + cGridOffsetY
iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
'If iLoopZ% >= iZ% Then
'If iLoopX% >= iX% Then
' FOR TILES FORWARD OF PLAYER
' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
If ( iPlayer2Dy
>= (iTile2Dy
- iGridSize
) ) AND ( iPlayer2Dy
<= (iTile2Dy
+ iGridSize
) ) Then
' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
If ( iPlayer2Dx
>= (iTile2Dx
- iGridSize
) ) AND ( iPlayer2Dx
<= (iTile2Dx
+ iGridSize
) ) Then ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
' TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'End If
'End If
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' JUST MAKE ALL TILES VISIBLE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' LEAVE THE TILE OPAQUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' /////////////////////////////////////////////////////////////////////////////
' Determine which squares are visible in isometric map
' Same as ComputeVisible except uses the rotated copy
' (m_arrRender instead of m_arrMap)
' Requires shared global variable (3D array of map):
' m_arrRender(x,y,z) = rotated copy of 3D array map of world
' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' RECEIVES:
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
' If iX% < 0 then we just render everything with its normal alpha value.
' TODO: FIX FOR c_iDir_Down and c_iDir_Up DIRECTIONS
' "FOR TILES FORWARD OF PLAYER" SECTION BELOW
' NEEDS TO LOOK AT Z AXIS INSTEAD OF Y ?
Sub ComputeRenderVisible
(iX%
, iY%
, iZ%
, iGridSize
) Dim RoutineName
As String: RoutineName
= "ComputeRenderVisible"
' CALCULATE PLAYER'S 2-D POSITION
iPX1% = iX% * iGridSize + cGridOffsetX
iPY1% = iY% * iGridSize + cGridOffsetY
iPZ1% = iZ% * iGridSize + cGridOffsetZ
iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
' LOOK AT EACH TILE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' *****************************************************************************
' IF SPACE HAS A TILE
' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
' THEN MAKE THE TILE TRANSPARENT
' *****************************************************************************
' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
If m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Wall
OR m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Floor_Tiled
Then ' CALCULATE TILE'S 2-D POSITION
iPX1% = iLoopX% * iGridSize + cGridOffsetX
iPY1% = iLoopY% * iGridSize + cGridOffsetY
iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
'If iLoopZ% >= iZ% Then
'If iLoopX% >= iX% Then
' FOR TILES FORWARD OF PLAYER
' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
If ( iPlayer2Dy
>= (iTile2Dy
- iGridSize
) ) AND ( iPlayer2Dy
<= (iTile2Dy
+ iGridSize
) ) Then
' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
If ( iPlayer2Dx
>= (iTile2Dx
- iGridSize
) ) AND ( iPlayer2Dx
<= (iTile2Dx
+ iGridSize
) ) Then ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
'TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE?
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
' LEAVE THE TILE OPAQUE
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
'End If
'End If
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' JUST MAKE ALL TILES VISIBLE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Alpha1
End Sub ' ComputeRenderVisible
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
' from the forward (default) perspective.
' Requires shared global variable
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
' params instead of constants:
' Const cScreenOffsetX = 500 ' 450
' Const cScreenOffsetY = 300 ' 50
' Const cScreenOffsetZ = 0
' what about?
' Const cGridOffsetX = 50
' Const cGridOffsetY = 50
' Const cGridOffsetZ = 0
Sub DrawIsometricScreen
(iScreenOffsetX
, iScreenOffsetY
, iGridSize
) Dim RoutineName
As String: RoutineName
= "DrawIsometricScreen"
alpha& = 255
bTile = FALSE
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' CALCULATE POSITION
iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iPosX1% = iLoopX% * iGridSize + cGridOffsetX
iPosY1% = iLoopY% * iGridSize + cGridOffsetY
iPosX2% = iPosX1% + iGridSize
iPosY2% = iPosY1% + iGridSize
' DETERMINE COLOR
If m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Floor_Tiled
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
bTile = FALSE
iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
bTile = TRUE
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Wall
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player1
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player2
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player3
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player4
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Water
Then 'TODO: transparent for water
iColor = cEmpty&
alpha& = 64
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Window
Then 'TODO: transparent for windows
iColor = cEmpty&
alpha& = 64
iColor = cEmpty&
' PLOT NEXT TILE
'IsoLine3D(x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
' from the forward (default) perspective.
' Same as DrawIsometricScreen except uses the rotated copy
' (m_arrRender instead of m_arrMap)
' Requires shared global variable
' m_arrRender(x,y,z) = 3D array map of world
' m_arrRender(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Sub DrawRenderScreen
(iScreenOffsetX
, iScreenOffsetY
, iGridSize
) Dim RoutineName
As String: RoutineName
= "DrawRenderScreen"
alpha& = 255
bTile = FALSE
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' CALCULATE POSITION
iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iPosX1% = iLoopX% * iGridSize + cGridOffsetX
iPosY1% = iLoopY% * iGridSize + cGridOffsetY
iPosX2% = iPosX1% + iGridSize
iPosY2% = iPosY1% + iGridSize
' DETERMINE COLOR
If m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Floor_Tiled
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
bTile = FALSE
iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color2
bTile = TRUE
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Wall
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player1
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player2
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player3
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Player4
Then iColor = m_arrRender(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Water
Then 'TODO: transparent for water
iColor = cEmpty&
alpha& = 64
ElseIf m_arrRender
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iMapType_Window
Then 'TODO: transparent for windows
iColor = cEmpty&
alpha& = 64
iColor = cEmpty&
' PLOT NEXT TILE
'IsoLine3D(x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
' from a different direction.
' This is the lazy man's version which simply copies the tiles to
' a temporary array, rotated to the specified direction/orientation.
' A more efficient + faster method would operate directly on the
' main array, but I am too bogged down to figure that out right now!
' RECEIVES:
' iDirection% = point of view to render from
' i.e. the direction we are looking at the scene FROM
' iDirection% can be one of the following:
' c_iDir_Down
' c_iDir_Up
' c_iDir_Left
' c_iDir_Right
' c_iDir_Back
' c_iDir_Forward = default
'
' If iDirection% = c_iDir_Forward, just call DrawIsometricScreen instead (faster).
'
' iScreenOffsetX, iScreenOffsetY = where on display to draw
'
' iX%, iY%, iZ% = player's position, used for ComputeRenderVisible
' to compute which tiles to hide / make transparent
' (tiles that might be hiding the player)
' If these are <0, then ComputeRenderVisible uses original alpha values.
' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
' params instead of constants:
' Const cScreenOffsetX = 500 ' 450
' Const cScreenOffsetY = 300 ' 50
' Const cScreenOffsetZ = 0
' what about?
' Const cGridOffsetX = 50
' Const cGridOffsetY = 50
' Const cGridOffsetZ = 0
Sub DrawScreen
(iDirection%
, iScreenOffsetX
, iScreenOffsetY
, iGridSize
, iX%
, iY%
, iZ%
)
IF iDirection%
= c_iDir_Forward
THEN ' NO NEED TO ROTATE, JUST USE THE ORIGINAL ROUTINE
ComputeVisible iX%, iY%, iZ%, iGridSize
DrawIsometricScreen iScreenOffsetX, iScreenOffsetY, iGridSize
' USE A TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
ClearRenderMap
' SCENE IS FLIPPED UP (TOP FACE NOW FACING AWAY FROM US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(iLoopX%,m_iMapMaxZ-iLoopZ%,iLoopY%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, m_iMapMaxZ-iZ%, iY%, iGridSize
' SCENE IS FLIPPED DOWN (TOP FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(iLoopX%,iLoopZ%,m_iMapMaxY-iLoopY%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, iZ%, m_iMapMaxY-iY%, iGridSize
' SCENE IS ROTATED COUNTER CLOCKWISE FROM TOP (LEFT FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(iLoopY%,m_iMapMaxX-iLoopX%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iY%, m_iMapMaxX-iX%, iZ%, iGridSize
' SCENE IS ROTATED CLOCKWISE FROM TOP (RIGHT FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(m_iMapMaxY-iLoopY%,iLoopX%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible m_iMapMaxY-iY%, iX%, iZ%, iGridSize
' SCENE IS TURNED AROUND (FRONT FACE NOW FACING AWAY FROM US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(m_iMapMaxX-iLoopX%,m_iMapMaxY-iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible m_iMapMaxX-iX%, m_iMapMaxY-iY%, iZ%, iGridSize
' DIRECTION UNKNOWN: for now just draw default (forward)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, iY%, iZ%, iGridSize
DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
' /////////////////////////////////////////////////////////////////////////////
' RETURNS MAP AS TEXT
' Requires shared global variable
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' USAGE:
'Input "See a text dump (y/n)? ", in$
'If LCase$(in$) = LCase$("y") Then
' Print MapToText$
'End If
sResult = ""
' FIND USED BOUNDARIES OF MAP
iMinX% = -1
iMaxX% = -1
iMinY% = -1
iMaxY% = -1
iMinZ% = -1
iMaxZ% = -1
iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
If iType%
<> c_iMapType_Empty
And iType%
<> c_iMapType_Floor_Tiled
Then iMinX% = iLoopX%
iMinY% = iLoopY%
iMinZ% = iLoopZ%
iMaxX% = iLoopX%
iMaxY% = iLoopY%
iMaxZ% = iLoopZ%
' GENERATE OUTPUT
For iLoopZ%
= iMinZ%
To iMaxZ%
sResult
= sResult
+ "-------------------------------------------------------------------------------" + Chr$(13) sResult
= sResult
+ "Map Z=" + cstr$
(iLoopZ%
) + ":" + Chr$(13) sResult
= sResult
+ "-------------------------------------------------------------------------------" + Chr$(13) For iLoopY%
= iMinY%
To iMaxY%
sLine = ""
For iLoopX%
= iMinX%
To iMaxX%
iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
iColor1& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
iColor2& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
iColor3& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color3
If iType%
= c_iMapType_Empty
Then sLine = sLine + " "
sLine = sLine + " "
sLine = sLine + "#"
sResult
= sResult
+ sLine
+ Chr$(13)
sResult
= sResult
+ Chr$(13)
MapToText$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' Return string description for 2.5D movement constants
sDir = "Down"
sDir = "Up"
sDir = "Left"
sDir = "Right"
sDir = "Back"
sDir = "Forward"
sDir = "Unknown"
GetDirection$ = sDir
' /////////////////////////////////////////////////////////////////////////////
CX2I = x - y
' /////////////////////////////////////////////////////////////////////////////
CY2I = (x + y) / 2
' /////////////////////////////////////////////////////////////////////////////
' since we're drawing a diamond and not a square box, we can't use Line BF.
' We have to manually down the 4 points of the line.
Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), iColor
Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), iColor
Paint (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + 4), iColor
'and fill the diamond solid Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), &HFFFFFFFF
' /////////////////////////////////////////////////////////////////////////////
' Like IsoLine, we're going to have to draw our lines manually.
' only in this case, we also need a Z coordinate to tell us how
' THICK/TALL/HIGH to make our tile
' MODIFIED by madscijr to draw a single tile of height iHeight at Z axis
' MODIFIED by madscijr to accept an alpha& value to control transparency (where 0=fully transparent, 255=opaque)
''Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
'Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
Sub IsoLine3D
(x
, y
, x2
, y2
, z
, iHeight
, xoffset
, yoffset
, iColor
As _Unsigned Long, alpha&
) 'dim iNewColor As _Unsigned Long
' Let's just do all the math first this time.
' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
TempX1 = CX2I(x, y) + xoffset
TempY1 = CY2I(x, y) + yoffset
TempX2 = CX2I(x2, y) + xoffset
TempY2 = CY2I(x2, y) + yoffset
TempX3 = CX2I(x2, y2) + xoffset
TempY3 = CY2I(x2, y2) + yoffset
TempX4 = CX2I(x, y2) + xoffset
TempY4 = CY2I(x, y2) + yoffset
' The top
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
fquad TempX1
, TempY1
- z
, TempX2
, TempY2
- z
, TempX3
, TempY3
- z
, TempX4
, TempY4
- z
, _RGB32(r
, g
, b
, alpha&
)
' TODO: maybe change which sides gets shaded depending on the direction of the light source?
' draw the left side, shaded 75%
'fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b)
fquad TempX4
, TempY4
- z
, TempX4
, TempY4
- z
+ iHeight
, TempX3
, TempY3
- z
+ iHeight
, TempX3
, TempY3
- z
, _RGB32(.75 * r
, .75 * g
, .75 * b
, alpha&
)
' draw the right side,s haded 50%
'fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b)
fquad TempX3
, TempY3
- z
, TempX3
, TempY3
- z
+ iHeight
, TempX2
, TempY2
- z
+ iHeight
, TempX2
, TempY2
- z
, _RGB32(.5 * r
, .5 * g
, .5 * b
, alpha&
) ' no need to draw any height, if there isn't any.
' /////////////////////////////////////////////////////////////////////////////
' found at abandoned, outdated and now likely malicious qb64 dot net website
' don’t go there: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
' /////////////////////////////////////////////////////////////////////////////
' 2019-11-20 Steve saves some time with STATIC
' and saves and restores last dest
' /////////////////////////////////////////////////////////////////////////////
' original fill quad that may be at fault using Steve's fTri version
' need 4 non linear points (not all on 1 line) list them clockwise
' so x2, y2 is opposite of x4, y4
ftri1 x1, y1, x2, y2, x4, y4, K
ftri1 x3, y3, x2, y2, x4, y4, K
' /////////////////////////////////////////////////////////////////////////////
' update 2019-12-16 needs orig fTri
' need 4 non linear points (not all on 1 line)
' list them clockwise so x2, y2 is opposite of x4, y4
ftri x1, y1, x2, y2, x3, y3, K
ftri x3, y3, x4, y4, x1, y1, K
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX
'SUB DrawBox (iX%, iY%, iSize%, iColor%)
SUB DrawBox
(iX%
, iY%
, iSize%
, iColor&
) LINE (iX%
, iY%
)-(iX%
+ iSize%
, iY%
+ iSize%
), iColor&
, BF
' Draw a solid box 'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
sResult = ""
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
GetBinary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
' See also: GetBit256%, SetBit256%
'DIM iTemp AS INTEGER
iResult = FALSE
bContinue = TRUE
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
'if any of the bits in iBit are false, return false
iResult = FALSE
bContinue = FALSE
iResult = TRUE
GetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the integer that corresponds to a binary string of length 8
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
iResult
= iResult
+ 2 ^ iLoop
* Val(Mid$(strBinary
, Len(strBinary
) - iLoop
, 1))
GetIntegerFromBinary% = iResult
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
IsNum% = TRUE
IsNum% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
LongABS& = 0 - lngValue
LongABS& = lngValue
' /////////////////////////////////////////////////////////////////////////////
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
' MWheatley
' « Reply #18 on: January 01, 2019, 11:24:30 AM »
' returns 1 if string is an integer, 0 if not
IsNumber = 1
IsNumber = 0
IsNumber = 0
' /////////////////////////////////////////////////////////////////////////////
' iNum% = PromptForIntegerInRange%("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
Function PromptForIntegerInRange%
(sPrompt$
, iMin%
, iMax%
, iDefault%
)
sPrompt1$ = sPrompt$
sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
sPrompt1$ = Replace$(sPrompt1$, "{min}", cstr$(iMin%))
sPrompt1$ = Replace$(sPrompt1$, "{max}", cstr$(iMax%))
bFinished% = FALSE
If iValue%
>= iMin%
And iValue%
<= iMax%
Then 'bFinished% = TRUE
Print "Number out of range." Print "Not a valid number." iValue% = iDefault%
'bFinished% = TRUE
PromptForIntegerInRange% = iValue%
' /////////////////////////////////////////////////////////////////////////////
' iNum& = PromptForLongInRange&("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
Function PromptForLongInRange&
(sPrompt$
, iMin&
, iMax&
, iDefault&
)
bFinished& = FALSE
sPrompt1$ = sPrompt$
sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
sPrompt1$ = Replace$ (sPrompt1$, "{min}", cstrl$(iMin&))
sPrompt1$ = Replace$ (sPrompt1$, "{max}", cstrl$(iMax&))
If iValue&
>= iMin&
And iValue&
<= iMax&
Then bFinished& = TRUE
Print "Number out of range." Print "Not a valid number." iValue& = iDefault&
bFinished& = TRUE
PromptForLongInRange& = iValue&
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
'x = 1: y = 2: z$ = "Three"
sError = "Error in PrintFile$ : File not found. Cannot append."
Open sFileName
For Output As #1 ' opens and clears an existing file or creates new empty file ' WRITE places text in quotes in the file
'WRITE #1, x, y, z$
'WRITE #1, sText
' PRINT does not put text inside quotes
'PRINT "File created with data. Press a key!"
'K$ = INPUT$(1) 'press a key
'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
'INPUT #2, a, b, c$
'CLOSE #2
'PRINT a, b, c$
'WRITE a, b, c$
PrintFile$ = sError
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber%
= Int(Rnd * NumSpread%
) + Min%
' GET RANDOM # BETWEEN Max% AND Min%
' /////////////////////////////////////////////////////////////////////////////
sFileName = "c:\temp\maze_test_1.txt"
sText
= "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random" bAppend = FALSE
sError = PrintFile$(sFileName, sText, bAppend)
bAppend = TRUE
iErrorCount = 0
iMin = 0
iMax = iCols - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
iMin = 0
iMax = iRows - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Print "Finished generating numbers. Errors: " + Str$(iErrorCount
) Print "Error creating file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Input "Press <ENTER> to continue", sInput$
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
' VARIABLES:
Dim lngLocation
As Long ' The address of the [Find] substring within the [Text] string. Dim strBefore
As String ' The characters before the string to be replaced. Dim strAfter
As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation
= InStr(1, Text2
, Find2
)
' PROCESSING:
' While [Find2] appears in [Text2]...
' Extract all Text2 before the [Find2] substring:
strBefore
= Left$(Text2
, lngLocation
- 1)
' Extract all text after the [Find2] substring:
strAfter
= Right$(Text2
, ((Len(Text2
) - (lngLocation
+ Len(Find2
) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation
= InStr(1, Text2
, Find2
)
' Next instance of [Find2]...
' OUTPUT:
Replace$ = Text2
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
' See also: GetBit256%, SetBit256%
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
sVal = "1"
sVal = "0"
strResult = ""
strResult = strResult + sVal
strResult
= strResult
+ Mid$(sNum
, iLoop
, 1) iResult = GetIntegerFromBinary%(strResult)
iResult = iNum
SetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
Sub split
(in$
, delimiter$
, result$
()) start = 1
start = start + 1
finish
= InStr(start
, in$
, delimiter$
) result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////
Input "Press <ENTER> to continue", in$
' /////////////////////////////////////////////////////////////////////////////
' WaitForKey "Press <ESC> to continue", 27, 0
' WaitForKey "Press <ENTER> to begin;", 13, 0
' waitforkey "", 65, 5
Sub WaitForKey
(prompt$
, KeyCode&
, DelaySeconds%
) ' SHOW PROMPT (IF SPECIFIED)
' WAIT FOR KEY
' PAUSE AFTER (IF SPECIFIED)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Receives:
' cycleColor = determines how foreColor, backColor are modified
' foreColor = the foreground color
' backColor = the background color (if needed)
' /////////////////////////////////////////////////////////////////////////////
' DoCycleColor colorScheme%, myColor&
' colorScheme = color scheme (value is alternated on subsequent calls)
' myColor = the current color (value is incremented/decremented on subsequent calls)
' colorScheme values:
' 1 Rainbow6 #1
' 9 Rainbow6 #2
' 2 Rainbow18 #1
' 10 Rainbow18 #2
' 3 Grayscale #1
' 11 Grayscale #2
' 4 Grayscale #1
' 12 Grayscale #2
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' CYCLE FORE COLOR
' 1, 5, 9 = simple rainbow
If colorScheme
= 1 Or colorScheme
= 9 Then myColor = cOrange&
myColor = cYellow&
myColor = cGreen&
myColor = cBlue&
myColor = cPurple&
myColor = cRed&
' 2, 6, 10 = complex rainbow
myColor = cOrangeRed&
myColor = cDarkOrange&
myColor = cOrange&
myColor = cGold&
myColor = cYellow&
myColor = cChartreuse&
myColor = cLime&
myColor = cMediumSpringGreen&
Case cMediumSpringGreen&:
myColor = cCyan&
myColor = cDeepSkyBlue&
myColor = cDodgerBlue&
myColor = cSeaBlue&
myColor = cBlue&
myColor = cBluePurple&
myColor = cDeepPurple&
myColor = cPurple&
myColor = cPurpleRed&
myColor = cRed&
' 3, 7, 11 = grayscale, ascending
myColor = cDarkGray&
myColor = cDimGray&
myColor = cGray&
myColor = cLightGray&
myColor = cSilver&
myColor = cWhite&
'myColor = cBlack&
myColor = cSilver&
' go in the other direction!
colorScheme = 4
colorScheme = 12
' 4, 8, 12 = grayscale, descending
myColor = cSilver&
myColor = cLightGray&
myColor = cGray&
myColor = cDimGray&
myColor = cDarkGray&
myColor = cBlack&
myColor = cDarkGray&
' go in the other direction!
colorScheme = 3
colorScheme = 11
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' NOTE: these are mostly negative numbers
' and have to be forced to positive
' when stored in the dictionary
' (only cEmpty& should be negative)
cOrangeRed&
= _RGB32(255, 69, 0)
cDarkOrange&
= _RGB32(255, 140, 0)
cOrange&
= _RGB32(255, 165, 0)
cYellow&
= _RGB32(255, 255, 0)
cChartreuse&
= _RGB32(127, 255, 0)
cMediumSpringGreen&
= _RGB32(0, 250, 154)
cDeepSkyBlue&
= _RGB32(0, 191, 255)
cDodgerBlue&
= _RGB32(30, 144, 255)
cSeaBlue&
= _RGB32(0, 64, 255)
cBluePurple&
= _RGB32(64, 0, 255)
cDeepPurple&
= _RGB32(96, 0, 255)
cPurple&
= _RGB32(128, 0, 255)
cPurpleRed&
= _RGB32(128, 0, 192)
cDarkRed&
= _RGB32(160, 0, 64)
cBrickRed&
= _RGB32(192, 0, 32)
cDarkGreen&
= _RGB32(0, 100, 0)
cOliveDrab&
= _RGB32(107, 142, 35)
cLightPink&
= _RGB32(255, 182, 193)
cHotPink&
= _RGB32(255, 105, 180)
cDeepPink&
= _RGB32(255, 20, 147)
cMagenta&
= _RGB32(255, 0, 255)
cDimGray&
= _RGB32(105, 105, 105)
cGray&
= _RGB32(128, 128, 128)
cDarkGray&
= _RGB32(169, 169, 169)
cSilver&
= _RGB32(192, 192, 192)
cLightGray&
= _RGB32(211, 211, 211)
cGainsboro&
= _RGB32(220, 220, 220)
cWhiteSmoke&
= _RGB32(245, 245, 245)
cWhite&
= _RGB32(255, 255, 255)
cDarkBrown&
= _RGB32(128, 64, 0)
cLightBrown&
= _RGB32(196, 96, 0)
cKhaki&
= _RGB32(240, 230, 140)
cEmpty& = -1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++