' ################################################################################################################################################################
' #TOP
' Isomatric mapping demo re-revisited
' Version 3.00 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
' * editor v1 = simple drawing program
' - change lowest z level to draw full blocks instead of flat tiles (leftover from early version)
' - add type RecordType to hold recording steps
' - add array m_arrRecord of RecordType to hold recording
' - display palette of available colors on screen
' + 26 colors including empty
' + 2 tiles (empty, wall)
' - cursor places tiles (ENTER = add/delete at current space)
' - 0-9 keys change colors/etc.
' - simple 1-level UNDO & REDO
' - save screens to file (stored as editable text)
' + FORMAT: tile={t},color={c},x={x},y={y},z={z}
' - load screens line by line (split was too slow)
' + PARSER:
' 1. remove whitespace
' 2. split by "," into 1D array of name/value pairs
' 3. each element is either tile, color, x, y, z
' 4. parse each into array to playback recording
' - run commands in m_arrRecord to plot tiles and display
' * 2-D front/back "map" view of the player's current Y slice.
' * 2-D right/left "map" view of the player's current X slice.
' -----------------------------------------------------------------------------
' TO DO:
' * get _BUTTON or some method working to detect keydown/keyup events for CTRL+Z, CTRL+Y for UNDO & REDO
' * save unlinited levels of undo/redo, using history of actions
' * 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: TBD
' + PARSER:
' 1. Commands:
' - cls
' - rotate perspective (up, down, left, right, back, forward), FORMAT: rotate={d}
' - enable/disable screen update every step, FORMAT: realtime{on/off}
' - set speed, FORAT: speed={s}
' - update screen, FORMAT: update
' - clear screen "cls"
' - select tile
' - change color
' - movement? (speed / direction)
' - 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, Zaxxon meets Atari 2600 Superman, Isometric Atari 2600 Raiders of the Lost Ark, 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)
' ################################################################################################################################################################
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' =============================================================================
' GLOBAL DECLARATIONS
' -----------------------------------------------------------------------------
' 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)
Typ
As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc. Alpha1
As Integer ' transparency of tile Color1
' 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
' WHERE TO SHOW THE SPLIT SCREENS
' WHERE TO DRAW THE PLAYER'S MINI MAPS
' WHERE TO LOCATE(Y,X) THE PLAYER'S MINI MAP TEXT LABELS
' TODO: later this will probably be bitmap text
' =============================================================================
' 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
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
' TODO: ADD UNLIMITED UNDO, FOR NOW ONE LEVEL IS BETTER THAN NONE!
' This array is used to hold user's drawing actions,
' to save drawings and for playback, and later for Undo/Redo.
' How big will the recording get?
' Max # tiles in (32x32x32) world = 32,768
' Max # tiles for 16 (32x32x32) worlds = 524,288
' Max # tiles for 256 (32x32x32) worlds = 8,388,608
' 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
' TODO: REPLACE THIS HACK WAY OF TRACKING KEY UP/DOWN
' =============================================================================
' 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, 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 "5. Draw in 2.5D! <- now with the color white working!" 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. Dim MapTileTempUndo
As MapUndoType
' =============================================================================
' 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(1).MiniMapTopDownX = 50
m_arrSplitScreen(1).MiniMapTopDownY = 560
m_arrSplitScreen(1).MiniMapFrontBackX = 50
m_arrSplitScreen(1).MiniMapFrontBackY = 720
m_arrSplitScreen(1).MiniMapRightLeftX = 50
m_arrSplitScreen(1).MiniMapRightLeftY = 880
m_arrSplitScreen(1).MiniMapFirstPersonX = 70
m_arrSplitScreen(1).MiniMapFirstPersonY = 450
m_arrSplitScreen(1).MiniMapTopDownTextX = 8
m_arrSplitScreen(1).MiniMapTopDownTextY = 35
m_arrSplitScreen(1).MiniMapFrontBackTextX = 8
m_arrSplitScreen(1).MiniMapFrontBackTextY = 45
m_arrSplitScreen(1).MiniMapRightLeftTextX = 8
m_arrSplitScreen(1).MiniMapRightLeftTextY = 55
m_arrSplitScreen(1).MiniMapFirstPersonTextX = 8
m_arrSplitScreen(1).MiniMapFirstPersonTextY = 31
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
'TODO: add minimap parameters for player 2
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
'TODO: add minimap parameters for player 3
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
'TODO: add minimap parameters for player 4
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
ClearIsometricMap
ReDim m_arrRecord
(-1) As RecordType
' -----------------------------------------------------------------------------
' 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
' -----------------------------------------------------------------------------
' DRAW FLOOR
For iLoopZ%
= m_iMapMinZ
To m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' ALTERNATE TILE COLORS
If IsEven%
(iLoopX%
) = TRUE
Then If IsEven%
(iLoopY%
) = TRUE
Then PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
If IsEven%
(iLoopY%
) = TRUE
Then PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
' -----------------------------------------------------------------------------
' 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%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
iLoopY% = iPosY2%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
' Draw left/right walls
For iLoopY%
= iPosY1%
To iPosY2%
iLoopX% = iPosX1%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
iLoopX% = iPosX2%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
' Add a door to middle of right wall
iX% = iPosX1% + ((iPosX2% - iPosX1%) \ 2)
PlotTile iX%, iPosY2%, iZ%, c_iTile_Empty, iNextColor~&
' Add a door to middle of front wall
iY% = iPosY1% + ((iPosY2% - iPosY1%) \ 2)
PlotTile iPosX2%, iY%, iZ%, c_iTile_Empty, iNextColor~&
' 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 PlotTile iLoopX%, m_iMapMaxY - 3, m_iMapMaxZ, c_iTile_Wall, cPurple
PlotTile iLoopX%, m_iMapMinY + 3, m_iMapMaxZ, c_iTile_Wall, cCyan
For iLoopY%
= m_iMapMinY
+ 3 To m_iMapMaxY
- 3 PlotTile m_iMapMinX + 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cOrange
PlotTile m_iMapMaxX - 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cLime
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
For iLoopX%
= m_iMapMinX
+ 2 To m_iMapMaxX
- 2 PlotTile iLoopX%, m_iMapMaxY - 2, m_iMapMidZ, c_iTile_Wall, cDodgerBlue
PlotTile iLoopX%, m_iMapMinY + 2, m_iMapMidZ, c_iTile_Wall, cDeepPurple
For iLoopY%
= m_iMapMinY
+ 2 To m_iMapMaxY
- 2 PlotTile m_iMapMinX + 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cDarkRed
PlotTile m_iMapMaxX - 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cGold
' -----------------------------------------------------------------------------
' DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
For iLoopX%
= m_iMapMinX
+ 1 To m_iMapMaxX
- 1 PlotTile iLoopX%, m_iMapMaxY - 1, m_iMapMinZ + 1, c_iTile_Wall, cSeaBlue
PlotTile iLoopX%, m_iMapMinY + 1, m_iMapMinZ + 1, c_iTile_Wall, cChartreuse
For iLoopY%
= m_iMapMinY
+ 1 To m_iMapMaxY
- 1 PlotTile m_iMapMinX + 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, cOrangeRed
PlotTile m_iMapMaxX - 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, 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
' INIT UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' =============================================================================
' 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%
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 TOP-DOWN X/Y 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextX:
Print "Top dn (Z-slice):" ' DRAW MAP
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
If m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Wall
Then 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%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player2
Then 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%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
'TODO: ADD OTHER TYPES
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) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
iDrawY% = (m_arrPlayer(iLoop1).y * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
' 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 TOP-DOWN X/Y 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN SHOW FRONT-BACK X/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextX:
Print "Frnt-bk (Y-slice):" ' DRAW MAP
For iLoopZ%
= m_iMapMaxZ
To m_iMapMinZ
Step -1 For iLoopX%
= m_iMapMinX
To m_iMapMaxX
iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
If m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
'TODO: ADD OTHER TYPES
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) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
' 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 FRONT-BACK X/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN SHOW RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextX:
Print "Rt-left (X-slice):" ' DRAW MAP
For iLoopZ%
= m_iMapMaxZ
To m_iMapMinZ
Step -1 For iLoopY%
= m_iMapMinY
To m_iMapMaxY
iDrawX% = ((m_iMapMaxY - iLoopY%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
If m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
'TODO: ADD OTHER TYPES
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' DRAW THE PLAYERS ON THE MINI MAP
For iLoop1
= m_iPlayerMin
To m_iPlayerCount
iDrawX% = ((m_iMapMaxY - m_arrPlayer(iLoop1).y) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
' 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 RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' TODO: SHOW SIMPLE FIRST-PERSON MINI-DISPLAY ON SCREEN
' POINTING WHICHEVER WAY USER MOVED LAST
' -----------------------------------------------------------------------------
' =============================================================================
' BEGIN GET KEYBOARD INPUT WITH _BUTTON
' =============================================================================
' *** HEY WHY HAS _BUTTON STOPPED WORKING? DID I NOT GET A MEMO? ***
' -----------------------------------------------------------------------------
' BEGIN UNDO v1
' TODO: unlimited levels of undo, for now just 1
' -----------------------------------------------------------------------------
'IF _BUTTON(KeyCode_CtrlLeft%) OR _BUTTON(KeyCode_CtrlRight%) THEN
' IF _BUTTON(KeyCode_Z%) THEN
' IF Not m_bButton_Z THEN
' m_bButton_Z = TRUE
' ' UNDO!
' END IF
' ELSEIF _BUTTON(KeyCode_Y%) THEN
' IF Not m_bButton_Y THEN
' m_bButton_Y = TRUE
' ' REDO!
' END IF
' END IF
'END IF
'
' TRACK WHEN KEYS ARE RELEASED (DISABLES REPEATING KEYS)
'IF Not _BUTTON(KeyCode_Z%) THEN
' m_bButton_Z = FALSE
'END IF
'IF Not _BUTTON(KeyCode_Y%) THEN
' m_bButton_Y = FALSE
'END IF
' -----------------------------------------------------------------------------
' END UNDO v1
' -----------------------------------------------------------------------------
' =============================================================================
' END GET KEYBOARD INPUT WITH _BUTTON
' =============================================================================
' =============================================================================
' 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 UNDO/REDO INPUT
' =============================================================================
If iLastKey
<> c_iKeyDown_A
Then iLastKey = c_iKeyDown_A
' UNDO!
MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
m_MapTileUndo.Typ = MapTileTempUndo.Typ
m_MapTileUndo.Color1 = MapTileTempUndo.Color1
m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
If iLastKey
<> c_iKeyDown_B
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_B
' REDO! *** FOR NOW IT'S THE SAME AS UNDO, JUST SWAPS CURRENT WITH UNDO INFO ***
MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
m_MapTileUndo.Typ = MapTileTempUndo.Typ
m_MapTileUndo.Color1 = MapTileTempUndo.Color1
m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
' =============================================================================
' END GET UNDO/REDO 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
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' DRAW CURRENT COLOR (OR ERASE IF COLOR=TRANSPARENT)
PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 4 erase
If iLastKey
<> c_iKeyDown_4
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_4
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' ERASE CURRENT TILE
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 5 toggle
If iLastKey
<> c_iKeyDown_5
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_5
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' TOGGLE CURRENT TILE:
If m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iTile_Empty
Then 'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Wall
PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 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
ReDim m_arrRecord
(-1) As RecordType
ClearIsometricMap
'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
' Next iLoopZ%
' Next iLoopY%
'Next iLoopX%
' -----------------------------------------------------------------------------
' 8 open
If iLastKey
<> c_iKeyDown_8
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_8
sNextErr = LoadIsometricDrawing$
' -----------------------------------------------------------------------------
' 9 save
If iLastKey
<> c_iKeyDown_9
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_9
sNextErr = SaveIsometricDrawing$
' =============================================================================
' 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
' =============================================================================
' =============================================================================
' BEGIN 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%
' =============================================================================
' END MOVE PLAYER BASED ON DIRECTION
' =============================================================================
' =============================================================================
' BEGIN 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 CYCLE COLOR
' =============================================================================
' ****************************************************************************************************************************************************************
' END PLAYER LOOP
' ****************************************************************************************************************************************************************
CleanupAndExit:
' FINISH UP AND EXIT
IsometricDraw1$ = sResult
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' PLOT TILE TO MAP AND SAVE TO RECORDING
'PlotTile iX, iY, iZ, iTile, ulngColor1
m_arrMap(iX, iY, iZ).Typ = iTile
m_arrMap(iX, iY, iZ).Color1 = ulngColor1
m_arrMap(iX, iY, iZ).Alpha1 = 255
m_arrMap(iX, iY, iZ).AlphaOverride = 255
LogPlotTile iX, iY, iZ, iTile, ulngColor1
' /////////////////////////////////////////////////////////////////////////////
' SAVE PLOT COMMAND TO RECORDING
'LogPlotTile iX, iY, iZ, iTile, ulngColor1
m_arrRecord(iIndex).Command = "plot"
m_arrRecord(iIndex).intParam1 = iX
m_arrRecord(iIndex).intParam2 = iY
m_arrRecord(iIndex).intParam3 = iZ
m_arrRecord(iIndex).intParam4 = iTile
m_arrRecord(iIndex).ulngParam1 = ulngColor1
' /////////////////////////////////////////////////////////////////////////////
' - save screens to file (stored as editable text)
' + FORMAT: [tile=t][color@x,y,z][color@x,y,z][color@x,y,z]...
Dim RoutineName
As String:: RoutineName
= "SaveIsometricDrawing$" '_echo "--------------------------------------------------------------------------------"
'_echo "Started " + RoutineName
'_echo "--------------------------------------------------------------------------------"
' Get file name
m_SaveFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "txt" Print "Default file name is " + Chr$(34) + m_SaveFileName$
+ Chr$(34) + "." Input "Type save file name, or blank for default: ", in$
m_SaveFileName$ = in$
sFile = m_ProgramPath$ + m_SaveFileName$
'_echo "sFile=" + CHR$(34) + sFile + CHR$(34)
' Save recording to file
'[tile=t][color@x,y,z][color@x,y,z][color@x,y,z]
If m_arrRecord
(iIndex
).Command
= "plot" Then sLine = ""
sLine = sLine + "plot,"
sLine
= sLine
+ "tile=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam4
)) + "," sLine
= sLine
+ "color=" + _Trim$(Str$(m_arrRecord
(iIndex
).ulngParam1
)) + "," sLine
= sLine
+ "x=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam1
)) + "," sLine
= sLine
+ "y=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam2
)) + "," sLine
= sLine
+ "z=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam3
)) iCount = iCount + 1
'_echo "SKIPPED m_arrRecord(" + _Trim$(Str$(iIndex)) + ") INVALID .Command=" + CHR$(34) + m_arrRecord(iIndex).Command + CHR$(34)
iError = iError + 1
Input "PRESS <ENTER> TO CONTINUE", in$
SaveIsometricDrawing$ = sError
' /////////////////////////////////////////////////////////////////////////////
' - 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$ = "draw"
' [n][1] = intParam1 = x
' [n][2] = intValue2 = y
' [n][3] = intValue3 = z
' [n][4] = intParam4 = tile #
' [n][5] = intValue5 = alpha1
' [n][6] = ulngValue1 = color1
Dim RoutineName
As String:: RoutineName
= "LoadIsometricDrawing$" ReDim m_arrRecord
(-1) As RecordType
'Dim sDebugLine As String
'_echo "--------------------------------------------------------------------------------"
'_echo "Started " + RoutineName
'_echo "--------------------------------------------------------------------------------"
' Get file name
m_SaveFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "txt" Print "Default file name is " + Chr$(34) + m_SaveFileName$
+ Chr$(34) + "." Input "Type name of file to open, or blank for default: ", in$
m_SaveFileName$ = in$
sFile = m_ProgramPath$ + m_SaveFileName$
' Make sure file exists
sError
= "File not found: " + Chr$(34) + sFile
+ Chr$(34) '_echo "Found file: " + chr$(34) + sFile + chr$(34)
' Load recording from file
ClearIsometricMap
ReDim m_arrRecord
(-1) As RecordType
'_echo "OPEN sFile FOR BINARY AS #1"
iTotal
= Len(sText
) - Len(Replace$
(sText
, Chr$(13), "")) sText = ""
' SPLIT IS TOO SLOW!
'_echo "split sText, CHR$(13), arrLines()"
'split sText, CHR$(13), arrLines()
'iTotal = ubound(arrLines)-1
' PARSE LINES: plot,tile=2,color=4294901760,x=10,y=10,z=10
iStatusCount = 0
iStatusEvery = iTotal / 100
'Print "iTotal =" + _Trim$(Str$(iTotal))
'Print "iStatusEvery=" + _Trim$(Str$(iStatusEvery))
'Input "PRESS <ENTER> TO CONTINUE",in$
'FOR iLine = lbound(arrLines) TO ubound(arrLines)-1
'sLine = arrLines(iLine)
'INPUT #1, sLine
Line Input #1, sLine
' read entire text file line
iRead = iRead + 1
'_echo "Parsing line " + _Trim$(Str$(iRead))
' SHOW STATUS
' TODO: FIX <- DOESN'T SEEM TO DISPLAY UNTIL THE END, ALL AT ONCE
iStatusCount = iStatusCount + 1
If iStatusCount
> iStatusEvery
Then iStatusCount = 0
iPercent = 100 * (iRead / iTotal)
'_echo _Trim$(Str$(iPercent)) + "%"
'sDebugLine = sLine
'sDebugLine = Replace$(sDebugLine, CHR$(9), "\t")
'sDebugLine = Replace$(sDebugLine, CHR$(13), "\n")
'sDebugLine = Replace$(sDebugLine, CHR$(10), "\r")
'_echo " Raw =" + chr$(34) + sDebugLine + chr$(34)
''_echo " Raw =" + chr$(34) + arrLines(iLine) + chr$(34)
sLine = Replace$(sLine, " ", "") ' Remove spaces
sLine
= Replace$
(sLine
, Chr$(9), "") ' Remove tabs sLine
= Replace$
(sLine
, Chr$(10), "") ' Remove line breaks sLine
= Replace$
(sLine
, Chr$(13), "") ' Remove carriage returns '_echo " Trimmed=" + chr$(34) + sLine + chr$(34)
split sLine, ",", arrNextLine()
'_echo " lbound =" + _Trim$(Str$(lbound(arrNextLine))) '+ CHR$(10)
'_echo " ubound =" + _Trim$(Str$(ubound(arrNextLine))) '+ CHR$(10)
sCommand
= arrNextLine
(LBound(arrNextLine
)) '_echo " Command=" + chr$(34) + sCommand + chr$(34)
iKnown = iKnown + 1
sPair = arrNextLine(iPair)
split sPair, "=", arrNameValue()
sValue
= arrNameValue
(LBound(arrNameValue
) + 1) sValue = ""
sName = ""
sNextErr = ""
sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Unknown parameter: " + Chr$(34) + sName
+ Chr$(34) + "," + Chr$(34) + sValue
+ Chr$(34) iValid = iValid + 1
'_echo "READ VALUES SUCCESSFULLY:" + CHR$(13)
'_echo "iTile =" + _Trim$(Str$(iTile)) + CHR$(13)
'_echo "ulngColor1=" + _Trim$(Str$(ulngColor1)) + CHR$(13)
'_echo "iX =" + _Trim$(Str$(iX)) + CHR$(13)
'_echo "iY =" + _Trim$(Str$(iY)) + CHR$(13)
'_echo "iZ =" + _Trim$(Str$(iZ)) + CHR$(13)
''EXIT FOR
PlotTile iX, iY, iZ, iTile, ulngColor1
iErrors = iErrors + 1
Print " ERROR: " + sNextErr
''_echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
'_echo " ERROR: " + sNextErr
''EXIT FOR
''_echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
'_echo " command not recognized: skipped"
iUnknown = iUnknown + 1
''_echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
'_echo " Line is blank: skipped"
iSkipped = iSkipped + 1
'NEXT iLine
Input "PRESS <ENTER> TO CONTINUE", in$
LoadIsometricDrawing$ = sError
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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&
)
' 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.qb64.[net]/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
' /////////////////////////////////////////////////////////////////////////////
Function GetPaletteFromColor%
(iColor~&
) 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
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 ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm
Sub DrawTextLine
(x%
, y%
, x2%
, y2%
, c$
) 'bError% = FALSE
'LOCATE 2, 2: PRINT "(" + STR$(x%) + "," + STR$(y%) + ") to (" + STR$(x2%) + "," + STR$(y2%) + ") of " + CHR$(34) + c$ + CHR$(34);
i% = 0
steep% = 0
e1% = 0
steep% = 1
e1% = 2 * dy% - dx%
'PSET (y%, x%), c%:
'PSET (x%, y%), c%
y% = y% + sy%: e1% = e1% - 2 * dx%
x% = x% + sx%: e1% = e1% + 2 * dy%
'PSET (x2%, y2%), c%
' /////////////////////////////////////////////////////////////////////////////
' 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
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' 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
' /////////////////////////////////////////////////////////////////////////////
' 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
' /////////////////////////////////////////////////////////////////////////////
' 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
' /////////////////////////////////////////////////////////////////////////////
' Writes sText to a debug file in the EXE folder.
' Debug file is named the same thing as the program EXE name with ".txt" at the end.
' For example the program "C:\QB64\MyProgram.BAS" running as
' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
' If the file doesn't exist, it is created, otherwise it is appended to.
sFileName = ProgramPath$ + ProgramName$ + ".txt"
sError = ""
sOut = ""
sOut
= sOut
+ "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10) sOut
= sOut
+ "PROGRAM : " + ProgramName$
+ Chr$(13) + Chr$(10) sOut
= sOut
+ "RUN DATE: " + CurrentDateTime$
+ Chr$(13) + Chr$(10) sOut
= sOut
+ "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10) sError = PrintFile$(sFileName, sOut, FALSE)
sError = PrintFile$(sFileName, sText, TRUE)
Print CurrentDateTime$
+ " PrintDebugFile FAILED: " + sError
' /////////////////////////////////////////////////////////////////////////////
' 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
' /////////////////////////////////////////////////////////////////////////////
' 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&
' /////////////////////////////////////////////////////////////////////////////
' 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
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.qb64.org)
' 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
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------"
in$ = "Thiz iz a teZt."
in$ = Replace$(in$, "z", "s")
in$ = Replace$(in$, "Z", "s")
Print "ReplaceTest finished."
' /////////////////////////////////////////////////////////////////////////////
' 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.
' Modified to handle multi-character delimiters
Sub split
(in$
, delimiter$
, result$
())
iDelimLen
= Len(delimiter$
)
start = 1
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$
, start
, iDelimLen
) = delimiter$
'start = start + 1
start = start + iDelimLen
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."
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------" Print "SplitAndReplaceTest"
in$
= "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
Print "Fixing linebreaks..."
split in$
, Chr$(13), arrTest$
()
Print "SplitAndReplaceTest 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 ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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
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)
' 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)
cBluePurple
= _RGB32(64, 0, 255)
cDeepPurple
= _RGB32(96, 0, 255)
cPurpleRed
= _RGB32(128, 0, 192)
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)
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) 'cWhite = _RGB32(254, 254, 254)
cDarkBrown
= _RGB32(128, 64, 0)
cLightBrown
= _RGB32(196, 96, 0)
cKhaki
= _RGB32(240, 230, 140)
'cEmpty~& = -1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
KeyCode_CtrlLeft% = 30
KeyCode_CtrlRight% = 286
KeyCode_Y% = 22
KeyCode_Z% = 45
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END KEYBOARD CODE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' #END
' ################################################################################################################################################################
