Author Topic: Isometric Demo re-revisited v2.70 added variable grid size (Read 1326 times)

madscijr · « **on:** December 04, 2021, 11:30:25 am »

Just a small update to the tweaked Isometric Mapping Demo code from
https://www.qb64.org/forum/index.php?topic=1903.30

The + and - keys now grow and shrink the grid size.

I started a bigger overhaul (moving to split screen 1-4 players, allow players to rotate angle of view)
and I wanted to post this version, because it could be a while before the next one is working!

Hopefully someone will find this useful. Comments welcome!

Code: QB64: [Select]

' ################################################################################################################################################################
' Isomatric mapping demo re-revisited
' Version 2.70 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
 
' -----------------------------------------------------------------------------
' TO DO:
' * change arrMap to global shared variable (for simpler code) & rename m_arrMap
' * allow player to rotate their view
' * auto-rotate view depending on direction player is facing
' * local multiplayer (2-4 players)
'   - move player info into array
'   - split screen (x2 or x4)
' * make simple open world (players can add/remove blocks, build in real time, save screens)
' * add ramp object
' * gravity (players stay on ground, can fall)
' * add ability to walk up ramps / climb ladders / etc.
' * add ability to jump over 1 space
' * option to remap keys
' * support game controllers
' * game controller calibration/mapping function
' * expand world to bigger than screen (2.5d scrolling view)
' * option to hide objects out of player's line-of-sight
' * show player as a stick figure (like "Realm of Impossibility")
' * walking movement
' * add objects (water, ladders, ropes, windows, doors, etc.)
' * simultaneously show additional 1st person view
' * add ability for tilting head up/down in first person
' * make simple games (maze craze, capture the flag, snake, surround, 2.5d pong)
' * make more complex games (berzerk, lode runner, atari combat / tank)
' * make awesome complex games (2.5d lunar lander, atari adventure, asteroids, gravitar, etc.)
 
' ################################################################################################################################################################
 
' =============================================================================
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
 
' -----------------------------------------------------------------------------
' boolean constants
' -----------------------------------------------------------------------------
Const FALSE = 0
Const TRUE = Not FALSE
 
' -----------------------------------------------------------------------------
' 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_1 = 49
Const c_iKeyDown_2 = 50
Const c_iKeyDown_3 = 51
Const c_iKeyDown_4 = 52
Const c_iKeyDown_5 = 53
Const c_iKeyDown_6 = 54
Const c_iKeyDown_7 = 55
Const c_iKeyDown_8 = 56
Const c_iKeyDown_9 = 57
Const c_iKeyDown_0 = 48
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_Tab = 9
Const c_iKeyDown_Q = 113
Const c_iKeyDown_W = 119
Const c_iKeyDown_E = 101
Const c_iKeyDown_R = 114
Const c_iKeyDown_T = 116
Const c_iKeyDown_Y = 121
Const c_iKeyDown_U = 117
Const c_iKeyDown_Pipe = 105
Const c_iKeyDown_O = 111
Const c_iKeyDown_P = 112
Const c_iKeyDown_BracketLeft = 91
Const c_iKeyDown_BracketRight = 93
Const c_iKeyDown_Backslash = 92
Const c_iKeyDown_A = 97
Const c_iKeyDown_S = 115
Const c_iKeyDown_D = 100
Const c_iKeyDown_F = 102
Const c_iKeyDown_G = 103
Const c_iKeyDown_H = 104
Const c_iKeyDown_J = 106
Const c_iKeyDown_K = 107
Const c_iKeyDown_L = 108
Const c_iKeyDown_SemiColon = 59
Const c_iKeyDown_Apostrophe = 39
Const c_iKeyDown_Enter = 13
Const c_iKeyDown_Z = 22
Const c_iKeyDown_X = 120
Const c_iKeyDown_C = 99
Const c_iKeyDown_V = 118
Const c_iKeyDown_B = 98
Const c_iKeyDown_N = 110
Const c_iKeyDown_M = 109
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 map (MapBlockType.Typ)
' -----------------------------------------------------------------------------
Const c_iMapType_Empty = 0
Const c_iMapType_Floor_Tiled = 1
Const c_iMapType_Wall = 2
Const c_iMapType_Water = 3
Const c_iMapType_Window = 4
Const c_iMapType_Player1 = 5
Const c_iMapType_Player2 = 6
 
' -----------------------------------------------------------------------------
' constants for 2.5D movement
' -----------------------------------------------------------------------------
Const c_iDir_Down = 1
Const c_iDir_Up = 2
Const c_iDir_Left = 3
Const c_iDir_Right = 4
Const c_iDir_Back = 5
Const c_iDir_Forward = 6
Const c_iDir_Min = 1
Const c_iDir_Max = 6
 
' -----------------------------------------------------------------------------
' constants for drawing the 2.5D screen
' -----------------------------------------------------------------------------
Const cGridOffsetX = 50
Const cGridOffsetY = 50
Const cGridOffsetZ = 0
Const cScreenOffsetX = 500 ' 450
Const cScreenOffsetY = 300 ' 50
Const cScreenOffsetZ = 0
 
' =============================================================================
' USER DEFINED TYPES
' =============================================================================
Type MapBlockType
    Typ As Integer ' c_iMapType_Empty, c_iMap_Floor_Tiled, c_iMap_Wall, etc.
    'Vis As Integer ' TRUE = visible, FALSE = don't render
    'Lit As Long ' light offset
        Color1 As Long ' main color
        Color2 As Long ' secondary color if needed
        Color3 As Long ' third color if needed  
        AlphaOverride As Integer ' can be used to override alpha (0 treated as opaque)
End Type ' MapBlockType
 
' =============================================================================
' GLOBAL VARIABLES
Dim Shared m_ProgramPath$ : m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$ : m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
Dim Shared m_iGridSize As Integer : m_iGridSize = 10 ' < 10 is causing problems with PAINT
Dim Shared m_iMapMinX As Integer : m_iMapMinX = 0
Dim Shared m_iMapMaxX As Integer : m_iMapMaxX = 32
Dim Shared m_iMapMidX As Integer : m_iMapMidX = (m_iMapMaxX-m_iMapMinX)\2
Dim Shared m_iMapMinY As Integer : m_iMapMinY = 0
Dim Shared m_iMapMaxY As Integer : m_iMapMaxY = 32
Dim Shared m_iMapMidY As Integer : m_iMapMidY = (m_iMapMaxY-m_iMapMinY)\2
Dim Shared m_iMapMinZ As Integer : m_iMapMinZ = 0
Dim Shared m_iMapMaxZ As Integer : m_iMapMaxZ = 32
Dim Shared m_iMapMidZ As Integer : m_iMapMidZ = (m_iMapMaxZ-m_iMapMinZ)\2
Dim Shared m_iGridSizeMin As Integer : m_iGridSizeMin = 1
Dim Shared m_iGridSizeMax As Integer : m_iGridSizeMax = 128
 
' =============================================================================
' LOCAL VARIABLES
Dim in$
 
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
$Console
_Delay 4
_Console On
_Echo "Started " + m_ProgramName$
_Echo "Debugging on..."
' ****************************************************************************************************************************************************************
 
' =============================================================================
' 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
_Console Off
' ****************************************************************************************************************************************************************
 
End
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub main
        Dim RoutineName as String : RoutineName = "main"
    Dim in$
        Dim result$
        
    Screen 0
 
    Do
        Cls
        Print m_ProgramName$
        Print
        Print "Isomatric Mapping Demo Re-visited"
        Print "v2.69, by Softintheheadware (Dec, 2021)"
        Print
        'PRINT "CONTROLS: PRESS <ESC> TO RETURN TO MENU"
        'PRINT "PLAYER  LEFT       RIGHT       UP        DOWN       "
        'PRINT "1       CRSR LEFT  CRSR RIGHT  CRSR UP   CRSR DOWN  "
        'PRINT "2       KEYPAD 4   KEYPAD 6    KEYPAD 8  KEYPAD 2   "
        'PRINT "3       A          S           W         Z          "
        'PRINT "4       J          K           I         M          "
        'PRINT
 
        Print "1. IsometricDemo1"
        Print "2. IsometricDemo2"
        Print "3. Move around in 2.5D"
        Print
        Print "What to do? ('q' to exit)"
 
        Input in$: in$ = LCase$(Left$(in$, 1))
 
        If in$ = "1" Then
            result$ = IsometricDemo1
        ElseIf in$ = "2" Then
            result$ = IsometricDemo2
        ElseIf in$ = "3" Then
            result$ = IsometricDemo3
        End If
                
                If LEN(result$) > 0 Then
                        PRINT result$
                End If
                
    Loop Until in$ = "q"
