Author Topic: Isometric Demo re-revisited (getting better!) (Read 2644 times)

madscijr · « **on:** December 02, 2021, 10:40:31 am »

I did more playing around with the Isometric Mapping Demo code from
https://www.qb64.org/forum/index.php?topic=1903.30
and added a "walk around" mode with code to render cubes that block the view of the player as transparent,
with a simultaneous 2-D top down "map" view of the player's current Z slice.
This could be the beginning of a framework for simple 2.5d games.
Anyway I hope someone enjoys this or finds it helpful...
Any comments welcome.

Code: QB64: [Select]

' ################################################################################################################################################################
' Isomatric mapping demo re-revisited
' Version 2.69 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".
' Added code to render cubes that block the view of
' the player as transparent. Added a 2-D top down "map"
' view of the player's current Z slice.
 
' TO DO:
' * allow player to rotate their view
' * option to hide objects out of player's line-of-sight
' * add objects (water, ladders, ropes, windows, doors, ramps, etc.)
' * shrink grid size to 8x8 (may need to use some other rendering method)
' * expand world to bigger than screen (2.5d scrolling view)
' * show player as a stick figure (like "Realm of Impossibility")
' * add ability to walk up ramps / climb ladders / etc.
' * simultaneously show additional 1st person view
' * add ability for tilting head up/down in first person
' * split screen (x2 or x4) local multi-player version
' * make simple open world (players can add/remove blocks, build in real time, save screens)
' * 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
 
' =============================================================================
' 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 Function ' 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 Function ' 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 7, 1: Print "SPACE TOGGLES CONTINUOUS MOVEMENT"
            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_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 Function ' 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 02, 2021, 11:31:10 am »

That's coming along nicely!

madscijr · « **Reply #2 on:** December 02, 2021, 01:41:40 pm »

Quote from: bplus on December 02, 2021, 11:31:10 am

That's coming along nicely!

Heh, thanks. I've never really dabbled in anything like 3D before, and I've been finding just getting it to work the way I want opens up so many questions.
I am constantly reminded of how much I don't know, but I'm learning, often from just trial and error.
For instance I must have gone through 5 or 6 different methods to determine what bricks are in front of the player to make transparent.
Also it's made easier by searching the QB64 help and forums, and it doesn't hurt that QB is a friendly and easy language.

News:

Author Topic: Isometric Demo re-revisited (getting better!) (Read 2644 times)

madscijr

Isometric Demo re-revisited (getting better!)

bplus

Re: Isometric Demo re-revisited (getting better!)

madscijr

Re: Isometric Demo re-revisited (getting better!)