' ################################################################################################################################################################
' #TOP
' Isomatric mapping demo re-revisited
' Version 3.00.14 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
' + 26 colors including empty
' + 2 tiles (empty, wall)
' - cursor places tiles (ENTER = add/delete at current space)
' - 0-9 keys change colors/etc.
' - CTRL+Z, CTRL+Y UNDO & REDO ? (save levels of undo, or history of commands)
' - 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)
' * 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)
' * for 2.5D animation program: independent animated objects?
' - 2.5D sprites?
' + animation sequence
' + motion path / algorithm
' + storage / library
' + multiple instances?
' - gravity? (tile falls if no tiles underneath)
' ################################################################################################################################################################
' =============================================================================
' 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
' -----------------------------------------------------------------------------
' Constants for layers
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Tile value constants for map (MapTileType.Typ)
' -----------------------------------------------------------------------------
Const c_iTile_Player1
= 5 Const c_iTile_Player2
= 6 Const c_iTile_Player3
= 7 Const c_iTile_Player4
= 8 Const c_iTile_Blinking
= 9 Const c_iTile_Slope45
= 11 Const c_iTile_InvSlope45
= 12
' -----------------------------------------------------------------------------
' constants for 2.5D movement
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' constants for drawing the 2.5D screen
' -----------------------------------------------------------------------------
Const cScreenOffsetX
= 500 Const cScreenOffsetY
= 300
' =============================================================================
' USER DEFINED TYPES
' =============================================================================
Typ
As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc. 'Vis As Integer ' TRUE = visible, FALSE = don't render
'Lit As Long ' light offset
Alpha1
As Integer ' transparency of tile Color1 Alpha2
As Integer ' transparency of tile Color2 Alpha3
As Integer ' transparency of tile Color3 AlphaOverride
As Integer ' can be used to override alpha (255 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 _Unsigned Long ' secondary color if needed
'Color3 As _Unsigned Long ' third color if needed
Alpha1
As Integer ' transparency of player Color1 'Alpha2 As Integer ' transparency of player Color2
'Alpha3 As Integer ' 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!
Dim Shared m_iObjectCount
As Integer : m_iObjectCount
= 0 ' <- TO BE USED WHEN WE HAVE OBJECTS
' 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_arrRender1
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrRender2
(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
' Store colors in an array
' =============================================================================
' 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 "v3.00.14, 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 "4. BoxDrawTest1$ <- draws white OK" Print "5. Draw in 2.5D! <- draws all colors except white(?)" Print "What to do? ('q' to exit)"
result$ = IsometricDemo1$
result$ = IsometricDemo2$
result$ = IsometricDemo3$
result$ = BoxDrawTest1$
result$ = IsometricDraw1$
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo1$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo2$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo3$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
' Test all the values 0-255 for style
' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
iSize% = 48 ' {n}x{n} pixels square
iDrawX% = 10
iDrawY% = 10
iNextColor& = cWhite&
iSpace% = 8
DrawStyledOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor&, iLoop
'DrawOutlineBox iDrawX%+1, iDrawY%+1, iSize%-2, iNextColor&, iLoop
iDrawX% = iDrawX% + iSize% + iSpace%
IF iDrawX%
> (1280 - (iSize%
* 2)) THEN iDrawX% = 10
iDrawY% = iDrawY% + iSize% + iSpace%
IF iDrawY%
> (1024 - (iSize%
* 2)) THEN sError = "Ran out of Y space."
FOR iLoop
= 1 TO (iSize% \
2) DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor&, iLoop
iDrawX% = iDrawX% + iSize% + iSpace%
IF iDrawX%
> (1280 - (iSize%
* 2)) THEN iDrawX% = 10
iDrawY% = iDrawY% + iSize% + iSpace%
IF iDrawY%
> (1024 - (iSize%
* 2)) THEN sError = "Ran out of Y space."
INPUT "PRESS <ENTER> TO CONTINUE";in$
BoxDrawTest1$ = ""
' /////////////////////////////////////////////////////////////////////////////
' Lets you draw a scene in 2.5D and save it to a file. Woo hoo!
' Version 1 only supports 2 tile types:
' c_iTile_Empty
' c_iTile_Wall
Dim RoutineName
As String: RoutineName
= "IsometricDraw1" Dim iTotal%
' compute total available spaces Dim iCount%
' count # of spaces searched
Dim bIgnoreTerrain
As Integer ' If TRUE, player can move through walls, etc.
' =============================================================================
' GET OPTIONS
m_iPlayerCount = 1
'm_iPlayerCount = PromptForIntegerInRange%("How many players ({min}-{max} or blank to quit)?", 1, 4, 0)
'IF m_iPlayerCount = 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
' -----------------------------------------------------------------------------
' INITIALIZE COLOR ARRAY
m_arrColors( 0) = cEmpty&
m_arrColors( 1) = cBlack&
m_arrColors( 2) = cDarkGray&
m_arrColors( 3) = cDimGray&
m_arrColors( 4) = cGray&
m_arrColors( 5) = cLightGray&
m_arrColors( 6) = cSilver&
m_arrColors( 7) = cWhite&
m_arrColors( 8) = cRed&
m_arrColors( 9) = cOrangeRed&
m_arrColors(10) = cDarkOrange&
m_arrColors(11) = cOrange&
m_arrColors(12) = cGold&
m_arrColors(13) = cYellow&
m_arrColors(14) = cOliveDrab1&
m_arrColors(15) = cLime&
m_arrColors(16) = cMediumSpringGreen&
m_arrColors(17) = cCyan&
m_arrColors(18) = cDeepSkyBlue&
m_arrColors(19) = cDodgerBlue&
m_arrColors(20) = cSeaBlue&
m_arrColors(21) = cBlue&
m_arrColors(22) = cBluePurple&
m_arrColors(23) = cDeepPurple&
m_arrColors(24) = cPurple&
m_arrColors(25) = cPurpleRed&
' -----------------------------------------------------------------------------
' INITIALIZE OTHER VARIABLES
bIgnoreTerrain = TRUE
m_bTesting = TRUE
m_arrMap(10, 10, 10).Typ = c_iTile_Wall
m_arrMap(10, 10, 10).Color1 = cRed&
m_arrMap(10, 10, 10).AlphaOverride = 255
m_arrMap(15, 10, 10).Typ = c_iTile_Wall
m_arrMap(15, 10, 10).Color1 = cWhite& ' cLime&
m_arrMap(15, 10, 10).AlphaOverride = 255
m_arrMap(20, 10, 10).Typ = c_iTile_Wall
m_arrMap(20, 10, 10).Color1 = cBlue&
m_arrMap(20, 10, 10).AlphaOverride = 255
' -----------------------------------------------------------------------------
' 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_iTile_Floor
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cWhite& ' 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.
iNextColor& = cWhite&
iColorScheme% = 3 ' 3, 11 = grayscale, ascending
iLevelCount% = 0
bContinue = TRUE
' Draw front/back walls
For iLoopX%
= iPosX1%
To iPosX2%
iLoopY% = iPosY1%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
iLoopY% = iPosY2%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_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_iTile_Wall
m_arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
m_arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
iLoopX% = iPosX2%
m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_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_iTile_Empty
' Add a door to middle of front wall
iY% = iPosY1% + ( (iPosY2% - iPosY1%) \ 2)
m_arrMap(iPosX2%, iY%, iZ%).Typ = c_iTile_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_iTile_Wall
m_arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Color1 = cWhite& ' cPurple&
m_arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Typ = c_iTile_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_iTile_Wall
m_arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Color1 = cOrange&
m_arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Typ = c_iTile_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_iTile_Wall
m_arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Color1 = cWhite& ' cDodgerBlue&
m_arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Typ = c_iTile_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_iTile_Wall
m_arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Color1 = cDarkRed&
m_arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Typ = c_iTile_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_iTile_Wall
m_arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Color1 = cWhite& ' cSeaBlue&
m_arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Typ = c_iTile_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_iTile_Wall
m_arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Color1 = cOrangeRed&
m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Typ = c_iTile_Wall
m_arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Color1 = cDeepSkyBlue&
' =============================================================================
' PLACE PLAYER(S) <- ONLY ONE FOR THIS DEMO
FOR iPlayerLoop
= 1 TO m_iPlayerCount
' -----------------------------------------------------------------------------
' BEGIN Map the 6 directional keys
' -----------------------------------------------------------------------------
'*** CURRENTLY THIS IS NOT USED ***
'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
'TODO: WHATEVER THE KEYS MAPPED ARE, SWAP THEM NON-HARDCODED
' 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_iTile_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_iTile_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_iTile_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
' ********************************************************************************
' *** THIS IS NOW DONE AT THE RENDERING LEVEL FOR PLAYERS AND NON-TERRAIN OBJECTS
' ********************************************************************************
'' 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
iDrawColor% = 8 ' RED
iCursorColor& = cRed&
bFinished = FALSE
' SHOW INSTRUCTIONS / COORDINATES ON SCREEN
LOCATE 3, 3:
PRINT "CRSR RT/LF MOVES X = " + CSTR$
(iX%
) LOCATE 4, 3:
PRINT "CRSR UP/DN MOVES Y = " + CSTR$
(iY%
) LOCATE 5, 3:
PRINT "PAGE UP/DN MOVES Z = " + CSTR$
(iZ%
) LOCATE 6, 3:
PRINT "= / - CHANGES GRID SIZE = " + CSTR$
(m_arrPlayer
(1).GridSize
) LOCATE 7, 3:
PRINT "[ / ] TOGGLES MOVEMENT = " + IIFSTR$
(m_arrPlayer
(1).IsMoving
, "TRUE", "FALSE") LOCATE 8, 3:
PRINT "INS / DEL TOGGLES REPEAT KEYS = " + IIFSTR$
(bEnableRepeatingKeys
, "TRUE", "FALSE") LOCATE 9, 3:
PRINT ", / . CHANGES MINI MAP SIZE = " + CSTR$
(m_arrPlayer
(1).MapSize
)
' ****************************************************************************************************************************************************************
' BEGIN DRAW PALETTE
' ****************************************************************************************************************************************************************
'TODO: support variable screen resolutions instead of hardcoded 1280x1024
iSize% = 24 ' {n}x{n} pixels square
iDrawX% = 10
iOffsetY% = 350
iDrawY% = iOffsetY%+(iLoop1 * iSize%)
' COLOR = TRANSPARENT
' DRAW A CHECKERBOARD PATTERN FOR TRANSPARENT
iFirstColor& = cDarkGray&
FOR iLoopY%
= iDrawY%
TO ((iDrawY%
+ iSize%
)-4) STEP 4 IF iFirstColor&
= cDarkGray&
THEN iFirstColor& = cGray&
iFirstColor& = cDarkGray&
iNextColor& = iFirstColor&
FOR iLoopX%
= iDrawX%
TO ((iDrawX%
+ iSize%
)-4) STEP 4 DrawBox iLoopX%, iLoopY%, 4, iNextColor&
IF iNextColor&
= cDarkGray&
THEN iNextColor& = cGray&
iNextColor& = cDarkGray&
' COLOR = BLACK
iNextColor& = m_arrColors(iLoop1)
DrawBox iDrawX%, iDrawY%, iSize%, iNextColor&
' DRAW A BORDER AROUND IT
iNextColor& = cDarkGray&
DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor&, 1
' DRAW WHITE BOX AROUND CURRENT COLOR
DoCycleColor 1, iCursorColor&
iDrawY% = iOffsetY%+(iDrawColor% * iSize%)
DrawOutlineBox iDrawX%, iDrawY%, iSize%, iCursorColor&, 1
' ****************************************************************************************************************************************************************
' END DRAW PALETTE
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' BEGIN PLAYER LOOP
' ****************************************************************************************************************************************************************
DrawScreen c_iDir_Forward, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
m_bTesting = FALSE
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 m_iPlayerCount
'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_iTile_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_iTile_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_iTile_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_iTile_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_iTile_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&
' DRAW THE PLAYERS ON THE MINI MAP
For iLoop1
= m_iPlayerMin
To m_iPlayerCount
iDrawX% = (m_arrPlayer(iLoop1).x * m_arrPlayer(1).MapSize) + 20
iDrawY% = (m_arrPlayer(iLoop1).y * m_arrPlayer(1).MapSize) + 200
' TODO: ADD Alpha PARAMETER TO DrawBox
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
' DRAW THE OBJECTS ON THE MINI MAP
' (TO DO WHEN WE ADD OBJECTS)
' -----------------------------------------------------------------------------
' 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
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN GET DRAWING INPUT
' -----------------------------------------------------------------------------
' 1 color-
If iLastKey
<> c_iKeyDown_1
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_1
iDrawColor% = iDrawColor% - 1
iDrawColor% = 25
' 2 color+
If iLastKey
<> c_iKeyDown_2
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_2
iDrawColor% = iDrawColor% + 1
iDrawColor% = 0
' 3 draw
If iLastKey
<> c_iKeyDown_3
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_3
m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Wall
m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
m_arrMap(iX%, iY%, iZ%).Color1 = m_arrColors(iDrawColor%)
m_arrMap(iX%, iY%, iZ%).Alpha1 = 255
m_arrMap(iX%, iY%, iZ%).AlphaOverride = 255
' 4 erase
If iLastKey
<> c_iKeyDown_4
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_4
m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
' 5 toggle
If iLastKey
<> c_iKeyDown_5
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_5
IF m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iTile_Empty
THEN m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Wall
m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
m_arrMap(iX%, iY%, iZ%).Color1 = m_arrColors(iDrawColor%)
m_arrMap(iX%, iY%, iZ%).Alpha1 = 255
m_arrMap(iX%, iY%, iZ%).AlphaOverride = 255
m_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
' 6 eyedropper
If iLastKey
<> c_iKeyDown_6
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_6
iDrawColor% = GetPaletteFromColor%(m_arrMap(iX%, iY%, iZ%).Color1)
' 7 clear all
If iLastKey
<> c_iKeyDown_7
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_7
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cEmpty&
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1 = 255
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' 8 open
If iLastKey
<> c_iKeyDown_8
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_8
'TBD
' 9 save
If iLastKey
<> c_iKeyDown_9
OR bEnableRepeatingKeys
=TRUE
Then iLastKey = c_iKeyDown_9
'TBD
' -----------------------------------------------------------------------------
' END GET DRAWING 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
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
' -----------------------------------------------------------------------------
' --------------------------------------------------------------------------------
' 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) 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_iTile_Empty
) AND (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
iNewY% = iY%
' (DO NOTHING)
'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
' ****************************************************************************************************************************************************************
' END PLAYER LOOP
' ****************************************************************************************************************************************************************
CleanupAndExit:
' FINISH UP AND EXIT
IsometricDraw1$ = 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_iTile_Empty
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE RENDERING MAP #1 TO EMPTY
' Requires shared global variable:
' m_arrRender1(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearRenderMap1"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE RENDERING MAP #2 TO EMPTY
' Requires shared global variable:
' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearRenderMap2"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrRender2(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_arrRender2) 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_iTile_Wall
OR m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
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_arrRender2 instead of m_arrMap)
' Requires shared global variable (3D array of map):
' m_arrRender2(x,y,z) = rotated copy of 3D array map of world
' m_arrRender2(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_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
OR m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
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_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
' LEAVE THE TILE OPAQUE
m_arrRender2(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_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender2(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_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender2(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_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
'End If
'End If
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(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_arrRender2(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_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(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_iTile_Floor
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_iTile_Wall
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Water
Then 'TODO: transparent for water
iColor = cEmpty&
alpha& = 64
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_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.
' Requires shared global variable
' m_arrRender2(x,y,z) = 3D array map of world
' m_arrRender2(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_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
bTile = FALSE
iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color2
bTile = TRUE
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Water
Then 'TODO: transparent for water
iColor = cEmpty&
alpha& = 64
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_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
' TODO: player layer
' m_iPlayerCount
' shared for current player #?
' first copy world and superimpose player coords?
Sub DrawScreen
(iDirection%
, iScreenOffsetX
, iScreenOffsetY
, iGridSize
, iX%
, iY%
, iZ%
)
' =============================================================================
' USE FIRST TEMPORARY ARRAY TO STORE SCENE OVERLAID WITH PLAYERS + OBJECTS
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap1
' FIRST COPY THE MAP
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
'm_arrRender1(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
CopyMapTile m_arrMap(iLoopX%, iLoopY%, iLoopZ%), m_arrRender1(iLoopX%,iLoopY%,iLoopZ%)
' NEXT COPY THE PLAYERS
For iLoopX%
= m_iPlayerMin
To m_iPlayerCount
m_arrRender1(m_arrPlayer(iLoopX%).x,m_arrPlayer(iLoopX%).y,m_arrPlayer(iLoopX%).z).Typ = m_arrPlayer(iLoopX%).Tile1
m_arrRender1(m_arrPlayer(iLoopX%).x,m_arrPlayer(iLoopX%).y,m_arrPlayer(iLoopX%).z).Color1 = m_arrPlayer(iLoopX%).Color1
m_arrRender1(m_arrPlayer(iLoopX%).x,m_arrPlayer(iLoopX%).y,m_arrPlayer(iLoopX%).z).Alpha1 = m_arrPlayer(iLoopX%).Alpha1
m_arrRender1(m_arrPlayer(iLoopX%).x,m_arrPlayer(iLoopX%).y,m_arrPlayer(iLoopX%).z).AlphaOverride = m_arrPlayer(iLoopX%).AlphaOverride
' NEXT COPY THE OBJECTS
' (TO DO WHEN WE HAVE OBJECTS)
' =============================================================================
' USE SECOND TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap2
' COPY TILES, ROTATED TO DESIRED VIEWING PERSPECTIVE / ANGLE
' 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_arrRender2(iLoopX%,m_iMapMaxZ-iLoopZ%,iLoopY%) = m_arrRender1(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_arrRender2(iLoopX%,iLoopZ%,m_iMapMaxY-iLoopY%) = m_arrRender1(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_arrRender2(iLoopY%,m_iMapMaxX-iLoopX%,iLoopZ%) = m_arrRender1(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_arrRender2(m_iMapMaxY-iLoopY%,iLoopX%,iLoopZ%) = m_arrRender1(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_arrRender2(m_iMapMaxX-iLoopX%,m_iMapMaxY-iLoopY%,iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible m_iMapMaxX-iX%, m_iMapMaxY-iY%, iZ%, iGridSize
' FOR ALL OTHER CASES WE JUST DRAW FORWARD (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_arrRender2(iLoopX%,iLoopY%,iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, iY%, iZ%, iGridSize
DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
' /////////////////////////////////////////////////////////////////////////////
' Copies a MapTileType user defined type variable, member by member
' (not sure if you can just do MyUDT1 = MyUDT2?)
Sub CopyMapTile
(SourceMap
As MapTileType
, DestMap
As MapTileType
) DestMap.Typ = SourceMap.Typ
DestMap.Color1 = SourceMap.Color1
DestMap.Color2 = SourceMap.Color2
DestMap.Color3 = SourceMap.Color3
DestMap.Alpha1 = SourceMap.Alpha1
DestMap.Alpha2 = SourceMap.Alpha2
DestMap.Alpha3 = SourceMap.Alpha3
DestMap.AlphaOverride = SourceMap.AlphaOverride
' /////////////////////////////////////////////////////////////////////////////
' 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_iTile_Empty
And iType%
<> c_iTile_Floor
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_iTile_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&
)
_Echo " iHeight=" + cstr$
(iHeight
) _Echo " xoffset=" + cstr$
(xoffset
) _Echo " yoffset=" + cstr$
(yoffset
) _Echo " iColor=" + cstrul$
(iColor
) _Echo " alpha&=" + cstrl$
(alpha&
) _Echo " _RGB32(r, g, b, alpha&)=" + cstrul$
(_RGB32(r
, g
, b
, alpha&
))
' 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 (SOLID)
' https://www.qb64.org/wiki/LINE
'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
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX (OUTLINE)
' https://www.qb64.org/wiki/LINE
' The style parameter 0-255 doesn't seemt to have a solid line?
'SUB DrawStyledOutlineBox (iX%, iY%, iSize%, iColor%, iStyle%)
SUB DrawStyledOutlineBox
(iX%
, iY%
, iSize%
, iColor&
, iStyle%
) ' LINE [STEP] [(column1, row1)]-[STEP] (column2, row2), color[, [{B|BF}], style%]
' B creates a box outline with each side parallel to the program screen sides. BF creates a filled box.
' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
LINE (iX%
, iY%
)-(iX%
+ iSize%
, iY%
+ iSize%
), iColor&
, B
, iStyle%
END SUB ' DrawStyledOutlineBox
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX (OUTLINE) WITH A SOLID LINE
SUB DrawOutlineBox
(iX%
, iY%
, iSize2%
, iColor&
, iWeight2%
) iSize% = iSize2% - 1
iWeight% = iWeight2% - 1
' TOP LINE
iFromX% = iX%
iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iY%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' BOTTOM LINE
iFromX% = iX%
iFromY% = iY% + iSize%
iToX% = iX% + iSize%
iToY% = iY% + iSize%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' LEFT LINE
iFromX% = iX%
iFromY% = iY%
iToX% = iX%
iToY% = iY% + iSize%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' RIGHT LINE
iFromX% = iX% + iSize%
iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iY% + iSize%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' TOP LINE
FOR iFromY%
= iY%
TO (iY%
+ iWeight%
) iFromX% = iX%
'iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iFromY%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' BOTTOM LINE
FOR iFromY%
= ((iY%
+ iSize%
) - iWeight%
) TO (iY%
+ iSize%
) iFromX% = iX%
'iFromY% = iY% + iSize%
iToX% = iX% + iSize%
iToY% = iFromY%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' LEFT LINE
FOR iFromX%
= iX%
TO (iX%
+ iWeight%
) 'iFromX% = iX%
iFromY% = iY%
iToX% = iFromX%
iToY% = iY% + iSize%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' RIGHT LINE
FOR iFromX%
= ((iX%
+ iSize%
) - iWeight%
) TO (iX%
+ iSize%
) 'iFromX% = iX% + iSize%
iFromY% = iY%
iToX% = iFromX%
iToY% = iY% + iSize%
LINE (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor&
, BF
' /////////////////////////////////////////////////////////////////////////////
GetPaletteFromColor% = 0
GetPaletteFromColor% = 1
GetPaletteFromColor% = 2
GetPaletteFromColor% = 3
GetPaletteFromColor% = 4
GetPaletteFromColor% = 5
GetPaletteFromColor% = 6
GetPaletteFromColor% = 7
GetPaletteFromColor% = 8
GetPaletteFromColor% = 9
GetPaletteFromColor% = 10
GetPaletteFromColor% = 11
GetPaletteFromColor% = 12
GetPaletteFromColor% = 13
GetPaletteFromColor% = 14
GetPaletteFromColor% = 15
CASE cMediumSpringGreen&:
GetPaletteFromColor% = 16
GetPaletteFromColor% = 17
GetPaletteFromColor% = 18
GetPaletteFromColor% = 19
GetPaletteFromColor% = 20
GetPaletteFromColor% = 21
GetPaletteFromColor% = 22
GetPaletteFromColor% = 23
GetPaletteFromColor% = 24
GetPaletteFromColor% = 25
GetPaletteFromColor% = 0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsEven% = TRUE
IsEven% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsOdd% = TRUE
IsOdd% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' 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, 9 = simple rainbow
If colorScheme
= 1 Or colorScheme
= 9 Then myColor = cOrange&
myColor = cYellow&
myColor = cGreen&
myColor = cBlue&
myColor = cPurple&
myColor = cRed&
' 2, 10 = complex rainbow
myColor = cOrangeRed&
myColor = cDarkOrange&
myColor = cOrange&
myColor = cGold&
myColor = cYellow&
myColor = cOliveDrab1&
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, 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)
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
cChartreuse&
= _RGB32(127, 255, 0)
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
cOliveDrab1&
= _RGB32(192, 255, 62)
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
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' #END
' ################################################################################################################################################################