End Sub ' main
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IsometricDemo1$
    Dim RoutineName As String: RoutineName = "IsometricDemo1"
        Dim sResult AS String : sResult = ""
    Dim arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType
    Dim iX%
    Dim iY%
    Dim iZ%
    Dim iNextX%
    Dim iNextY%
    Dim iNextZ%
    Dim iPosX1%
    Dim iPosX2%
    Dim iPosY1%
    Dim iPosY2%
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
    Dim iNextColor&
        Dim iColorScheme%
    Dim bContinue As Integer
    Dim iDirection%
    Dim bFinished As Integer
    Dim iCount%
    Dim iOpen%
    Dim iMove%
        Dim iSegmentLength%
        Dim iMaxLength%
    Dim bFirst As Integer
    Dim bQuit As Integer
    Dim in$
        
    ' INITIALIZE
    'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
        Screen _NewImage(1280, 1024, 32)
        
    ' =============================================================================
    ' MAIN LOOP
    bQuit = FALSE
    Do
        Cls
 
        ' -----------------------------------------------------------------------------
        ' INITIALIZE MAP TO EMPTY
        ClearIsometricMap arrMap()
                
        ' -----------------------------------------------------------------------------
        ' DRAW FLOOR
        iZ% = 0
        For iLoopX% = 0 To 32
            For iLoopY% = 0 To 32
                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Floor_Tiled
                                arrMap(iLoopX%, iLoopY%, iZ%).Color1 = cGray&
                                arrMap(iLoopX%, iLoopY%, iZ%).Color2 = cLightGray&
            Next iLoopY%
        Next iLoopX%
                
        ' -----------------------------------------------------------------------------
        ' DRAW BLOCKS TO CHECK ORIENTATION
                
                FOR iLoopZ% = m_iMapMinZ + 1 TO m_iMapMaxZ
                        arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
                        
                        arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
                        
                        arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
                        
                        'arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
                        'arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
                        
                        'arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
                        'arrMap(m_iMapMinX, m_iMapMidY, iLoopZ%).Color1 = cOrange&
                        '
                        'arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Typ = c_iMapType_Wall
                        'arrMap(m_iMapMaxX, m_iMapMidY, iLoopZ%).Color1 = cPurple&
                        '
                        'arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
                        'arrMap(m_iMapMidX, m_iMapMinY, iLoopZ%).Color1 = cLime&
                        '
                        'arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
                        'arrMap(m_iMapMidX, m_iMapMaxY, iLoopZ%).Color1 = cCyan&
                NEXT iLoopZ%
                
        ' -----------------------------------------------------------------------------
        ' DRAW SOME OBJECTS
        If TRUE = TRUE Then
            iX% = 16
            iY% = 3
                        
            iNextColor& = cRed&
            iLoopZ% = 1
            iLoopY% = iY%
            For iLoopX% = iX% To (iX% + 10)
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
            Next iLoopX%
                        
            iNextColor& = cBlue&
            iLoopZ% = 1
            iLoopY% = iY% + 8
            For iLoopX% = iX% To (iX% + 10)
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
            Next iLoopX%
                        
            iNextColor& = cGreen&
            iLoopZ% = 1
            iLoopX% = iX% + 1
            For iLoopY% = (iY% + 1) To (iY% + 7)
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
            Next iLoopY%
                        
            iNextColor& = cYellow&
            iLoopZ% = 1
            iLoopX% = iX% + 9
            For iLoopY% = (iY% + 1) To (iY% + 7)
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall
                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = iNextColor&
            Next iLoopY%
        End If
                
        ' -----------------------------------------------------------------------------
        ' DRAW A PYRAMID
        If TRUE = TRUE Then
            iX% = 2
            iY% = 18
            iZ% = 1
            iPosX1% = iX%
            iPosX2% = iX% + 10
            iPosY1% = iY%
            iPosY2% = iY% + 10
                        iNextColor& = cRed&
                        iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
                        
            bContinue = TRUE
            Do
                ' PLOT NEXT LEVEL
                For iLoopX% = iPosX1% To iPosX2%
                    For iLoopY% = iPosY1% To iPosY2%
                                                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                        arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                    Next iLoopY%
                Next iLoopX%
                                
                ' MOVE UP A LEVEL
                iPosX1% = iPosX1% + 1
                iPosX2% = iPosX2% - 1
                iPosY1% = iPosY1% + 1
                iPosY2% = iPosY2% - 1
                                DoCycleColor iColorScheme%, iNextColor&
                                
                ' QUIT AFTER WE REACH THE TOP
                If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
                    iZ% = iZ% + 1
                Else
                    bContinue = FALSE
                End If
                                
            Loop Until bContinue = FALSE
        End If
 
        ' -----------------------------------------------------------------------------
        ' DRAW PIPES
        If TRUE = TRUE Then
                        ' START POSITION
            iX% = m_iMapMaxX ' 30 ' RandomNumber(0, 32)
            iY% = m_iMapMaxY ' 28 ' RandomNumber(0, 32)
            iZ% = 1 ' 32
                        
                        ' LENGTH OF PIPES
                        iSegmentLength% = 4
                        iMaxLength% = 64
                        
                        ' START COLOR + DEFINE HOW COLOR CHANGES
                        iNextColor& = cRed&
                        iColorScheme% = 2 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
                        
                        ' INITIALIZE
            bFirst = TRUE
            iCount% = 0
            iMove% = 0
            bFinished = FALSE
            Do
                iNextX% = iX%
                iNextY% = iY%
                iNextZ% = iZ%
                                
                                ' CHANGE DIRECTION EVERY iSegmentLength% SPACES
                iMove% = iMove% + 1
                If iMove% > iSegmentLength% Then
                    iMove% = 0
                                        
                                        ' PICK A DIRECTION
                    If bFirst = TRUE Then
                                                ' MOVE UP FOR FIRST MOVE
                        iDirection% = c_iDir_Up
                        bFirst = FALSE
                    Else
                                                ' PICK A RANDOM DIRECTION
                        iDirection% = RandomNumber(c_iDir_Min, c_iDir_Max)
                    End If
                End If
                                
                Select Case iDirection%
                    Case c_iDir_Down:
                        If iNextZ% > 0 Then
                            iNextZ% = iNextZ% - 1
                        End If
                    Case c_iDir_Up:
                        If iNextZ% < 32 Then
                            iNextZ% = iNextZ% + 1
                        End If
                    Case c_iDir_Left:
                        If iNextX% > 0 Then
                            iNextX% = iNextX% - 1
                        End If
                    Case c_iDir_Right:
                        If iNextX% < 32 Then
                            iNextX% = iNextX% + 1
                        End If
                    Case c_iDir_Back:
                        If iNextY% > 0 Then
                            iNextY% = iNextY% - 1
                        End If
                    Case Else: ' c_iDir_Forward
                        If iNextY% < 32 Then
                            iNextY% = iNextY% + 1
                        End If
                End Select
                                
                                ' CHECK IF NEXT SPACE IS EMPTY
                If arrMap(iNextX%, iNextY%, iNextZ%).Typ = c_iMapType_Empty Then
                                        ' SPACE IS EMPTY
                                        ' DRAW HERE
                                        
                    iCount% = iCount% + 1
                    iX% = iNextX%
                    iY% = iNextY%
                    iZ% = iNextZ%
                                        
                                        ' GET NEXT COLOR AND DRAW BLOCK
                                        DoCycleColor iColorScheme%, iNextColor&
                                        arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
                                        arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
                                        
                    ' HAVE WE PLACED MAX # OF BLOCKS?
                    If iCount% > iMaxLength% Then
                        bFinished = TRUE
                    End If
                Else                                    
                                        ' SPACE IS OCCUPIED
                    ' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
                    iOpen% = 0
                    If iZ% > 0 Then
                        If arrMap(iX%, iY%, iZ% - 1).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iZ% < 32 Then
                        If arrMap(iX%, iY%, iZ% + 1).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iX% > 0 Then
                        If arrMap(iX% - 1, iY%, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iX% < 32 Then
                        If arrMap(iX% + 1, iY%, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iY% > 0 Then
                        If arrMap(iX%, iY% - 1, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iY% < 32 Then
                        If arrMap(iX%, iY% + 1, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                                        
                    ' QUIT IF NO OPEN SPACES AVAILABLE
                    If iOpen% = 0 Then
                        ' NOWHERE TO GO, EXIT
                        bFinished = TRUE
                    End If
                End If
                                
            Loop Until bFinished = TRUE
        End If
 
        ' PLOT GRAPHICS TO SCREEN
        DrawIsometricScreen arrMap()
                
        Input "Type q to quit? ", in$
                
        If LCase$(in$) = LCase$("q") Then
            bQuit = TRUE
        End If
                
    Loop Until bQuit = TRUE
        
    Screen 0
        
        IsometricDemo1 = sResult
End Sub ' IsometricDemo1
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IsometricDemo2$
    Dim RoutineName As String: RoutineName = "IsometricDemo2"
        Dim sResult AS String : sResult = ""
    Dim arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType
    Dim iX%
    Dim iY%
    Dim iZ%
    Dim iNextX%
    Dim iNextY%
    Dim iNextZ%
    Dim iPosX1%
    Dim iPosX2%
    Dim iPosY1%
    Dim iPosY2%
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
    Dim iNextColor&
        Dim iColorScheme%
    Dim bContinue As Integer
    Dim iDirection%
    Dim bFinished As Integer
    Dim iCount%
    Dim iOpen%
    Dim iMove%
        Dim iSegmentLength%
        Dim iMaxLength%
    Dim bFirst As Integer
    Dim bQuit As Integer
    Dim in$
        
    ' INITIALIZE
    'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
        Screen _NewImage(1280, 1024, 32)
        
    ' =============================================================================
    ' MAIN LOOP
    bQuit = FALSE
    Do
        Cls
 
        ' -----------------------------------------------------------------------------
        ' INITIALIZE MAP TO EMPTY
        ClearIsometricMap arrMap()
                
        ' -----------------------------------------------------------------------------
        ' DRAW FLOOR
        'For iLoopZ% = m_iMapMinZ To m_iMapMaxZ Step 8
                For iLoopZ% = m_iMapMinZ To m_iMapMinZ
                        For iLoopX% = m_iMapMinX To m_iMapMaxX
                                For iLoopY% = m_iMapMinY To m_iMapMaxY
                                        arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
                                        arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
                                        arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
                                Next iLoopY%
                        Next iLoopX%
                Next iLoopZ%
                
        ' -----------------------------------------------------------------------------
        ' DRAW FRAME AROUND ENTIRE SPACE
                
                FOR iLoopZ% = m_iMapMinZ+1 TO m_iMapMaxZ
                        arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, m_iMapMinY, iLoopZ%).Color1 = cRed&
                        
                        arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMaxX, m_iMapMinY, iLoopZ%).Color1 = cBlue&
                        
                        arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, m_iMapMaxY, iLoopZ%).Color1 = cGreen&
                        
                        arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Typ = c_iMapType_Wall
                        arrMap(m_iMapMaxX, m_iMapMaxY, iLoopZ%).Color1 = cYellow&
                NEXT iLoopZ%
                
                FOR iLoopX% = m_iMapMinX TO m_iMapMaxX
                        arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Typ = c_iMapType_Wall
                        arrMap(iLoopX%, m_iMapMinY, m_iMapMinZ+1).Color1 = cOrange&
                        
                        arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Typ = c_iMapType_Wall
                        arrMap(iLoopX%, m_iMapMaxY, m_iMapMaxZ).Color1 = cPurple&
                        
                        arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Typ = c_iMapType_Wall
                        arrMap(iLoopX%, m_iMapMaxY, m_iMapMinZ+1).Color1 = cLime&
                        
                        arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Typ = c_iMapType_Wall
                        arrMap(iLoopX%, m_iMapMinY, m_iMapMaxZ).Color1 = cCyan&
                NEXT iLoopX%
                
                FOR iLoopY% = m_iMapMinY TO m_iMapMaxY
                        arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, iLoopY%, m_iMapMinZ+1).Color1 = cDodgerBlue&
                        
                        arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
                        arrMap(m_iMapMinX, iLoopY%, m_iMapMaxZ).Color1 = cDeepPurple&
                        
                        arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
                        arrMap(m_iMapMaxX, iLoopY%, m_iMapMinZ+1).Color1 = cDarkRed&
                        
                        arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
                        arrMap(m_iMapMaxX, iLoopY%, m_iMapMaxZ).Color1 = cGold&
                NEXT iLoopY%
                
        ' -----------------------------------------------------------------------------
        ' DRAW PIPES
        If TRUE = TRUE Then
                        ' START POSITION
            iX% = m_iMapMidX ' 30 ' RandomNumber(0, 32)
            iY% = m_iMapMidY ' 28 ' RandomNumber(0, 32)
            iZ% = m_iMapMidZ ' 1 ' 32
                        
                        ' LENGTH OF PIPES
                        iSegmentLength% = 8
                        iMaxLength% = 512
                        
                        ' START COLOR + DEFINE HOW COLOR CHANGES
                        iNextColor& = cRed&
                        iColorScheme% = 3 ' 0 = don't change, 2 = Rainbow18 #1, 10 = Rainbow18 #2, etc.
                        
                        ' INITIALIZE
            bFirst = TRUE
            iCount% = 0
            iMove% = 0
            bFinished = FALSE
            Do
                iNextX% = iX%
                iNextY% = iY%
                iNextZ% = iZ%
                                
                                ' CHANGE DIRECTION EVERY iSegmentLength% SPACES
                iMove% = iMove% + 1
                If iMove% > iSegmentLength% Then
                    iMove% = 0
                                        
                                        ' PICK A DIRECTION
                    If bFirst = TRUE Then
                                                ' MOVE UP FOR FIRST MOVE
                        iDirection% = c_iDir_Up
                        bFirst = FALSE
                    Else
                                                ' PICK A RANDOM DIRECTION
                        iDirection% = RandomNumber(c_iDir_Min, c_iDir_Max)
                    End If
                End If
                                
                Select Case iDirection%
                    Case c_iDir_Down:
                        If iNextZ% > 0 Then
                            iNextZ% = iNextZ% - 1
                        End If
                    Case c_iDir_Up:
                        If iNextZ% < 32 Then
                            iNextZ% = iNextZ% + 1
                        End If
                    Case c_iDir_Left:
                        If iNextX% > 0 Then
                            iNextX% = iNextX% - 1
                        End If
                    Case c_iDir_Right:
                        If iNextX% < 32 Then
                            iNextX% = iNextX% + 1
                        End If
                    Case c_iDir_Back:
                        If iNextY% > 0 Then
                            iNextY% = iNextY% - 1
                        End If
                    Case Else: ' c_iDir_Forward
                        If iNextY% < 32 Then
                            iNextY% = iNextY% + 1
                        End If
                End Select
                                
                                ' CHECK IF NEXT SPACE IS EMPTY
                If arrMap(iNextX%, iNextY%, iNextZ%).Typ = c_iMapType_Empty Then
                                        ' SPACE IS EMPTY
                                        ' DRAW HERE
                                        
                    iCount% = iCount% + 1
                    iX% = iNextX%
                    iY% = iNextY%
                    iZ% = iNextZ%
                                        
                                        ' GET NEXT COLOR AND DRAW BLOCK
                                        DoCycleColor iColorScheme%, iNextColor&
                                        arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Wall
                                        arrMap(iX%, iY%, iZ%).Color1 = iNextColor&
                                        
                    ' HAVE WE PLACED MAX # OF BLOCKS?
                    If iCount% > iMaxLength% Then
                        bFinished = TRUE
                    End If
                Else                                    
                                        ' SPACE IS OCCUPIED
                    ' SEE IF WE HAVE ANY OPEN SPACES TO MOVE TO
                    iOpen% = 0
                    If iZ% > 0 Then
                        If arrMap(iX%, iY%, iZ% - 1).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iZ% < 32 Then
                        If arrMap(iX%, iY%, iZ% + 1).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iX% > 0 Then
                        If arrMap(iX% - 1, iY%, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iX% < 32 Then
                        If arrMap(iX% + 1, iY%, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iY% > 0 Then
                        If arrMap(iX%, iY% - 1, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                    If iY% < 32 Then
                        If arrMap(iX%, iY% + 1, iZ%).Typ = c_iMapType_Empty Then
                            iOpen% = iOpen% + 1
                        End If
                    End If
                                        
                    ' QUIT IF NO OPEN SPACES AVAILABLE
                    If iOpen% = 0 Then
                        ' NOWHERE TO GO, EXIT
                        bFinished = TRUE
                    End If
                End If
                                
            Loop Until bFinished = TRUE
        End If
 
        ' PLOT GRAPHICS TO SCREEN
        DrawIsometricScreen arrMap()
                
        Input "Type q to quit? ", in$
                
        If LCase$(in$) = LCase$("q") Then
            bQuit = TRUE
        End If
                
    Loop Until bQuit = TRUE
        
    Screen 0
        
        IsometricDemo2 = sResult
End Sub ' IsometricDemo2
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IsometricDemo3$
    Dim RoutineName As String: RoutineName = "IsometricDemo3"
        Dim sResult AS String : sResult = ""
    Dim arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType
    Dim iX%
    Dim iY%
    Dim iZ%
        Dim iNewX%
        Dim iNewY%
        Dim iNewZ%
    Dim iMyColor&
        Dim iColorScheme%
    Dim iDirection% ' direction player's nose is pointing
        Dim bFound As Integer
        DIM bDone As Integer
    Dim in$
        Dim iTotal% ' compute total available spaces
        Dim iCount% ' count # of spaces searched
        Dim bMoving As Integer
        Dim iLastKey As Integer
        Dim bMoved As Integer
        
    Dim iPosX1%
    Dim iPosX2%
    Dim iPosY1%
    Dim iPosY2%
        Dim iNextColor&
        Dim bContinue As Integer
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
        Dim iLevelCount%
        Dim iLevelSize%
        
        Dim iDrawX%
        Dim iDrawY%
        
        ' =============================================================================
    ' INITIALIZE
    'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
        Screen _NewImage(1280, 1024, 32)
        
        ' -----------------------------------------------------------------------------
        ' INITIALIZE MAP TO EMPTY
        ClearIsometricMap arrMap()
        
        ' -----------------------------------------------------------------------------
        ' DRAW FLOOR
        For iLoopZ% = m_iMapMinZ To m_iMapMinZ
                For iLoopX% = m_iMapMinX To m_iMapMaxX
                        For iLoopY% = m_iMapMinY To m_iMapMaxY
                                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled
                                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cGray&
                                arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2 = cLightGray&
                        Next iLoopY%
                Next iLoopX%
        Next iLoopZ%
 
        ' -----------------------------------------------------------------------------
        ' DRAW A TALL HOLLOW PYRAMID
        If TRUE = TRUE Then
                iX% = 5
                iY% = 10
                iZ% = 1
                iLevelSize% = 4
                
                iPosX1% = iX%
                iPosX2% = iX% + 7
                iPosY1% = iY%
                iPosY2% = iY% + 7
                iNextColor& = cRed&
                iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
                iLevelCount% = 0
                
                bContinue = TRUE
                Do
                        ' PLOT NEXT LEVEL
                        'For iLoopX% = iPosX1% To iPosX2%
                        '       For iLoopY% = iPosY1% To iPosY2%
                        '               arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                        '               arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                        '       Next iLoopY%
                        'Next iLoopX%
                        
                        ' Draw front/back walls
                        For iLoopX% = iPosX1% To iPosX2%
                                iLoopY% = iPosY1%
                                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                                arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                                arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
                                
                                iLoopY% = iPosY2%
                                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                                arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                                arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
                        Next iLoopX%
                        
                        ' Draw left/right walls
                        For iLoopY% = iPosY1% To iPosY2%
                                iLoopX% = iPosX1%
                                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                                arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                                arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
                                
                                iLoopX% = iPosX2%
                                arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall
                                arrMap(iLoopX%, iLoopY%, iZ%).Color1 = iNextColor&
                                arrMap(iLoopX%, iLoopY%, iZ%).AlphaOverride = 255
                        Next iLoopY%
                        
                        ' Add a door to middle of right wall
                        iX% = iPosX1% + ( (iPosX2% - iPosX1%) \ 2)
                        arrMap(iX%, iPosY2%, iZ%).Typ = c_iMapType_Empty
                        
                        ' Add a door to middle of front wall
                        iY% = iPosY1% + ( (iPosY2% - iPosY1%) \ 2)
                        arrMap(iPosX2%, iY%, iZ%).Typ = c_iMapType_Empty
                        
                        ' MOVE UP A LEVEL
                        iLevelCount% = iLevelCount% + 1
                        IF iLevelCount% > iLevelSize% THEN
                                iLevelCount% = 0
                                iPosX1% = iPosX1% + 1
                                iPosX2% = iPosX2% - 1
                                iPosY1% = iPosY1% + 1
                                iPosY2% = iPosY2% - 1
                        END IF
                        
                        ' QUIT AFTER WE REACH THE TOP
                        If (iPosX1% <= iPosX2%) And (iPosY1% <= iPosY2%) Then
                                iZ% = iZ% + 1
                                DoCycleColor iColorScheme%, iNextColor&
                                If iZ% > m_iMapMaxZ Then
                                        bContinue = FALSE
                                End If
                        Else
                                bContinue = FALSE
                        End If
                        
                Loop Until bContinue = FALSE
        End If  
        
        ' -----------------------------------------------------------------------------
        ' DRAW FRAME AROUND ENTIRE SPACE (TOP)
        
        FOR iLoopX% = m_iMapMinX+3 TO m_iMapMaxX-3
                arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMaxY-3, m_iMapMaxZ).Color1 = cPurple&
                
                arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMinY+3, m_iMapMaxZ).Color1 = cCyan&
        NEXT iLoopX%
        
        FOR iLoopY% = m_iMapMinY+3 TO m_iMapMaxY-3
                arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
                arrMap(m_iMapMinX+3, iLoopY%, m_iMapMaxZ).Color1 = cOrange&
                
                arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Typ = c_iMapType_Wall
                arrMap(m_iMapMaxX-3, iLoopY%, m_iMapMaxZ).Color1 = cLime&
        NEXT iLoopY%
        
        ' -----------------------------------------------------------------------------
        ' DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
        
        FOR iLoopX% = m_iMapMinX+2 TO m_iMapMaxX-2
                arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMaxY-2, m_iMapMidZ).Color1 = cDodgerBlue&
                
                arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMinY+2, m_iMapMidZ).Color1 = cDeepPurple&
        NEXT iLoopX%
        
        FOR iLoopY% = m_iMapMinY+2 TO m_iMapMaxY-2
                arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
                arrMap(m_iMapMinX+2, iLoopY%, m_iMapMidZ).Color1 = cDarkRed&
                
                arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Typ = c_iMapType_Wall
                arrMap(m_iMapMaxX-2, iLoopY%, m_iMapMidZ).Color1 = cGold&
        NEXT iLoopY%
        
        ' -----------------------------------------------------------------------------
        ' DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
        
        FOR iLoopX% = m_iMapMinX+1 TO m_iMapMaxX-1
                arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMaxY-1, m_iMapMinZ+1).Color1 = cSeaBlue&
                
                arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Typ = c_iMapType_Wall
                arrMap(iLoopX%, m_iMapMinY+1, m_iMapMinZ+1).Color1 = cChartreuse&
        NEXT iLoopX%
        
        FOR iLoopY% = m_iMapMinY+1 TO m_iMapMaxY-1
                arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
                arrMap(m_iMapMinX+1, iLoopY%, m_iMapMinZ+1).Color1 = cOrangeRed&
                
                arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Typ = c_iMapType_Wall
                arrMap(m_iMapMaxX-1, iLoopY%, m_iMapMinZ+1).Color1 = cDeepSkyBlue&
        NEXT iLoopY%
        
        ' -----------------------------------------------------------------------------
        ' 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 arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty THEN
                bFound = TRUE
        ELSE
                ' 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
                Do
                        iX% = iX% + 1
                        if iX% > m_iMapMaxX then
                                ' reset x and move to next y
                                iX% = m_iMapMinX
                                iY% = iY% + 1
                                if iY% > m_iMapMaxY then
                                        ' reset y and move to next z
                                        iY% = m_iMapMinY
                                        iZ% = iZ% + 1
                                        if iZ% > m_iMapMaxZ then
                                                ' RESET Z AND SEE IF WE HAVE CHECKED EVERYTHING
                                                iZ% = m_iMapMinZ
                                                iCount% = iCount% + 1
                                                if iCount% >= iTotal% then
                                                        ' NONE FOUND, EXIT
                                                        Exit Do
                                                end if
                                        else
                                                iCount% = iCount% + 1
                                        end if
                                else
                                        iCount% = iCount% + 1
                                end if
                        else
                                iCount% = iCount% + 1
                        end if
                        IF arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty THEN
                                ' FOUND AN EMPTY SPACE, EXIT
                                bFound = TRUE
                                Exit Do
                        END IF
                Loop
        END IF
        
        IF bFound = TRUE THEN
                ' PLACE PLAYER
                iMyColor& = cRed&
                iColorScheme% = 2
                
                ' PICK A DIRECTION (SIMPLE FOR NOW, LEFT OR RIGHT)
                if iX% <= m_iMapMidX then
                        iDirection% = c_iDir_Right
                else
                        iDirection% = c_iDir_Left
                end if
                
                ' RESET MOVEMENT VARIABLES
                bMoving = FALSE
                bMoved = FALSE
                
                ' RESET INPUT
                WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
                iLastKey = c_iKeyDown_Enter
                
                ' DRAW PLAYER
                arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Player1 ' c_iMapType_Wall
                arrMap(iX%, iY%, iZ%).Color1 = iMyColor&
                arrMap(iX%, iY%, iZ%).AlphaOverride = 255
                
                ' =============================================================================
                ' MAIN LOOP
                bFinished = FALSE
                Do
                        ' PLOT GRAPHICS TO SCREEN
                        CLS ' is cls necessary?
                        ComputeVisible arrMap(), iX%, iY%, iZ%
                        DrawIsometricScreen arrMap()
                        
                        ' SHOW INSTRUCTIONS / COORDINATES ON SCREEN
                        LOCATE 1, 1: PRINT "IsometricDemo3"
                        LOCATE 3, 1: PRINT "CRSR RIGHT/LEFT   MOVES X=" + CSTR$(iX%)
                        LOCATE 4, 1: PRINT "CRSR UP   /DOWN   MOVES Y=" + CSTR$(iY%)
                        LOCATE 5, 1: PRINT "PAGE UP   /DOWN   MOVES Z=" + CSTR$(iZ%)
                        LOCATE 6, 1: PRINT "+ / -   CHANGES GRID SIZE=" + CSTR$(m_iGridSize)
                        LOCATE 7, 1: PRINT "SPACE TOGGLES CONTINUOUS MOVEMENT = " + IIFSTR$(bMoving, "TRUE", "FALSE")
                        LOCATE 9, 1: PRINT "PRESS <ESC> TO QUIT"
                        
                        ' SHOW 2D MINI MAP ON SCREEN
                        FOR iLoopX% = m_iMapMinX TO m_iMapMaxX
                                FOR iLoopY% = m_iMapMinY TO m_iMapMaxY
                                        iDrawX% = (iLoopX% * 4) + 20
                                        iDrawY% = (iLoopY% * 4) + 200
                                        IF arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Wall THEN
                                                DrawBox iDrawX%, iDrawY%, 4, arrMap(iLoopX%, iLoopY%, iZ%).Color1
                                                
                                        ELSEIF arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iMapType_Player1 THEN
                                                DrawBox iDrawX%, iDrawY%, 4, arrMap(iLoopX%, iLoopY%, iZ%).Color1
                                                
                                        ELSE
                                                DrawBox iDrawX%, iDrawY%, 4, cBlack&
                                        END IF
                                NEXT iLoopY%
                        NEXT iLoopX%
                        
                        ' GET KEYBOARD INPUT
                        If _KeyDown(c_iKeyDown_Up) Then
                                If iLastKey <> c_iKeyDown_Up Then
                                        iLastKey = c_iKeyDown_Up
                                        iDirection% = c_iDir_Back
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Down) Then
                                If iLastKey <> c_iKeyDown_Down Then
                                        iLastKey = c_iKeyDown_Down
                                        iDirection% = c_iDir_Forward
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Left) Then
                                If iLastKey <> c_iKeyDown_Left Then
                                        iLastKey = c_iKeyDown_Left
                                        iDirection% = c_iDir_Left
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Right) Then
                                If iLastKey <> c_iKeyDown_Right Then
                                        iLastKey = c_iKeyDown_Right
                                        iDirection% = c_iDir_Right
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_PgUp) Then
                                If iLastKey <> c_iKeyDown_PgUp Then
                                        iLastKey = c_iKeyDown_PgUp
                                        iDirection% = c_iDir_Up
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_PgDn) Then
                                If iLastKey <> c_iKeyDown_PgDn Then
                                        iLastKey = c_iKeyDown_PgDn
                                        iDirection% = c_iDir_Down
                                        bMoved = TRUE
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Spacebar) Then
                                If iLastKey <> c_iKeyDown_Spacebar Then
                                        iLastKey = c_iKeyDown_Spacebar
                                        'bMoving = IIF(bMoving, False, True)
                                        IF bMoving = TRUE THEN
                                                bMoving = FALSE
                                        ELSE
                                                bMoving = TRUE
                                        END IF
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Minus) Then
                                If iLastKey <> c_iKeyDown_Minus Then
                                        iLastKey = c_iKeyDown_Minus
                                        m_iGridSize = m_iGridSize - 1
                                        IF m_iGridSize < m_iGridSizeMin THEN
                                                m_iGridSize = m_iGridSizeMin
                                        ELSE
                                                bMoved = TRUE
                                        END IF
                                End If
                        ElseIf _KeyDown(c_iKeyDown_EqualPlus) Then
                                If iLastKey <> c_iKeyDown_EqualPlus Then
                                        iLastKey = c_iKeyDown_EqualPlus
                                        m_iGridSize = m_iGridSize + 1
                                        IF m_iGridSize > m_iGridSizeMax THEN
                                                m_iGridSize = m_iGridSizeMax
                                        ELSE
                                                bMoved = TRUE
                                        END IF
                                End If
                        ElseIf _KeyDown(c_iKeyDown_Esc) Then
                                Exit Do
                        Else
                                iLastKey = -1
                        End If
                        
                        ' --------------------------------------------------------------------------------
                        ' ERASE OLD POSITION
                        ' --------------------------------------------------------------------------------
                        arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Empty
                        arrMap(iX%, iY%, iZ%).Color1 = cEmpty&
                        arrMap(iX%, iY%, iZ%).AlphaOverride = 255
                        
                        ' --------------------------------------------------------------------------------
                        ' MOVE PLAYER BASED ON DIRECTION
                        ' --------------------------------------------------------------------------------
                        'IF bMoved=TRUE THEN
                        IF bMoving=TRUE OR bMoved=TRUE THEN
                                bMoved = FALSE
                                
                                SELECT CASE iDirection%
                                        CASE c_iDir_Down:
                                                iNewX% = iX%
                                                iNewY% = iY%
                                                iNewZ% = iZ% - 1
                                                If iNewZ% < m_iMapMinZ Then
                                                        iNewZ% = m_iMapMaxZ
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Up
                                                        iNewZ% = iZ%
                                                End If
                                                
                                        CASE c_iDir_Up:
                                                iNewX% = iX%
                                                iNewY% = iY%
                                                iNewZ% = iZ% + 1
                                                If iNewZ% > m_iMapMaxZ Then
                                                        iNewZ% = m_iMapMinZ
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Down
                                                        iNewZ% = iZ%
                                                End If
                                                
                                        CASE c_iDir_Left:
                                                iNewX% = iX% - 1
                                                iNewY% = iY%
                                                iNewZ% = iZ%
                                                If iNewX% < m_iMapMinX Then
                                                        iNewX% = m_iMapMaxX
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Right
                                                        iNewX% = iX%
                                                End If
                                                
                                        CASE c_iDir_Right:
                                                iNewX% = iX% + 1
                                                iNewY% = iY%
                                                iNewZ% = iZ%
                                                If iNewX% > m_iMapMaxX Then
                                                        iNewX% = m_iMapMinX
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Left
                                                        iNewX% = iX%
                                                End If
                                                
                                        CASE c_iDir_Back:
                                                iNewX% = iX%
                                                iNewY% = iY% - 1
                                                iNewZ% = iZ%
                                                If iNewY% < m_iMapMinY Then
                                                        iNewY% = m_iMapMaxY
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Forward
                                                        iNewY% = iY%
                                                End If
                                                
                                        CASE c_iDir_Forward:
                                                iNewX% = iX%
                                                iNewY% = iY% + 1
                                                iNewZ% = iZ%
                                                If iNewY% > m_iMapMaxY Then
                                                        iNewY% = m_iMapMinY
                                                End If
                                                If arrMap(iNewX%, iNewY%, iNewZ%).Typ <> c_iMapType_Empty Then
                                                        iDirection% = c_iDir_Back
                                                        iNewY% = iY%
                                                End If
                                                
                                        CASE ELSE:
                                                'iNewX% = iX%
                                                'iNewY% = iY%
                                                'iNewZ% = iZ%
                                END SELECT
                                
                                ' SAVE NEW POSITION
                                iX% = iNewX%
                                iY% = iNewY%
                                iZ% = iNewZ%
                        END IF
                        
                        ' REDRAW AT CURRENT POSITION
                        DoCycleColor iColorScheme%, iMyColor&
                        arrMap(iX%, iY%, iZ%).Typ = c_iMapType_Player1 ' c_iMapType_Wall
                        arrMap(iX%, iY%, iZ%).Color1 = iMyColor&
                        arrMap(iX%, iY%, iZ%).AlphaOverride = 255
                        
                _Limit 30
                _Display
                
                Loop
        ELSE
                sResult = "Could not find an empty space to start player."
        END IF
        
        ' FINISH UP AND EXIT
    WHILE _DEVICEINPUT(1): WEND ' clear and update the keyboard buffer
        SCREEN 0
        IsometricDemo3$ = sResult
End Sub ' IsometricDemo3
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' =============================================================================
' LET'S GET THE COORDINATES STRAIGHT!
' Coordinates are 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
 
'ClearIsometricMap arrMap()
Sub ClearIsometricMap (arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType)
    Dim RoutineName As String: RoutineName = "ClearIsometricMap"
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
        
        For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
                For iLoopX% = m_iMapMinX To m_iMapMaxX
                        For iLoopY% = m_iMapMinY To m_iMapMaxY
                                arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Empty
                                arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
                        Next iLoopY%
                Next iLoopX%
        Next iLoopZ%
End Sub ' ClearIsometricMap
 
 
' /////////////////////////////////////////////////////////////////////////////
' Determine which squares are visible in isometric map
 
' arrMap(x,y,z) = 3D array map of world
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
 
Sub ComputeVisible (arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType, iX%, iY%, iZ%)
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
        
        Dim iPX1%
        Dim iPY1%
        Dim iPZ1%
        Dim iPlayer2Dx As Integer
        Dim iPlayer2Dy As Integer
        Dim iBrick2Dx As Integer
        Dim iBrick2Dy As Integer
        
        ' CALCULATE PLAYER'S 2-D POSITION
        iPX1% = iX% * m_iGridSize + cGridOffsetX
        iPY1% = iY% * m_iGridSize + cGridOffsetY
        iPZ1% = iZ% * m_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&)  
        
        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 brick
                                ' and its 2D (X,Y) is > Player's 2D (X,Y)
                                ' then make the brick transparent
                                If arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall Then
                                        ' CALCULATE BRICK'S 2-D POSITION
                                        iPX1% = iLoopX% * m_iGridSize + cGridOffsetX
                                        iPY1% = iLoopY% * m_iGridSize + cGridOffsetY
                                        iPZ1% = iLoopZ% * m_iGridSize + cGridOffsetZ
                                        iBrick2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
                                        iBrick2Dy = (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
                                                        If iLoopY% > iY% Then
                                                                If ( iPlayer2Dy >= (iBrick2Dy - m_iGridSize) ) AND ( iPlayer2Dy <= (iBrick2Dy + m_iGridSize) ) Then
                                                                        If ( iPlayer2Dx >= (iBrick2Dx - m_iGridSize) ) AND ( iPlayer2Dx <= (iBrick2Dx + m_iGridSize) ) Then
                                                                                arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
                                                                        Else
                                                                                arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
                                                                        End If
                                                                Else
                                                                        arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
                                                                End If
                                                        End If
                                                'End If
                                        'End If
                                Else
                                        arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
                                End If
                        Next iLoopZ%
                Next iLoopY%
        Next iLoopX%
End Sub ' ComputeVisible
 
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
 
' Parameters:
' arrMap(x,y,z) = 3D array map of world
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
 
'DrawIsometricScreen arrMap()
Sub DrawIsometricScreen (arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType)
    Dim RoutineName As String: RoutineName = "DrawIsometricScreen"
    Dim bTile As Integer
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
    Dim iColor As _Unsigned Long
    Dim iPosX1%
    Dim iPosX2%
    Dim iPosY1%
    Dim iPosY2%
    Dim iPosZ1%
        Dim alpha&
        
        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% * m_iGridSize + cGridOffsetZ
                                iPosX1% = iLoopX% * m_iGridSize + cGridOffsetX
                                iPosY1% = iLoopY% * m_iGridSize + cGridOffsetY
                                iPosX2% = iPosX1% + m_iGridSize
                                iPosY2% = iPosY1% + m_iGridSize
                                
                                ' DETERMINE COLOR
                                If arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Floor_Tiled Then
                                        If bTile = TRUE Then
                                                iColor = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
                                                bTile = FALSE
                                        Else
                                                iColor = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
                                                bTile = TRUE
                                        End If
                                ElseIf arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Wall Then
                                        iColor = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
                                        alpha& = arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
                                        
                                ElseIf arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player1 Then
                                        iColor = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
                                        alpha& = 255
                                        
                                ElseIf arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Player2 Then
                                        iColor = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
                                        alpha& = 255
                                        
                                ElseIf arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Water Then
                                        'TODO: transparent for water
                                        iColor = cEmpty&
                                        alpha& = 64
                                        
                                ElseIf arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iMapType_Window Then
                                        'TODO: transparent for windows
                                        iColor = cEmpty&
                                        alpha& = 64
                                        
                                Else
                                        iColor = cEmpty&
                                End If
                                
                                ' PLOT NEXT BLOCK
                                If iColor <> cEmpty& Then
                                        '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&
                                End If
                                
                        Next iLoopY%
                Next iLoopX%
        Next iLoopZ%
        
End Sub ' DrawIsometricScreen
 
' /////////////////////////////////////////////////////////////////////////////
' RETURNS MAP AS TEXT
 
'Input "See a text dump (y/n)? ", in$
'If LCase$(in$) = LCase$("y") Then
'    Print MapToText$( arrMap() )
'End If
Function MapToText$ (arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapBlockType)
    Dim RoutineName As String: RoutineName = "MapToText$"
    Dim sResult As String
    Dim iLoopX%
    Dim iLoopY%
    Dim iLoopZ%
    Dim iMinX%
    Dim iMaxX%
    Dim iMinY%
    Dim iMaxY%
    Dim iMinZ%
    Dim iMaxZ%
    Dim sLine As String
    Dim iType%
        Dim iColor1&
        Dim iColor2&
        Dim iColor3&
    Dim in$
 
    sResult = ""
 
    ' FIND USED BOUNDARIES OF MAP
    iMinX% = -1
    iMaxX% = -1
    iMinY% = -1
    iMaxY% = -1
    iMinZ% = -1
    iMaxZ% = -1
    For iLoopZ% = 0 To 32
        For iLoopX% = 0 To 32
            For iLoopY% = 0 To 32
                iType% = arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
                If iType% <> c_iMapType_Empty And iType% <> c_iMapType_Floor_Tiled Then
                    If iMinX% = -1 Then
                        iMinX% = iLoopX%
                    End If
                    If iMinY% = -1 Then
                        iMinY% = iLoopY%
                    End If
                    If iMinZ% = -1 Then
                        iMinZ% = iLoopZ%
                    End If
                    If iLoopX% > iMaxX% Then
                        iMaxX% = iLoopX%
                    End If
                    If iLoopY% > iMaxY% Then
                        iMaxY% = iLoopY%
                    End If
                    If iLoopZ% > iMaxZ% Then
                        iMaxZ% = iLoopZ%
                    End If
                End If
            Next iLoopY%
        Next iLoopX%
    Next 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% = arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
                                iColor1& = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
                                iColor2& = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
                                iColor3& = arrMap(iLoopX%, iLoopY%, iLoopZ%).Color3
                                
                If iType% = c_iMapType_Empty Then
                    sLine = sLine + " "
                Else
                    If iColor1& = cEmpty& Then
                        sLine = sLine + " "
                    Else
                        sLine = sLine + "#"
                    End If
                End If
            Next iLoopX%
            sResult = sResult + sLine + Chr$(13)
        Next iLoopY%
 
        sResult = sResult + Chr$(13)
    Next iLoopZ%
 
    MapToText$ = sResult
End Function ' MapToText$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function CX2I (x As Long, y As Long) 'Convert Cartesian X To Isometic coordinates
    CX2I = x - y
End Function ' CX2I
 
' /////////////////////////////////////////////////////////////////////////////
 
Function CY2I (x As Long, y As Long) 'Convert Cartesian Y To Isometic coordinates
    CY2I = (x + y) / 2
End Function ' CY2I
 
' /////////////////////////////////////////////////////////////////////////////
' 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.
 
Sub IsoLine (x, y, x2, y2, xoffset, yoffset, iColor As _Unsigned Long)
    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
End Sub ' IsoLine
 
' /////////////////////////////////////////////////////////////////////////////
' 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 block of height iHeight at Z axis
' MODIFIED by madscijr to accept an alpha& value to control transparency (where 0=fully transparent, 255=opaque)
 
''Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
'Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
    dim r as integer
        dim g as integer
        dim b as integer
        'dim iNewColor As _Unsigned Long
        
        r = _Red32(iColor)
        g = _Green32(iColor)
        b = _Blue32(iColor)
        
    ' 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&)
        
    If z <> 0 Then
        ' 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&)
    Else
        ' no need to draw any height, if there isn't any.
    End If
End Sub ' IsoLine3D
 
' /////////////////////////////////////////////////////////////////////////////
' found at abandoned, outdated and now likely malicious qb64 dot net website
' don’t go there: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Dim a&
 
    D = _Dest
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& ' <<< this is important!
End Sub ' ftri
 
' /////////////////////////////////////////////////////////////////////////////
' 2019-11-20 Steve saves some time with STATIC
' and saves and restores last dest
 
Sub ftri1 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
 
    D = _Dest
    If a& = 0 Then
        a& = _NewImage(1, 1, 32)
    End If
    _Dest a&
    _DontBlend a&
    PSet (0, 0), K
    _Blend a&
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub ' ftri1
 
' /////////////////////////////////////////////////////////////////////////////
' 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
 
Sub fquad1 (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
    ftri1 x1, y1, x2, y2, x4, y4, K
    ftri1 x3, y3, x2, y2, x4, y4, K
End Sub ' fquad1
 
' /////////////////////////////////////////////////////////////////////////////
' 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
 
Sub fquad (x1, y1, x2, y2, x3, y3, x4, y4, K As _Unsigned Long)
    ftri x1, y1, x2, y2, x3, y3, K
    ftri x3, y3, x4, y4, x1, y1, K
End Sub ' fquad
 
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX
 
'SUB DrawBox (iX%, iY%, iSize%, iColor%)
SUB DrawBox (iX%, iY%, iSize%, iColor&)
    LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor&, BF ' Draw a solid box
        'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
    'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
END SUB ' DrawBox
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function cstrs$ (myValue As Single)
    ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstrs$ = _Trim$(Str$(myValue))
End Function ' cstrs$
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIF (Condition, IfTrue, IfFalse)
    If Condition Then IIF = IfTrue Else IIF = IfFalse
End Function
 
' /////////////////////////////////////////////////////////////////////////////
 
Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function
 
' /////////////////////////////////////////////////////////////////////////////
' 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
 
Function GetBinary$ (iInput1 As Integer)
    Dim sResult As String
    Dim iLoop As Integer
    Dim iInput As Integer: iInput = iInput1
 
    sResult = ""
 
    If iInput >= 0 And iInput <= 255 Then
        For iLoop = 1 To 8
            sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
            iInput = iInput \ 2
            'If iLoop = 4 Then sResult = " " + sResult
        Next iLoop
    End If
 
    GetBinary$ = sResult
End Function ' GetBinary$
 
' /////////////////////////////////////////////////////////////////////////////
' 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%
 
Function GetBit256% (iNum1 As Integer, iBit1 As Integer)
    Dim iResult As Integer
    Dim sNum As String
    Dim sBit As String
    Dim iLoop As Integer
    Dim bContinue As Integer
    'DIM iTemp AS INTEGER
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
 
    iResult = FALSE
    bContinue = TRUE
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                'if any of the bits in iBit are false, return false
                If Mid$(sNum, iLoop, 1) = "0" Then
                    iResult = FALSE
                    bContinue = FALSE
                    Exit For
                End If
            End If
        Next iLoop
        If bContinue = TRUE Then
            iResult = TRUE
        End If
    End If
 
    GetBit256% = iResult
End Function ' GetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' 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
 
Function GetIntegerFromBinary% (sBinary1 As String)
    Dim iResult As Integer
    Dim iLoop As Integer
    Dim strBinary As String
    Dim sBinary As String: sBinary = sBinary1
 
    iResult = 0
    strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
    For iLoop = 0 To Len(strBinary) - 1
        iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
    Next iLoop
 
    GetIntegerFromBinary% = iResult
End Function ' GetIntegerFromBinary%
 
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
 
Function IsNum% (text$)
    Dim a$
    Dim b$
    a$ = _Trim$(text$)
    b$ = _Trim$(Str$(Val(text$)))
    If a$ = b$ Then
        IsNum% = TRUE
    Else
        IsNum% = FALSE
    End If
End Function ' IsNum%
 
' /////////////////////////////////////////////////////////////////////////////
' 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.
 
Function join$ (in$(), delimiter$)
    result$ = in$(LBound(in$))
    For i = LBound(in$) + 1 To UBound(in$)
        result$ = result$ + delimiter$ + in$(i)
    Next i
    join$ = result$
End Function ' join$
 
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
 
Function LongABS& (lngValue As Long)
    If Sgn(lngValue) = -1 Then
        LongABS& = 0 - lngValue
    Else
        LongABS& = lngValue
    End If
End Function ' LongABS&
 
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
 
Function PrintFile$ (sFileName As String, sText As String, bAppend As Integer)
    'x = 1: y = 2: z$ = "Three"
 
    Dim sError As String: sError = ""
 
    If Len(sError) = 0 Then
        If (bAppend = TRUE) Then
            If _FileExists(sFileName) Then
                Open sFileName For Append As #1 ' opens an existing file for appending
            Else
                sError = "Error in PrintFile$ : File not found. Cannot append."
            End If
        Else
            Open sFileName For Output As #1 ' opens and clears an existing file or creates new empty file
        End If
    End If
    If Len(sError) = 0 Then
        ' WRITE places text in quotes in the file
        'WRITE #1, x, y, z$
        'WRITE #1, sText
 
        ' PRINT does not put text inside quotes
        Print #1, sText
 
        Close #1
 
        '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$
    End If
 
    PrintFile$ = sError
End Function ' PrintFile$
 
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
    Dim NumSpread%
 
    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer
 
    ' 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%
 
End Function ' RandomNumber%
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub RandomNumberTest
    Dim iCols As Integer: iCols = 10
    Dim iRows As Integer: iRows = 20
    Dim iLoop As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim sError As String
    Dim sFileName As String
    Dim sText As String
    Dim bAppend As Integer
    Dim iMin As Integer
    Dim iMax As Integer
    Dim iNum As Integer
    Dim iErrorCount As Integer
    Dim sInput$
 
    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)
    If Len(sError) = 0 Then
        bAppend = TRUE
        iErrorCount = 0
 
        iMin = 0
        iMax = iCols - 1
        For iLoop = 1 To 100
            iNum = RandomNumber(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        iMin = 0
        iMax = iRows - 1
        For iLoop = 1 To 100
            iNum = RandomNumber(iMin, iMax)
            sText = Str$(iLoop) + Chr$(9) + Str$(iMin) + Chr$(9) + Str$(iMax) + Chr$(9) + Str$(iNum)
            sError = PrintFile$(sFileName, sText, bAppend)
            If Len(sError) > 0 Then
                iErrorCount = iErrorCount + 1
                Print Str$(iLoop) + ". ERROR"
                Print "    " + "iMin=" + Str$(iMin)
                Print "    " + "iMax=" + Str$(iMax)
                Print "    " + "iNum=" + Str$(iNum)
                Print "    " + "Could not write to file " + Chr$(34) + sFileName + Chr$(34) + "."
                Print "    " + sError
            End If
        Next iLoop
 
        Print "Finished generating numbers. Errors: " + Str$(iErrorCount)
    Else
        Print "Error creating file " + Chr$(34) + sFileName + Chr$(34) + "."
        Print sError
    End If
 
    Input "Press <ENTER> to continue", sInput$
End Sub ' RandomNumberTest
 
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
'   Revision: 1.6
'   Updated:  5/28/2012
 
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
 
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    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]...
    While lngLocation
        ' 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]...
    Wend
 
    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$
 
' /////////////////////////////////////////////////////////////////////////////
' 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)
Function SetBit256% (iNum1 As Integer, iBit1 As Integer, bVal1 As Integer)
    Dim sNum As String
    Dim sBit As String
    Dim sVal As String
    Dim iLoop As Integer
    Dim strResult As String
    Dim iResult As Integer
    Dim iNum As Integer: iNum = iNum1
    Dim iBit As Integer: iBit = iBit1
    Dim bVal As Integer: bVal = bVal1
 
    If iNum < 256 And iBit <= 128 Then
        sNum = GetBinary$(iNum)
        sBit = GetBinary$(iBit)
        If bVal = TRUE Then
            sVal = "1"
        Else
            sVal = "0"
        End If
        strResult = ""
        For iLoop = 1 To 8
            If Mid$(sBit, iLoop, 1) = "1" Then
                strResult = strResult + sVal
            Else
                strResult = strResult + Mid$(sNum, iLoop, 1)
            End If
        Next iLoop
        iResult = GetIntegerFromBinary%(strResult)
    Else
        iResult = iNum
    End If
 
    SetBit256% = iResult
End Function ' SetBit256%
 
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM Â»
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
 
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
 
Sub split (in$, delimiter$, result$())
    ReDim result$(-1)
    start = 1
    Do
        While Mid$(in$, start, 1) = delimiter$
            start = start + 1
            If start > Len(in$) Then Exit Sub
        Wend
        finish = InStr(start, in$, delimiter$)
        If finish = 0 Then finish = Len(in$) + 1
        ReDim _Preserve result$(0 To UBound(result$) + 1)
        result$(UBound(result$)) = Mid$(in$, start, finish - start)
        start = finish + 1
    Loop While start <= Len(in$)
End Sub ' split
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub SplitTest
 
    Dim in$
    Dim delim$
    ReDim arrTest$(0)
    Dim iLoop%
 
    delim$ = Chr$(10)
    in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
    Print "in$ = " + Chr$(34) + in$ + Chr$(34)
    Print "delim$ = " + Chr$(34) + delimeter$ + Chr$(34)
    split in$, delim$, arrTest$()
 
    For iLoop% = LBound(arrTest$) To UBound(arrTest$)
        Print "arrTest$(" + LTrim$(RTrim$(Str$(iLoop%))) + ") = " + Chr$(34) + arrTest$(iLoop%) + Chr$(34)
    Next iLoop%
    Print
    Print "Split test finished."
End Sub ' SplitTest
 
' /////////////////////////////////////////////////////////////////////////////
 
Sub WaitForEnter
    Dim in$
    Input "Press <ENTER> to continue", in$
End Sub ' WaitForEnter
 
' /////////////////////////////////////////////////////////////////////////////
' 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)
    If Len(prompt$) > 0 Then
        If Right$(prompt$, 1) <> ";" Then
            Print prompt$
        Else
            Print Right$(prompt$, Len(prompt$) - 1);
        End If
    End If
 
    ' WAIT FOR KEY
    Do: Loop Until _KeyDown(KeyCode&) ' leave loop when specified key pressed
 
    ' PAUSE AFTER (IF SPECIFIED)
    If DelaySeconds% < 1 Then
        _KeyClear: '_DELAY 1
    Else
        _KeyClear: _Delay DelaySeconds%
    End If
End Sub ' WaitForKey
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
' /////////////////////////////////////////////////////////////////////////////
' Receives:
' cycleColor = determines how foreColor, backColor are modified
' foreColor  = the foreground color
' backColor  = the background color (if needed)
 
' /////////////////////////////////////////////////////////////////////////////
' DoCycleColor colorScheme%, myColor&
 
' colorScheme = color scheme (value is alternated on subsequent calls)
' myColor     = the current color (value is incremented/decremented on subsequent calls)
 
' colorScheme values:
'  1 Rainbow6 #1
'  9 Rainbow6 #2
'  2 Rainbow18 #1
' 10 Rainbow18 #2
'  3 Grayscale #1
' 11 Grayscale #2
'  4 Grayscale #1
' 12 Grayscale #2
 
Sub DoCycleColor (colorScheme As Integer, myColor As Long)
    ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
    ' CYCLE FORE COLOR
 
    ' 1, 5, 9 = simple rainbow
    If colorScheme = 1 Or colorScheme = 9 Then
        Select Case myColor
            Case cRed&:
                myColor = cOrange&
            Case cOrange&:
                myColor = cYellow&
            Case cYellow&:
                myColor = cGreen&
            Case cGreen&:
                myColor = cBlue&
            Case cBlue&:
                myColor = cPurple&
            Case Else:
                myColor = cRed&
        End Select
 
    ' 2, 6, 10 = complex rainbow
    ElseIf colorScheme = 2 Or colorScheme = 10 Then
        Select Case myColor
            Case cRed&:
                myColor = cOrangeRed&
            Case cOrangeRed&:
                myColor = cDarkOrange&
            Case cDarkOrange&:
                myColor = cOrange&
            Case cOrange&:
                myColor = cGold&
            Case cGold&:
                myColor = cYellow&
            Case cYellow&:
                myColor = cChartreuse&
            Case cChartreuse&:
                myColor = cLime&
            Case cLime&:
                myColor = cMediumSpringGreen&
            Case cMediumSpringGreen&:
                myColor = cCyan&
            Case cCyan&:
                myColor = cDeepSkyBlue&
            Case cDeepSkyBlue&:
                myColor = cDodgerBlue&
            Case cDodgerBlue&:
                myColor = cSeaBlue&
            Case cSeaBlue&:
                myColor = cBlue&
            Case cBlue&:
                myColor = cBluePurple&
            Case cBluePurple&:
                myColor = cDeepPurple&
            Case cDeepPurple&:
                myColor = cPurple&
            Case cPurple&:
                myColor = cPurpleRed&
            Case Else:
                myColor = cRed&
        End Select
 
    ' 3, 7, 11 = grayscale, ascending
    ElseIf colorScheme = 3 Or colorScheme = 11 Then
        Select Case myColor
            Case cBlack&:
                myColor = cDarkGray&
            Case cDarkGray&:
                myColor = cDimGray&
            Case cDimGray&:
                myColor = cGray&
            Case cGray&:
                myColor = cLightGray&
            Case cLightGray&:
                myColor = cSilver&
            Case cSilver&:
                myColor = cWhite&
            Case Else:
                'myColor = cBlack&
                myColor = cSilver&
 
                ' go in the other direction!
                If colorScheme = 3 Then
                    colorScheme = 4
                Else
                    colorScheme = 12
                End If
 
        End Select
 
    ' 4, 8, 12 = grayscale, descending
    ElseIf colorScheme = 4 Or colorScheme = 12 Then
        Select Case myColor
            Case cWhite&:
                myColor = cSilver&
            Case cSilver&:
                myColor = cLightGray&
            Case cLightGray&:
                myColor = cGray&
            Case cGray&:
                myColor = cDimGray&
            Case cDimGray&:
                myColor = cDarkGray&
            Case cDarkGray&:
                myColor = cBlack&
            Case Else:
                myColor = cDarkGray&
 
                ' go in the other direction!
                If colorScheme = 4 Then
                    colorScheme = 3
                Else
                    colorScheme = 11
                End If
        End Select
 
    End If
        
End Sub ' DoCycleColor
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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)
 
Function cRed& ()
    cRed& = _RGB32(255, 0, 0)
End Function
 
Function cOrangeRed& ()
    cOrangeRed& = _RGB32(255, 69, 0)
End Function ' cOrangeRed&
 
Function cDarkOrange& ()
    cDarkOrange& = _RGB32(255, 140, 0)
End Function ' cDarkOrange&
 
Function cOrange& ()
    cOrange& = _RGB32(255, 165, 0)
End Function ' cOrange&
 
Function cGold& ()
    cGold& = _RGB32(255, 215, 0)
End Function ' cGold&
 
Function cYellow& ()
    cYellow& = _RGB32(255, 255, 0)
End Function ' cYellow&
 
Function cChartreuse& ()
    cChartreuse& = _RGB32(127, 255, 0)
End Function ' cChartreuse&
 
Function cLime& ()
    cLime& = _RGB32(0, 255, 0)
End Function ' cLime&
 
Function cMediumSpringGreen& ()
    cMediumSpringGreen& = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen&
 
Function cCyan& ()
    cCyan& = _RGB32(0, 255, 255)
End Function ' cCyan&
 
Function cDeepSkyBlue& ()
    cDeepSkyBlue& = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue&
 
Function cDodgerBlue& ()
    cDodgerBlue& = _RGB32(30, 144, 255)
End Function ' cDodgerBlue&
 
Function cSeaBlue& ()
    cSeaBlue& = _RGB32(0, 64, 255)
End Function ' cSeaBlue&
 
Function cBlue& ()
    cBlue& = _RGB32(0, 0, 255)
End Function ' cBlue&
 
Function cBluePurple& ()
    cBluePurple& = _RGB32(64, 0, 255)
End Function ' cBluePurple&
 
Function cDeepPurple& ()
    cDeepPurple& = _RGB32(96, 0, 255)
End Function ' cDeepPurple&
 
Function cPurple& ()
    cPurple& = _RGB32(128, 0, 255)
End Function ' cPurple&
 
Function cPurpleRed& ()
    cPurpleRed& = _RGB32(128, 0, 192)
End Function ' cPurpleRed&
 
Function cDarkRed& ()
    cDarkRed& = _RGB32(160, 0, 64)
End Function ' cDarkRed&
 
Function cBrickRed& ()
    cBrickRed& = _RGB32(192, 0, 32)
End Function ' cBrickRed&
 
Function cDarkGreen& ()
    cDarkGreen& = _RGB32(0, 100, 0)
End Function ' cDarkGreen&
 
Function cGreen& ()
    cGreen& = _RGB32(0, 128, 0)
End Function ' cGreen&
 
Function cOliveDrab& ()
    cOliveDrab& = _RGB32(107, 142, 35)
End Function ' cOliveDrab&
 
Function cLightPink& ()
    cLightPink& = _RGB32(255, 182, 193)
End Function ' cLightPink&
 
Function cHotPink& ()
    cHotPink& = _RGB32(255, 105, 180)
End Function ' cHotPink&
 
Function cDeepPink& ()
    cDeepPink& = _RGB32(255, 20, 147)
End Function ' cDeepPink&
 
Function cMagenta& ()
    cMagenta& = _RGB32(255, 0, 255)
End Function ' cMagenta&
 
Function cBlack& ()
    cBlack& = _RGB32(0, 0, 0)
End Function ' cBlack&
 
Function cDimGray& ()
    cDimGray& = _RGB32(105, 105, 105)
End Function ' cDimGray&
 
Function cGray& ()
    cGray& = _RGB32(128, 128, 128)
End Function ' cGray&
 
Function cDarkGray& ()
    cDarkGray& = _RGB32(169, 169, 169)
End Function ' cDarkGray&
 
Function cSilver& ()
    cSilver& = _RGB32(192, 192, 192)
End Function ' cSilver&
 
Function cLightGray& ()
    cLightGray& = _RGB32(211, 211, 211)
End Function ' cLightGray&
 
Function cGainsboro& ()
    cGainsboro& = _RGB32(220, 220, 220)
End Function ' cGainsboro&
 
Function cWhiteSmoke& ()
    cWhiteSmoke& = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke&
 
Function cWhite& ()
    cWhite& = _RGB32(255, 255, 255)
End Function ' cWhite&
 
Function cDarkBrown& ()
    cDarkBrown& = _RGB32(128, 64, 0)
End Function ' cDarkBrown&
 
Function cLightBrown& ()
    cLightBrown& = _RGB32(196, 96, 0)
End Function ' cLightBrown&
 
Function cKhaki& ()
    cKhaki& = _RGB32(240, 230, 140)
End Function ' cKhaki&
 
Function cEmpty& ()
    cEmpty& = -1
End Function ' cEmpty&
 
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 

bplus · « **Reply #1 on:** December 04, 2021, 12:44:17 pm »

@madscijr

You should post in Programs in one thread as a work in progress. That way if amounts to something, and it should with continued progress, librarians have a single thread to reference. MasterGy is doing good job of that with "car simulator".

I wonder if you can make a Christmas tree of cubes or even a whole xmas scene?

madscijr · « **Reply #2 on:** December 04, 2021, 04:43:07 pm »

Quote from: bplus on December 04, 2021, 12:44:17 pm

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

All good ideas! I'll see what I can come up with! :-D

News:

Author Topic: Isometric Demo re-revisited v2.70 added variable grid size (Read 1326 times)

madscijr

Isometric Demo re-revisited v2.70 added variable grid size

bplus

Re: Isometric Demo re-revisited v2.70 added variable grid size

madscijr

Re: Isometric Demo re-revisited v2.70 added variable grid size