' ################################################################################################################################################################
' #TOP
' Isomatric mapping demo re-revisited
' Version 3.00 by madscijr
' Based on Isometric Mapping Demo
' by SMcNeill, bplus, and others at
' https://www.qb64.org/forum/index.php?topic=1903.30
' This crude version uses a 3-dimensional array (32x32x32)
' to store cubes of different colors,
' and draws them to the screen in 2.5D "isometric".
' -----------------------------------------------------------------------------
' DONE
' -----------------------------------------------------------------------------
' * Render cubes that block the view of the player as transparent.
' * 2-D top down "map" view of the player's current Z slice.
' * variable grid size
' * change arrMap to global shared variable (for simpler code) & rename m_arrMap
' * allow player to rotate their view
' * preliminary multiplayer changes
' - move player info into array (upto 4 players)
' - key mapping variables
' * fixed some keyboard input (repeating keys, continuous motion)
' * fixed right point of view bug where x & y coordinates were reversed
' * preliminary multiplayer changes
' - split screen display (4, 6, or 8?)
' + for now display player 1's world rotated in each window (for editor)
' * x4: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
' * x6: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward
' * x8: c_iDir_Down, c_iDir_Up, c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, (none), (none)
' + will eventually be one per player
' * 2D minimap background = cKhaki
' * , and . change minimap size
' * editor v1 = simple drawing program
' - change lowest z level to draw full blocks instead of flat tiles (leftover from early version)
' - add type RecordType to hold recording steps
' - add array m_arrRecord of RecordType to hold recording
' - display palette of available colors on screen
' + 26 colors including empty
' + 2 tiles (empty, wall)
' - cursor places tiles (ENTER = add/delete at current space)
' - 0-9 keys change colors/etc.
' - simple 1-level UNDO & REDO
' - save screens to file (stored as editable text)
' + FORMAT: tile={t},color={c},x={x},y={y},z={z}
' - load screens line by line (split was too slow)
' + PARSER:
' 1. remove whitespace
' 2. split by "," into 1D array of name/value pairs
' 3. each element is either tile, color, x, y, z
' 4. parse each into array to playback recording
' - run commands in m_arrRecord to plot tiles and display
' * 2-D front/back "map" view of the player's current Y slice.
' * 2-D right/left "map" view of the player's current X slice.
' SOME 3D SHAPE ROUTINES
' - 3D rectangle (cuboid)
' - 3D circle (simple, not a sphere, not filled)
' -----------------------------------------------------------------------------
' TO DO (HOLIDAY)
' -----------------------------------------------------------------------------
' * snow
' * ornaments
' * wind lights
' * blinking
' * tree star
' * rotate it all
' * stars (all 4 sides + top?)
' * northstar
' * text message
' * music
' * smaller tiles
' * one big map
' * - free rotate? 3D 3-shear rotation v1 (x/y)
' * mouse control (mouse moves x/y, wheel moves z)
' * MORE 3D SHAPE ROUTINES
' - improved circle
' * circle fill
' * circle wall thickness
' * option for origin at top left
' - step pyramid
' - sphere
' - simple line in one plane (x/y, x/z, y/z)
' - 3D line (x1,y1,z1) to (x2,y2,z2)
' * 3D select
' - copy/cut/paste
' - rotate (x/y, x/z, y/z)
' - flip (x/y, x/z, y/z)
' - invert
' - substitute colors
' - save contents as reusable shape
' christmas trees
' * stack of pyramids (grow, reset, grow)
' * stack of circle cones (circles grow)
' * 4-sided pyramid polygons with wavering bottom points
' * stack of circle cones (lines from bottom to tip)
' * 3-sided pyramid polygons with 3-d lines
'
' north star
' * shimmering north star
' * growing glowing circles along 3 axes
'
' ornaments
' * ornaments fly in from 4 directions
' * circles
' * striped
'
' lights
' * string of transparent lights follows around outside, winds its way up
' * colors = red, green, blue, yellow, orange, purple
' * save lights in array
' * shimmer each with its color pattern
'
' snowfall
' * wavering snowflakes
' * stick n deep
' * fall down if n spaces under
'
' stars in sky
' * at back edges
' * twinkling
'
' snowman
' * 3 spheres
' * cone nose
' * eyes
' * mouth
' * hat
' * stick arms
' * pipe
' * scarf
'
' presents
' stockings
' reindeer/slay
' -----------------------------------------------------------------------------
' TO DO (GENERAL)
' -----------------------------------------------------------------------------
' * screen size
' - grow screen to 64x64 (only 1 window)
' - shrink grid size
' * layers
' -----------------------------------------------------------------------------
' TO DO (DRAWING)
' -----------------------------------------------------------------------------
' * mouse control
' * change mouse axis
' * first person view
' * x/y/z view (total not slice)
' * line/brush size
' * line/bresenham
' * cube (height/length, width, isHollow?)
' * pyramid from top (height, color scheme, isHollow)
' * pyramid from base (length, width, isHollow)
' * polygon (draw n points, fills inbetween)
' * fill
' * YET MORE SHAPES
' - ellipse
' - n-sided polygon
' -----------------------------------------------------------------------------
' TO DO (MORE DETAILS)
' -----------------------------------------------------------------------------
' * get _BUTTON or some method working to detect keydown/keyup events for CTRL+Z, CTRL+Y for UNDO & REDO
' * save unlinited levels of undo/redo, using history of actions
' * rotating view changes orientation of keys (get it working)
' * add parameters to tiles
' - color scheme (for cycle colors)
' * add tiles
' - transparent lights (blinking / cycle colors)
' * editor v2 = simple animation program
' - records cursor movements and adding/deleting tiles
' - press key to record a "frame"
' + flash screen + play a sound
' - can change animation speed
' - realtime=on command enables redrawing screen every step (until realtime=off command encountered)
' - playback mode recreates editing actions
' - playback updates screen every "update"
' - tweak save format (still editable text)
' + FORMAT: TBD
' + PARSER:
' 1. Commands:
' - cls
' - rotate perspective (up, down, left, right, back, forward), FORMAT: rotate={d}
' - enable/disable screen update every step, FORMAT: realtime{on/off}
' - set speed, FORAT: speed={s}
' - update screen, FORMAT: update
' - clear screen "cls"
' - select tile
' - change color
' - movement? (speed / direction)
' - effects of gravity (from bottom up, ie z=0 to z=max)
' -----------------------------------------------------------------------------
' * expand world to bigger than screen (2.5d scrolling view)
' * editor v3 = mouse
' - mouse movement controls cursor x,y position
' - mouse wheel controls z position
' - left click draws a tile
' - right click erases a tile
' - ENTER records a frame
' - Add animation playback command:
' [n][0] = command
' -8 = enable user to rotate image in realtime with mouse? "mouse=on"
' -----------------------------------------------------------------------------
' TO DO (LATER)
' -----------------------------------------------------------------------------
' * local multiplayer (2-4 players)
' - split screen (x2 or x4)
' * fix/control screen placement/rendering/scroll boundaries for grid sizes
' (to not overwrite other players, go off screen, etc., when grid size changes)
' * auto-rotate view depending on direction player is facing
' * control the x/y/z slice axis, for a cutaway view
' * gravity (players stay on ground, can fall)
' * player can climb up to next level if it is 1 tile higher
' * add ability to jump over 1 space
' * option to remap keys
' * support game controllers
' * game controller calibration/mapping function
' * option to hide objects out of player's line-of-sight
' * show player as a stick figure (like "Realm of Impossibility")
' * walking movement
' * add tiles (water, ladders, steps, ropes, windows, doors, etc.)
' * add toggle tiles - door "opens" when triggered
' * triggers
' * add tiles
' - Water = transparent blue)
' - Window = more transparent cyan)
' * add directional tiles (can be rotated?)
' - ladder
' - bridge
' - hand-over-hand bars?
' - Slope45 = 45° slope <- 4 or 6 directions?
' - InvSlope45 = 45° inverted slope <- 4 or 6 directions?
' - Pyramid45 = 45° pyramid "cap stone" <- 4 or 6 directions?
' - ramp (player can walk up/down slope45)
' * add ability to climb ladders + climbing animation
' * add ability to walk up ramps with smooth z-movement inbetween tiles
' * add ability to climb monkey bars (animation like lode runner)
' * simultaneously show additional 1st person view
' * add ability for tilting head up/down in first person
' * simple open world (players can add/remove tiles, build in real time)
' * make simple games (maze craze, capture the flag, snake, surround, 2.5d pong)
' * make more complex games (berzerk, lode runner, atari combat / tank)
' * make awesome complex games (2.5d lunar lander, atari adventure, asteroids, gravitar, Zaxxon meets Atari 2600 Superman, Isometric Atari 2600 Raiders of the Lost Ark, etc.)
' * text adventure features (to create graphic Infocom or Scott Adams style games)
' * for 2.5D animation program: independent animated objects?
' - 2.5D sprites?
' + animation sequence
' + motion path / algorithm
' + storage / library
' + multiple instances?
' - gravity? (tile falls if no tiles underneath)
' ################################################################################################################################################################
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' =============================================================================
' GLOBAL DECLARATIONS
' -----------------------------------------------------------------------------
' boolean constants
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' KeyDownConstants
' -----------------------------------------------------------------------------
Const c_iKeyDown_Esc
= 27 Const c_iKeyDown_F1
= 15104 Const c_iKeyDown_F2
= 15360 Const c_iKeyDown_F3
= 15616 Const c_iKeyDown_F4
= 15872 Const c_iKeyDown_F5
= 16128 Const c_iKeyDown_F6
= 16384 Const c_iKeyDown_F7
= 16640 Const c_iKeyDown_F8
= 16896 Const c_iKeyDown_F9
= 17152 Const c_iKeyDown_F10
= 17408 Const c_iKeyDown_Tilde
= 96 Const c_iKeyDown_Minus
= 45 Const c_iKeyDown_EqualPlus
= 61 Const c_iKeyDown_BkSp
= 8 Const c_iKeyDown_Ins
= 20992 Const c_iKeyDown_Home
= 18176 Const c_iKeyDown_PgUp
= 18688 Const c_iKeyDown_Del
= 21248 Const c_iKeyDown_End
= 20224 Const c_iKeyDown_PgDn
= 20736 Const c_iKeyDown_KEYPAD_7_Home
= 18176 Const c_iKeyDown_KEYPAD_8_Up
= 18432 Const c_iKeyDown_KEYPAD_9_PgUp
= 18688 Const c_iKeyDown_KEYPAD_4_Left
= 19200 Const c_iKeyDown_KEYPAD_6_Right
= 19712 Const c_iKeyDown_KEYPAD_1_End
= 20224 Const c_iKeyDown_KEYPAD_2_Down
= 20480 Const c_iKeyDown_KEYPAD_3_PgDn
= 20736 Const c_iKeyDown_KEYPAD_0_Ins
= 20992 Const c_iKeyDown_KEYPAD_Period_Del
= 21248 Const c_iKeyDown_Pipe
= 105 Const c_iKeyDown_BracketLeft
= 91 Const c_iKeyDown_BracketRight
= 93 Const c_iKeyDown_Backslash
= 92 Const c_iKeyDown_SemiColon
= 59 Const c_iKeyDown_Apostrophe
= 39 Const c_iKeyDown_Enter
= 13 Const c_iKeyDown_Comma
= 44 Const c_iKeyDown_Period
= 46 Const c_iKeyDown_Slash
= 47 Const c_iKeyDown_Up
= 18432 Const c_iKeyDown_Left
= 19200 Const c_iKeyDown_Down
= 20480 Const c_iKeyDown_Right
= 19712 Const c_iKeyDown_Spacebar
= 32
' -----------------------------------------------------------------------------
' Constants for layers
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' Tile value constants for map (MapTileType.Typ)
' -----------------------------------------------------------------------------
Const c_iTile_Player1
= 5 Const c_iTile_Player2
= 6 Const c_iTile_Player3
= 7 Const c_iTile_Player4
= 8 Const c_iTile_Blinking
= 9 Const c_iTile_Slope45
= 11 Const c_iTile_InvSlope45
= 12
' -----------------------------------------------------------------------------
' constants for 2.5D movement
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' constants for drawing the 2.5D screen
' -----------------------------------------------------------------------------
Const cScreenOffsetX
= 500 Const cScreenOffsetY
= 300
' -----------------------------------------------------------------------------
' constants for 3D coordinates
' -----------------------------------------------------------------------------
' =============================================================================
' USER DEFINED TYPES
' =============================================================================
Typ
As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc. 'Vis As Integer ' TRUE = visible, FALSE = don't render
'Lit As Long ' light offset
Alpha1
As Integer ' transparency of tile Color1 Alpha2
As Integer ' transparency of tile Color2 Alpha3
As Integer ' transparency of tile Color3 AlphaOverride
As Integer ' can be used to override alpha (255 treated as opaque)
origz
As Integer ' used for shear rotation (added for 3D) zone
as integer ' used for shear rotation, which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
Typ
As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc. Alpha1
As Integer ' transparency of tile Color1
' UDT TO HOLD THE INFO FOR A PLAYER
Direction
As Integer ' direction player is moving: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward; not used: c_iDir_Down, c_iDir_Up View As Integer ' player's viewing orientation (direction screen is being looked at from), can be: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up Tile1
As Long ' later we will instead use directional animation sequences
'Color2 As _Unsigned Long ' secondary color if needed
'Color3 As _Unsigned Long ' third color if needed
Alpha1
As Integer ' transparency of player Color1 'Alpha2 As Integer ' transparency of player Color2
'Alpha3 As Integer ' transparency of player Color3
ColorScheme1
As Long ' for cycling colors
'ColorScheme2 As Long ' for cycling colors
'ColorSchemeSpeed2 As Long
'ColorSchemeCount2 As Long
'ColorScheme3 As Long ' for cycling colors
'ColorSchemeSpeed3 As Long
'ColorSchemeCount3 As Long
AlphaOverride
As Integer ' can be used to override alpha (0 treated as opaque)
'hx AS Integer ' home base x position
'hy AS Integer ' home base y position
'ex AS Integer ' exit x position
'ey AS Integer ' exit y position
'wins AS Integer ' count # of wins
'points AS Long ' count points (more points for harder)
'difficulty AS Integer ' 1-5, from 1 (easiest, maze width 5) to 5 (hardest, maze width 1). Each win awards {difficulty} # of points.
'speed AS Integer ' the higher the faster
'delay AS Integer ' counter, player can move based on speed
'bit AS Integer ' bit value for masking player in map
'rows AS Integer ' # of rows in player's maze
'cols AS Integer ' # of columns in player's maze
' HOLDS SNOWFLAKES
' TODO: generalize this for more complex objects
Direction
As Integer ' direction object is moving: c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up Tile1
As Long ' tile to draw it with
' used to track last time snowflake moved in the wind?
' used to regulate snowflake's vertical speed
' KEY MAPPING v1
' UDT TO HOLD THE KEY MAPPINGS
' SPLIT SCREEN OFFSETS
' WHERE TO SHOW THE SPLIT SCREENS
' WHERE TO DRAW THE PLAYER'S MINI MAPS
' WHERE TO LOCATE(Y,X) THE PLAYER'S MINI MAP TEXT LABELS
' TODO: later this will probably be bitmap text
'c As Integer
zone
as integer ' which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
Typ
As Integer ' c_iTile_Empty, c_iTile_Floor, c_iTile_Wall, etc. 'Color2 As _Unsigned Long ' secondary color if needed
'Color3 As _Unsigned Long ' third color if needed
Alpha1
As Integer ' transparency of tile Color1 'Alpha2 As Integer ' transparency of tile Color2
'Alpha3 As Integer ' transparency of tile Color3
'AlphaOverride As Integer ' can be used to override alpha (255 treated as opaque)
' =============================================================================
' GLOBAL VARIABLES
' =============================================================================
Dim Shared m_iGridSize
As Integer: m_iGridSize
= 6 ' BEFORE, < 10 wass causing problems with PAINT, but new method doesn't use PAINT, so nyah!
Dim Shared m_iObjectCount
As Integer: m_iObjectCount
= 0 ' <- TO BE USED WHEN WE HAVE OBJECTS
Dim Shared m_arrMap
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrRender0
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrRender1
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrRender2
(m_iMapMinX
To m_iMapMaxX
, m_iMapMinY
To m_iMapMaxY
, m_iMapMinZ
To m_iMapMaxZ
) As MapTileType
Dim Shared m_arrPlayer
(m_iPlayerMin
To m_iPlayerMax
) As PlayerType
' PLACE TEXT INSTRUCTIONS ON SCREEN
' PLACE MINI MAPS ON SCREEN
' PLACE MINI MAP TEXT ON SCREEN (150 pixels = 19 text characters)
' TODO: ADD UNLIMITED UNDO, FOR NOW ONE LEVEL IS BETTER THAN NONE!
' This array is used to hold user's drawing actions,
' to save drawings and for playback, and later for Undo/Redo.
' How big will the recording get?
' Max # tiles in (32x32x32) world = 32,768
' Max # tiles for 16 (32x32x32) worlds = 524,288
' Max # tiles for 256 (32x32x32) worlds = 8,388,608
' For each player, map the 6 directional keys differently for each of the 6 directional orientations!
Dim Shared m_arrDirKeyMap
(m_iPlayerMin
To m_iPlayerMax
, c_iDir_Min
To c_iDir_Max
) As DirKeyMapType
' Store offsets for splitscreen
Dim Shared m_arrSplitScreen
(m_iPlayerMin
To m_iPlayerMax
) As SplitScreenType
' Store colors in an array
' ENABLE / DISABLE DEBUG CONSOLE
' ENABLE / DISABLE DEBUG GRID
' TODO: REPLACE THIS HACK WAY OF TRACKING KEY UP/DOWN
' =============================================================================
' LOCAL VARIABLES
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
_Echo "Started " + m_ProgramName$
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
Print m_ProgramName$
+ " finished." Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
' ****************************************************************************************************************************************************************
System ' return control to the operating system
' /////////////////////////////////////////////////////////////////////////////
Print "Isomatric Mapping Demo Re-visited" Print "v3.01, by Softintheheadware (Dec, 2021)" 'PRINT "CONTROLS: PRESS <ESC> TO RETURN TO MENU"
'PRINT "PLAYER LEFT RIGHT UP DOWN "
'PRINT "1 CRSR LEFT CRSR RIGHT CRSR UP CRSR DOWN "
'PRINT "2 KEYPAD 4 KEYPAD 6 KEYPAD 8 KEYPAD 2 "
'PRINT "3 A S W Z "
'PRINT "4 J K I M "
'PRINT
Print "1. A little holiday message + primitive drawing in 2.5D woohoo!" 'Print "2. BoxDrawTest1$"
'Print "3. (TBD)"
'Print "4. (TBD)"
Print "What to do? ('q' to exit)"
result$ = IsometricDraw1$
'result$ = BoxDrawTest1$
'result$ = IsometricDemo1$
'result$ = IsometricDemo2$
'result$ = IsometricDemo3$
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo1$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo2$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
IsometricDemo3$ = "(TBD)"
' /////////////////////////////////////////////////////////////////////////////
' Test all the values 0-255 for style
' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
iSize% = 48 ' {n}x{n} pixels square
iDrawX% = 10
iDrawY% = 10
iNextColor~& = cWhite
iSpace% = 8
DrawStyledOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, iLoop
'DrawOutlineBox iDrawX%+1, iDrawY%+1, iSize%-2, iNextColor~&, iLoop
iDrawX% = iDrawX% + iSize% + iSpace%
If iDrawX%
> (1280 - (iSize%
* 2)) Then iDrawX% = 10
iDrawY% = iDrawY% + iSize% + iSpace%
If iDrawY%
> (1024 - (iSize%
* 2)) Then sError = "Ran out of Y space."
For iLoop
= 1 To (iSize% \
2) DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, iLoop
iDrawX% = iDrawX% + iSize% + iSpace%
If iDrawX%
> (1280 - (iSize%
* 2)) Then iDrawX% = 10
iDrawY% = iDrawY% + iSize% + iSpace%
If iDrawY%
> (1024 - (iSize%
* 2)) Then sError = "Ran out of Y space."
Input "PRESS <ENTER> TO CONTINUE"; in$
BoxDrawTest1$ = ""
' /////////////////////////////////////////////////////////////////////////////
' receives x,y,z coordinates of the back, bottom, left corner
' and width, length, height for the size
' where
' X1 is the x dimension, the size of which is W1 width
' Y1 is the y dimension, the size of which is L1 length
' Z1 is the z dimension, the size of which is H1 height
' and draws a tile iTile in the color iColor
' using PlotTile
' usage:
' PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
' TODO: add parameter to specify array to plot to
X2 = (X1 + W1) - 1
Y2 = (Y1 + L1) - 1
Z2 = (Z1 + H1) - 1
PlotTile iX, iY, iZ, iTile, iColor
' /////////////////////////////////////////////////////////////////////////////
' Fast circle drawing in pure Atari BASIC#
' https://atariwiki.org/wiki/Wiki.jsp?page=Super%20fast%20circle%20routine
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903282.BAS
' * Atari BASIC listing (listed): M8903282.LST
' Next example is demonstration of implementing mentioned circle algorithm
' in pure Atari BASIC. This program shows how much faster it is compared to
' classic program using sine and cosine functions from Atari BASIC
' (shown in last example).
' Basic Listing M8903282.LST#
'1 REM *******************************
'2 REM PROGRAM : FAST CIRCLE DRAWING
'3 REM AUTHOR : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 PRINT "ENTER X, Y AND R"
'30 INPUT X,Y,R
'40 IF R=0 THEN PLOT X,Y:END
'50 B=R:C=0:A=R-1
'60 PLOT X+C,Y+B
'70 PLOT X+C,Y-B
'80 PLOT X-C,Y-B
'90 PLOT X-C,Y+B
'100 PLOT X+B,Y+C
'110 PLOT X+B,Y-C
'120 PLOT X-B,Y-C
'130 PLOT X-B,Y+C
'140 C=C+1
'150 A=A+1-C-C
'160 IF A>=0 THEN 190
'170 B=B-1
'180 A=A+B+B
'190 IF B>=C THEN 60
' Use some valid values for coordinates and radius, for example:
' X=40, Y=40, R=30
' X=130, Y=90, R=60
' Slow circle drawing in Atari BASIC#
' * Magazine: Moj Mikro, 1989/3
' * Author : Zlatko Bleha
' * Page : 27 - 31
' * Atari BASIC listing on disk (tokenized): M8903281.BAS
' * Atari BASIC listing (listed): M8903281.LST
' This is classic example for drawing circles from Atari BASIC
' using sine and cosine functions. Unfortunatelly, this is very slow
' way of doing it and not recommended.
' Just use routine shown above and everybody will be happy
' Basic Listing M8903281.LST#
'1 REM *******************************
'2 REM PROGRAM : SLOW CIRCLE DRAWING
'3 REM AUTHOR : ZLATKO BLEHA
'4 REM PUBLISHER: MOJ MIKRO MAGAZINE
'5 REM ISSUE NO.: 1989, NO.3, PAGE 29
'6 REM *******************************
'7 REM
'10 GRAPHICS 8:SETCOLOR 2,0,0:COLOR 3
'20 FOR A=0 TO 6.28 STEP 0.02
'30 X=SIN(A)*50+150
'40 Y=COS(A)*50+80
'50 PLOT X,Y
'60 NEXT A
' Conclusion#
' Returning back to first program with the fastest way of drawing circles...
' There is one more thing to note. In case you want to use PLOT subroutine,
' which is part of the main circle routine, then read following explanation.
' PLOT routine is written so it can be used easily from Atari BASIC program
' independently from main circle routine, by using like this:
' A=USR(30179,POK,X,Y)
'
' POK 1 (drawing a pixel), 0 (erasing a pixel)
' X X coordinate of the pixel
' Y Y coordinate of the pixel
'
' The routine alone is not any faster than normal PLOT command
' from Atari BASIC, because USR command takes approximately 75%
' of whole execution. But, used as part of the main circle routine
' it does not matter anymore, because it is integrated in one larger
' entity. There the execution is very fast, with no overhead.
' PLOT routine is here for you to examine anyway.
' You never know if you will maybe need it in the future.
' More on plotting circles:
' Drawing a circle in BASIC - fast
' https://www.cpcwiki.eu/forum/programming/drawing-a-circle-in-basic-fast/
' -----------------------------------------------------------------------------
' Modified to work with 3 dimensional array
' -----------------------------------------------------------------------------
' Dependencies:
' Needs the following constants defined: cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' Receives:
' iAxis = which plane to draw it on, where cPlaneXY=X,Y cPlaneYZ=Y,Z cPlaneZX=X,Z
' X,Y,Z = center point of circle
' R = radius
' iTile = tile to plot with using PlotTile
' iColor = color to make the tile
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' PlotCircle iAxis, startX, startY, startZ, radius, iTile, iColor
' TODO: add parameter to specify array to plot to
B = R
C = 0
A = R - 1
' X, Y
PlotTile X + C, Y + B, Z, iTile, iColor
PlotTile X + C, Y - B, Z, iTile, iColor
PlotTile X - C, Y - B, Z, iTile, iColor
PlotTile X - C, Y + B, Z, iTile, iColor
PlotTile X + B, Y + C, Z, iTile, iColor
PlotTile X + B, Y - C, Z, iTile, iColor
PlotTile X - B, Y - C, Z, iTile, iColor
PlotTile X - B, Y + C, Z, iTile, iColor
' Y, Z
PlotTile X, Y + B, Z + C, iTile, iColor
PlotTile X, Y - B, Z + C, iTile, iColor
PlotTile X, Y - B, Z - C, iTile, iColor
PlotTile X, Y + B, Z - C, iTile, iColor
PlotTile X, Y + C, Z + B, iTile, iColor
PlotTile X, Y - C, Z + B, iTile, iColor
PlotTile X, Y - C, Z - B, iTile, iColor
PlotTile X, Y + C, Z - B, iTile, iColor
' X, Z
PlotTile X + C, Y, Z + B, iTile, iColor
PlotTile X + C, Y, Z - B, iTile, iColor
PlotTile X - C, Y, Z - B, iTile, iColor
PlotTile X - C, Y, Z + B, iTile, iColor
PlotTile X + B, Y, Z + C, iTile, iColor
PlotTile X + B, Y, Z - C, iTile, iColor
PlotTile X - B, Y, Z - C, iTile, iColor
PlotTile X - B, Y, Z + C, iTile, iColor
' DO NOTHING
C = C + 1
A = A + 1 - C - C
If A
< 0 Then ' IF A>=0 THEN 190 B = B - 1
A = A + B + B
' /////////////////////////////////////////////////////////////////////////////
' Temporary variable version
' later we will update PlotCircle and all will use that
' for now bSaveToRecording is disabled
' later we will use a global variable for that
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' PlotCircle2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
B = R
C = 0
A = R - 1
' X, Y
PlotTile2 arrMap(), X + C, Y + B, Z, iTile, iColor
PlotTile2 arrMap(), X + C, Y - B, Z, iTile, iColor
PlotTile2 arrMap(), X - C, Y - B, Z, iTile, iColor
PlotTile2 arrMap(), X - C, Y + B, Z, iTile, iColor
PlotTile2 arrMap(), X + B, Y + C, Z, iTile, iColor
PlotTile2 arrMap(), X + B, Y - C, Z, iTile, iColor
PlotTile2 arrMap(), X - B, Y - C, Z, iTile, iColor
PlotTile2 arrMap(), X - B, Y + C, Z, iTile, iColor
' Y, Z
PlotTile2 arrMap(), X, Y + B, Z + C, iTile, iColor
PlotTile2 arrMap(), X, Y - B, Z + C, iTile, iColor
PlotTile2 arrMap(), X, Y - B, Z - C, iTile, iColor
PlotTile2 arrMap(), X, Y + B, Z - C, iTile, iColor
PlotTile2 arrMap(), X, Y + C, Z + B, iTile, iColor
PlotTile2 arrMap(), X, Y - C, Z + B, iTile, iColor
PlotTile2 arrMap(), X, Y - C, Z - B, iTile, iColor
PlotTile2 arrMap(), X, Y + C, Z - B, iTile, iColor
' X, Z
PlotTile2 arrMap(), X + C, Y, Z + B, iTile, iColor
PlotTile2 arrMap(), X + C, Y, Z - B, iTile, iColor
PlotTile2 arrMap(), X - C, Y, Z - B, iTile, iColor
PlotTile2 arrMap(), X - C, Y, Z + B, iTile, iColor
PlotTile2 arrMap(), X + B, Y, Z + C, iTile, iColor
PlotTile2 arrMap(), X + B, Y, Z - C, iTile, iColor
PlotTile2 arrMap(), X - B, Y, Z - C, iTile, iColor
PlotTile2 arrMap(), X - B, Y, Z + C, iTile, iColor
' DO NOTHING
C = C + 1
A = A + 1 - C - C
If A
< 0 Then ' IF A>=0 THEN 190 B = B - 1
A = A + B + B
' /////////////////////////////////////////////////////////////////////////////
' Re: Is this fast enough as general circle fill?
' https://qb64forum.alephc.xyz/index.php?topic=298.msg1913#msg1913
' From: SMcNeill
' Date: « Reply #30 on: June 26, 2018, 03:34:18 pm »
'
' Sometimes, computers do things that are completely counter-intuitive to us, and
' we find ourselves having to step back as programmers and simply say, "WOW!!"
' Here's a perfect example of that:
' Here we look at two different circle fill routines -- one, which I'd assume to
' be faster, which precalculates the offset needed to find the endpoints for each
' line which composes a circle, and another, which is the same old CircleFill
' program which I've shared countless times over the years with people on various
' QB64 forums.
'
' When all is said and done though, CircleFill is STILL even faster than
' CircleFillFast, which pregenerates those end-points for us!
' -----------------------------------------------------------------------------
' Modified to work with 3 dimensional array
' -----------------------------------------------------------------------------
' Dependencies:
' Needs the following constants defined: cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' Receives:
' iAxis = which plane to draw it on, where 1=X,Y 2=Y,Z 3=X,Z
' X,Y,Z = center point of circle
' R = radius
' iTile = tile to plot with using PlotTile
' iColor = color to make the tile
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' CircleFill iAxis, startX, startY, startZ, radius, iTile, iColor
' TODO: add parameter to specify array to plot to
RadiusError = -Radius
X = Radius
Y = 0
'TODO: SHOULDN'T WE JUST PLOT A DOT IF RADIUS IS 1 RATHER THAN 0 ?
''PSET (CX, CY), C
'PlotPoint CX, CY, S, MyArray()
PlotTile CX, CY, CZ, iTile, iColor
' X, Y
' (just add Z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile iLoopX, CY, CZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopY = CY - X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, iLoopY, CZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopY = CY + X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, iLoopY, CZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopY = CY - Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, iLoopY, CZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopY = CY + Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, iLoopY, CZ, iTile, iColor
' Y, Z
' (x becomes z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile CX, CY, iLoopZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopY = CY - X
FOR iLoopZ
= CZ
- Y
TO CZ
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile CX, iLoopY, iLoopZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopY = CY + X
FOR iLoopZ
= CZ
- Y
TO CZ
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile CX, iLoopY, iLoopZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopY = CY - Y
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile CX, iLoopY, iLoopZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopY = CY + Y
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile CX, iLoopY, iLoopZ, iTile, iColor
' X, Z
' (x stays x, y becomes z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile iLoopX, CY, CZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopZ = CZ - X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, CY, iLoopZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopZ = CZ + X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, CY, iLoopZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopZ = CZ - Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, CY, iLoopZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopZ = CZ + Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile iLoopX, CY, iLoopZ, iTile, iColor
' DO NOTHING
' /////////////////////////////////////////////////////////////////////////////
' Temporary variable version
' later we will update CircleFill and all will use that
' for now bSaveToRecording is disabled
' later we will use a global variable for that
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' CircleFill2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
RadiusError = -Radius
X = Radius
Y = 0
'TODO: SHOULDN'T WE JUST PLOT A DOT IF RADIUS IS 1 RATHER THAN 0 ?
''PSET (CX, CY), C
'PlotPoint CX, CY, S, MyArray()
PlotTile2 arrMap(), CX, CY, CZ, iTile, iColor
' X, Y
' (just add Z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, CZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopY = CY - X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopY = CY + X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopY = CY - Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopY = CY + Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, iLoopY, CZ, iTile, iColor
' Y, Z
' (x becomes z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile2 arrMap(), CX, CY, iLoopZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopY = CY - X
FOR iLoopZ
= CZ
- Y
TO CZ
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopY = CY + X
FOR iLoopZ
= CZ
- Y
TO CZ
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopY = CY - Y
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopY = CY + Y
FOR iLoopZ
= CZ
- X
TO CZ
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), CX, iLoopY, iLoopZ, iTile, iColor
' X, Z
' (x stays x, y becomes z)
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
'LINE (CX - X, CY)-(CX + X, CY), C, BF
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, CY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, CZ, iTile, iColor
RadiusError = RadiusError + Y * 2 + 1
'LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
iLoopZ = CZ - X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
'LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
iLoopZ = CZ + X
FOR iLoopX
= CX
- Y
TO CX
+ Y
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
iLoopZ = CZ - Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
iLoopZ = CZ + Y
FOR iLoopX
= CX
- X
TO CX
+ X
'PlotPoint iLoopX, iLoopY, S, MyArray()
PlotTile2 arrMap(), iLoopX, CY, iLoopZ, iTile, iColor
' DO NOTHING
' /////////////////////////////////////////////////////////////////////////////
' Returns a semicircle represented in a _Byte array
' R = radius
' Q = which quarter of the circle to return
' where 1=top right, 2=bottom right, 3=bottom left, 4=top left
' like this:
' .......4444111.......
' .....44.......11.....
' ....4...........1....
' ...4.............1...
' ..4...............1..
' .4.................1.
' .4.................1.
' 4...................1
' 4...................1
' 4...................1
' 3...................1
' 3...................2
' 3...................2
' 3...................2
' .3.................2.
' .3.................2.
' ..3...............2..
' ...3.............2...
' ....3...........2....
' .....33.......22.....
' .......3333222.......
' S = char to draw
' MyArray = 2D *dynamic* array to plot semicircle in, (0 To R, 0 To R) of _Byte
' Usage:
' ReDim MyArray(-1, -1) As _Byte
' GetSemicircle R, Q, MyArray()
Dim RoutineName
As String : RoutineName
= "GetSemicircle"
' Resize array
' Clear array
MyArray(X,Y) = 0
' Plot semicircle to array
B = R
C = 0
A = R - 1
' PORTIONS OF CIRCLE:
' .......3333222.......
' .....33.......22.....
' ....3...........2....
' ...7.............6...
' ..7...............6..
' .7.................6.
' .7.................6.
' 7...................6
' 7...................6
' 7...................6
' 8...................6
' 8...................5
' 8...................5
' 8...................5
' .8.................5.
' .8.................5.
' ..8...............5..
' ...8.............5...
' ....4...........1....
' .....44.......11.....
' .......4444111.......
' JUST PLOT SELECTED QUADRANT:
' quadrant #1
MyArray(C, R - B) = 1 ' 2
MyArray(B, R - C) = 1 ' 6
' quadrant #2
MyArray(B, C) = 1 ' 5
MyArray(C, B) = 1 ' 1
' quadrant #3
MyArray(R - C, B) = 1 ' 4
MyArray(R - B, C) = 1 ' 8
' quadrant #4
MyArray(R - B, R - C) = 1 ' 7
MyArray(R - C, R - B) = 1 ' 3
' (DO NOTHING)
'' PLOT CIRCLE:
'' quadrant #1
'PlotPoint R + C, R - B, S2, arrTemp() ' 2
'PlotPoint R + B, R - C, S2, arrTemp() ' 6
'
'' quadrant #2
'PlotPoint R + B, R + C, S2, arrTemp() ' 5
'PlotPoint R + C, R + B, S2, arrTemp() ' 1
'
'' quadrant #3
'PlotPoint R - C, R + B, S2, arrTemp() ' 4
'PlotPoint R - B, R + C, S2, arrTemp() ' 8
'
'' quadrant #4
'PlotPoint R - B, R - C, S2, arrTemp() ' 7
'PlotPoint R - C, R - B, S2, arrTemp() ' 3
C = C + 1
A = A + 1 - C - C
B = B - 1
A = A + B + B
' /////////////////////////////////////////////////////////////////////////////
' ShearRotate v4
' *****************************************************************************
' UNDER CONSTRUCTION
' Tried to get this working for 3D and positive indexed array,
' and no runtime or compile errors,
' but doesn't seem to be working (the screen goes black when we render it!)
' *****************************************************************************
' -----------------------------------------------------------------------------
' CHANGES
' -----------------------------------------------------------------------------
' * Modified to work with 3 dimensional array (iterates through z axis)
' * Modified to work with non-polar array (converts coordinates to polar coordinates)
' -----------------------------------------------------------------------------
' NOTES
' -----------------------------------------------------------------------------
' Tries to fix the problem of 2 points resolving to the same coordinate
' (one overwrites the other, which becomes "lost")
' using a different approach, by just looking at the problem angles:
' 30, 60, 120, 150, 210, 240, 300, 330 degrees
' (which can be cClockwise or cCounterClockwise)
' together with which quarter of the screen the point is in,
' Note: cClockwise and cCounterClockwise constants must be declared globally.
' Returns # points missing (that could not be corrected) in iMissing parameter.
' -----------------------------------------------------------------------------
' Dependencies
' -----------------------------------------------------------------------------
' Needs the following constants defined:
' cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' cCounterClockwise = -1, cClockwise = 1
' Receives:
' OldArray() = original 3d array (x,y,z) of MapTileType to be rotated,
' * must contain an odd # of elements, so there is a center axis to rotate around
' NewArray() = rotated 3d array (x,y,z) of MapTileType to be returned
' * must be the same array size/type as OldArray
' * must be declared as a dynamic array with ReDim
' angle1 = angle to rotate OldArray to, can be 0-360
' iDirection = direction of rotation, can be cClockwise or cCounterClockwise
' iAxis = which plane to draw it on, where cPlaneXY=X,Y cPlaneYZ=Y,Z cPlaneZX=X,Z
' * currently only cPlaneXY is supported
' iMissing = return value, # of points which were "lost in rotation"
' -----------------------------------------------------------------------------
' TODO:
' * get it working
' * maybe add option to only rotate one slice
' (e.g. if we're rotating x/y, specify a single z)
' -----------------------------------------------------------------------------
' USAGE:
' ShearRotate4 OldArray(), NewRotatedArray(), angleToRotateTo, cClockwise, cPlaneXY, iMissingTileCount
OldArray
() As MapTileType
, _
NewArray
() As MapTileType
, _
Dim RtoD
As Double: RtoD
= 180 / Pi
' radians * RtoD = degrees Dim DtoR
As Double: DtoR
= Pi
/ 180 ' degrees * DtoR = radians Dim clr
As RotationType
' Integer
Dim iDiffPolarX
As Integer ' used to convert array coordinates to polar coordinates
' -----------------------------------------------------------------------------
' initialize new with empty
NewArray(x, y, z).origx = x
NewArray(x, y, z).origy = y
NewArray(x, y, z).origz = z
NewArray(x, y, z).Typ = c_iTile_Empty
NewArray(x, y, z).Color1 = cEmpty
' -----------------------------------------------------------------------------
' angle is reversed
angle = 360 - angle1
' Shearing each element 3 times in one shot
nangle = angle
' this pre-processing portion basically rotates by 90 to get
' between -45 and 45 degrees, where the 3-shear routine works correctly...
nangle = angle - 90
nangle = angle - 180
nangle = angle - 180
nangle = angle - 270
nangle = nangle + 360
nangle = nangle - 360
rotr = nangle * DtoR
shear1
= Tan(rotr
/ 2) ' correct way
' *** NOTE: this had a bug where the values 135, 224, and 314
' *** all resolve to -45 degrees.
' *** Fixed by changing < to <=
'if angle > 45 and angle < 134 then
flipper = 1
flipper = 2
' *** NOTE: this had a bug where this flipper was wrong
' Fixed by adding case 7
'flipper = 3
flipper = 7
flipper = 0
' -----------------------------------------------------------------------------
' find midpoints
' -----------------------------------------------------------------------------
' determine polar coordinates
' since our arrays use positive coordinates
' e.g. convert 1 To 15 to -7 To 7
iDiffPolarX = 0 - iMidX
iPolarMinX
= LBound(OldArray
, 1) + iDiffPolarX
iPolarMaxX
= UBound(OldArray
, 1) + iDiffPolarX
iPolarMidX = 0
iDiffPolarY = 0 - iMidY
iPolarMinY
= LBound(OldArray
, 2) + iDiffPolarY
iPolarMaxY
= UBound(OldArray
, 2) + iDiffPolarY
iPolarMidY = 0
iDiffPolarZ = 0 - iMidZ
iPolarMinZ
= LBound(OldArray
, 3) + iDiffPolarZ
iPolarMaxZ
= UBound(OldArray
, 3) + iDiffPolarZ
iPolarMidZ = 0
' -----------------------------------------------------------------------------
' THIS PART DEPENDS ON WHICH AXIS WE'RE ROTATING ON
' X, Y
' Here is where it needs some optimizing possibly... kinda slow...
For z
= iPolarMinZ
To iPolarMaxZ
'For y = LBound(NewArray, 2) To UBound(NewArray, 2)
For y
= iPolarMinY
To iPolarMaxY
'For x = LBound(NewArray, 1) To UBound(NewArray, 1)
For x
= iPolarMinX
To iPolarMaxX
' find which part of screen the current point is in
' bottom half of screen
' right half of screen
iScreenZone = 2
' left half of screen
iScreenZone = 3
' top half of screen
' right half of screen
iScreenZone = 1
' left half of screen
iScreenZone = 4
' calculate directions
nx = -y
ny = x
nx = -x
ny = -y
nx = -y
ny = -x
nx = -x
ny = y
nx = x
ny = -y
nx = y
ny = x
nx = y
ny = -x
nx = x
ny = y
clr.Typ = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Typ
clr.Color1 = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Color1
clr.Alpha1 = OldArray(nx - iDiffPolarX, ny - iDiffPolarY, z - iDiffPolarZ).Alpha1
y1 = y * shear1
xy1 = x + y1
fy = (y - xy1 * shear2)
fx = xy1 + fy * shear1
If fx
>= iPolarMinX
And fx
<= iPolarMaxX
Then If fy
>= iPolarMinY
And fy
<= iPolarMaxY
Then ' only draw here if this spot is empty
if NewArray
(fx
- iDiffPolarX
, fy
- iDiffPolarY
, z
- iDiffPolarZ
).Typ
= c_iTile_Empty
then NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Typ = clr.Typ
NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Color1 = clr.Color1
NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).Alpha1 = clr.Alpha1
NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origx = fx
NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origy = fy
NewArray(fx - iDiffPolarX, fy - iDiffPolarY, z - iDiffPolarZ).origz = z ' added for 3D
' don't draw, but save it to a list to handle later
arrLost
(UBound(arrLost
)).Typ
= clr.Typ
arrLost
(UBound(arrLost
)).Color1
= clr.Color1
arrLost
(UBound(arrLost
)).Alpha1
= clr.Alpha1
arrLost
(UBound(arrLost
)).origx
= fx
arrLost
(UBound(arrLost
)).origy
= fy
arrLost
(UBound(arrLost
)).origz
= z
' added for 3D
' preserve which zone screen is in, 1 = top right, 2 = bottom right, 3 = bottom left, 4 = top left
arrLost
(UBound(arrLost
)).zone
= iScreenZone
' try to place any points that would have overwritten to a spot nearby
' can nearby be determined by the direction of rotation (iDirection)
' together with which quarter of the screen the point is in (iScreenZone)
' where we divide the screen up into 4 zones:
' --------------------------------------
'| | |
'| zone 4 | zone 1 |
'| | |
'|--------------------------------------|
'| | |
'| zone 3 | zone 2 |
'| | |
'| | |
' --------------------------------------
' in zone rotation direction search direction (y,x)
' ------- ------------------ ----------------------
' 1 clockwise down + right
' 1 counter-clockwise up + left
' 2 clockwise down + left
' 2 counter-clockwise up + right
' 3 clockwise up + left
' 3 counter-clockwise down + right
' 4 clockwise up + right
' 4 counter-clockwise down + left
if IsProblemAngle%
(angle1
) then iMissing = 0
bFound = FindEmptyShearRotationPoint4%(arrLost(iLoop), iDirection, x - iDiffPolarX, y - iDiffPolarY, z - iDiffPolarZ, NewArray())
'If m_bDebug = TRUE Then
' _echo "Plotted missing point " + chr$(34) + chr$(arrLost(iLoop).Typ) + chr$(34) + " to (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
'End If
iMissing = iMissing + 1
'If m_bDebug = TRUE Then
' _echo "Detected missing point " + chr$(34) + chr$(arrLost(iLoop).Typ) + chr$(34) + " at (x=" + cstr$(x) + ", y=" + cstr$(y) + ")"
'End If
' Y, Z
' (UNDER CONSTRUCTION)
' X, Z
' (UNDER CONSTRUCTION)
' DO NOTHING
' /////////////////////////////////////////////////////////////////////////////
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
bResult = TRUE
IsProblemAngle% = bResult
' /////////////////////////////////////////////////////////////////////////////
' Looks for a new point
' a little more accurately, using iDirection parameter
' which can be cClockwise or cCounterClockwise.
' Note: cClockwise and cCounterClockwise constants must be declared globally.
' Receives
' FindMe (RotationType) = contains
' .origx, .origy, .origz = the starting location to start looking from,
' .zone = which area of the screen the point is in
' (1=top right, 2=bottom right, 3=bottom left, 4=top left)
' to determine direction to look in
' .Typ = the value to write
' iDirection (Integer) = direction of rotation, can be cClockwise or cCounterClockwise (constants must be declared globally)
' destX (Integer) = if an empty spot is found, returns the x location here byref
' destY (Integer) = if an empty spot is found, returns the y location here byref
' destZ (Integer) = if an empty spot is found, returns the z location here byref
' NewArray() (RotationType array (x,y,127) ) = array representing the screen to search in and plot to
' Returns
' FALSE if no empty spot was found
' TRUE if an empty spot was found, and x,y,z location returned byref in destX,destY,destZ parameters
'bFound= FindEmptyShearRotationPoint4%(arrLost(iLoop) , iDirection , x - iDiffPolarX , y - iDiffPolarY , z - iDiffPolarZ, NewArray() )
' Initialize
destX = 0
destY = 0
destZ = 0 ' added for 3D
bContinue = TRUE
' Choose search direction based on the quadrant of the screen
' and the direction of rotation:
' iScreenZone iDirection search direction (y,x)
' ----------- ------------------ ----------------------
' 1 cClockwise down + right ( 1, 1)
' 1 cCounterClockwise up + left (-1,-1)
' 2 cClockwise down + left ( 1,-1)
' 2 cCounterClockwise up + right (-1, 1)
' 3 cClockwise up + left (-1,-1)
' 3 cCounterClockwise down + right ( 1, 1)
' 4 cClockwise up + right (-1, 1)
' 4 cCounterClockwise down + left ( 1,-1)
If FindMe.zone
= 1 And iDirection
= cClockwise
Then dirY = 1
dirX = 1
dirY = -1
dirX = -1
dirY = 1
dirX = -1
dirY = -1
dirX = 1
dirY = -1
dirX = -1
dirY = 1
dirX = 1
dirY = -1
dirX = 1
dirY = 1
dirX = -1
bContinue = FALSE
' Quit if we're out of bounds
bContinue = FALSE
x = FindMe.origx
y = FindMe.origy
z = FindMe.origz
bContinue = TRUE
' look along y axis for an available adjacent point
destX = x
destY = y + dirY
destZ = z
if NewArray
(destX
, destY
, destZ
).Typ
= c_iTile_Empty
then NewArray(destX, destY, destZ).Typ = FindMe.Typ
NewArray(destX, destY, destZ).Color1 = FindMe.Color1
NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
bResult = TRUE
bContinue = FALSE
' look along x axis for an available adjacent point
destX = x + dirX
destY = y
destZ = z
if NewArray
(x
+ dirX
, y
, destZ
).Typ
= c_iTile_Empty
then NewArray(destX, destY, destZ).Typ = FindMe.Typ
NewArray(destX, destY, destZ).Color1 = FindMe.Color1
NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
bResult = TRUE
bContinue = FALSE
' look diagonally for an available adjacent point
destX = x + dirX
destY = y + dirY
destZ = z
if NewArray
(x
+ dirX
, y
+ dirY
, destZ
).Typ
= c_iTile_Empty
then NewArray(destX, destY, destZ).Typ = FindMe.Typ
NewArray(destX, destY, destZ).Color1 = FindMe.Color1
NewArray(destX, destY, destZ).Alpha1 = FindMe.Alpha1
bResult = TRUE
bContinue = FALSE
' Return result
FindEmptyShearRotationPoint4% = bResult
End Sub ' FindEmptyShearRotationPoint4%
' /////////////////////////////////////////////////////////////////////////////
' Lets you draw a scene in 2.5D and save it to a file. Woo hoo!
' Version 1 only supports 2 tile types:
' c_iTile_Empty
' c_iTile_Wall
Dim RoutineName
As String: RoutineName
= "IsometricDraw1" Dim iTotal%
' compute total available spaces Dim iCount%
' count # of spaces searched
Dim bIgnoreTerrain
As Integer ' If TRUE, player can move through walls, etc. Dim MapTileTempUndo
As MapUndoType
'Dim sngDR As Single
'Dim sngLevelSize As Single
Dim iSnow
As Integer ' used to control how frequently a snowflake is spawned
ReDim arrSnow
(100) As SnowflakeType
Dim arrLights
(100) As SnowflakeType
Dim oStar
As SnowflakeType
' ' USED FOR FIRST PERSON VIEW
' Dim iDistance As Integer
' Dim arrFPBrickSize(0 to 7) as Integer
'USED FOR ANIMATIONS
'm_arrRender0
'yoda
' =============================================================================
' GET OPTIONS
m_iPlayerCount = 1
'm_iPlayerCount = PromptForIntegerInRange%("How many players ({min}-{max} or blank to quit)?", 1, 4, 0)
'IF m_iPlayerCount = 0 THEN Goto CleanupAndExit
bEnableRepeatingKeys = FALSE
' INITIALIZE OTHER SHARED VARIABLES
'TODO: store color sequences in a linked list or dictionary
'GetGreenTreeColors m_arrGreenTreeColors
' =============================================================================
' INITIALIZE GRAPHIC SCREEN
'Screen _NewImage(1024, 720, 32) : _ScreenMove _Middle
' ' -----------------------------------------------------------------------------
' ' INITIALIZE FIRST PERSON VIEW VARIABLES
' iWidth = 16
' for iDistance = 0 to 7
' arrFPBrickSize(iDistance) = iWidth
' iWidth = iWidth - 1
' next iDistance
'
' arrFP_From(0) = -3
' arrFP_From(1) = -3
' arrFP_From(2) = -3
' arrFP_From(3) = -3
' arrFP_From(4) = -4
' arrFP_From(5) = -4
' arrFP_From(6) = -5
' arrFP_From(7) = -6
'
' arrFP_To(0) = 4
' arrFP_To(1) = 4
' arrFP_To(2) = 4
' arrFP_To(3) = 4
' arrFP_To(4) = 5
' arrFP_To(5) = 5
' arrFP_To(6) = 6
' arrFP_To(7) = 7
' -----------------------------------------------------------------------------
' BEGIN PLAYER 1 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' WINDOW PLACEMENT
m_arrSplitScreen(1).GridOffsetX = 50
m_arrSplitScreen(1).GridOffsetY = 50
m_arrSplitScreen(1).GridOffsetZ = 0
m_arrSplitScreen(1).ScreenOffsetX = 450
m_arrSplitScreen(1).ScreenOffsetY = 200
m_arrSplitScreen(1).ScreenOffsetZ = 0
' MINIMAP PLACEMENT
m_arrSplitScreen(1).MiniMapFirstPersonX = m_iMiniMapStartCol + (0 * m_iMiniMapSize)
m_arrSplitScreen(1).MiniMapFirstPersonY = m_iMiniMapStartRow
m_arrSplitScreen(1).MiniMapTopDownX = m_iMiniMapStartCol + (1 * m_iMiniMapSize)
m_arrSplitScreen(1).MiniMapTopDownY = m_iMiniMapStartRow
m_arrSplitScreen(1).MiniMapFrontBackX = m_iMiniMapStartCol + (2 * m_iMiniMapSize)
m_arrSplitScreen(1).MiniMapFrontBackY = m_iMiniMapStartRow
m_arrSplitScreen(1).MiniMapRightLeftX = m_iMiniMapStartCol + (3 * m_iMiniMapSize)
m_arrSplitScreen(1).MiniMapRightLeftY = m_iMiniMapStartRow
' MINIMAP TEXT PLACEMENT
m_arrSplitScreen(1).MiniMapFirstPersonTextX = m_iMiniMapTextStartCol + (0 * m_iMiniMapTextSize)
m_arrSplitScreen(1).MiniMapFirstPersonTextY = m_iMiniMapTextStartRow
m_arrSplitScreen(1).MiniMapTopDownTextX = m_iMiniMapTextStartCol + (1 * m_iMiniMapTextSize)
m_arrSplitScreen(1).MiniMapTopDownTextY = m_iMiniMapTextStartRow
m_arrSplitScreen(1).MiniMapFrontBackTextX = m_iMiniMapTextStartCol + (2 * m_iMiniMapTextSize)
m_arrSplitScreen(1).MiniMapFrontBackTextY = m_iMiniMapTextStartRow
m_arrSplitScreen(1).MiniMapRightLeftTextX = m_iMiniMapTextStartCol + (3 * m_iMiniMapTextSize)
m_arrSplitScreen(1).MiniMapRightLeftTextY = m_iMiniMapTextStartRow
' -----------------------------------------------------------------------------
' END PLAYER 1 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN PLAYER 2 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' WINDOW PLACEMENT
m_arrSplitScreen(2).GridOffsetX = 50
m_arrSplitScreen(2).GridOffsetY = 50
m_arrSplitScreen(2).GridOffsetZ = 0
m_arrSplitScreen(2).ScreenOffsetX = 1000
m_arrSplitScreen(2).ScreenOffsetY = 200
m_arrSplitScreen(2).ScreenOffsetZ = 0
'TODO: add minimap parameters for player 2
' -----------------------------------------------------------------------------
' END PLAYER 2 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN PLAYER 3 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' WINDOW PLACEMENT
m_arrSplitScreen(3).GridOffsetX = 50
m_arrSplitScreen(3).GridOffsetY = 50
m_arrSplitScreen(3).GridOffsetZ = 0
m_arrSplitScreen(3).ScreenOffsetX = 450
m_arrSplitScreen(3).ScreenOffsetY = 700
m_arrSplitScreen(3).ScreenOffsetZ = 0
'TODO: add minimap parameters for player 3
' -----------------------------------------------------------------------------
' END PLAYER 3 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN PLAYER 4 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' WINDOW PLACEMENT
m_arrSplitScreen(4).GridOffsetX = 50
m_arrSplitScreen(4).GridOffsetY = 50
m_arrSplitScreen(4).GridOffsetZ = 0
m_arrSplitScreen(4).ScreenOffsetX = 1000
m_arrSplitScreen(4).ScreenOffsetY = 700
m_arrSplitScreen(4).ScreenOffsetZ = 0
'TODO: add minimap parameters for player 4
' -----------------------------------------------------------------------------
' END PLAYER 4 SCREEN PLACEMENT
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' INITIALIZE MAP TO EMPTY
ClearIsometricMap
ReDim m_arrRecord
(-1) As RecordType
' -----------------------------------------------------------------------------
' INITIALIZE COLOR ARRAY
m_arrColors(0) = cEmpty
m_arrColors(1) = cBlack
m_arrColors(2) = cDarkGray
m_arrColors(3) = cDimGray
m_arrColors(4) = cGray
m_arrColors(5) = cLightGray
m_arrColors(6) = cSilver
m_arrColors(7) = cWhite
m_arrColors(8) = cRed
m_arrColors(9) = cOrangeRed
m_arrColors(10) = cDarkOrange
m_arrColors(11) = cOrange
m_arrColors(12) = cGold
m_arrColors(13) = cYellow
m_arrColors(14) = cOliveDrab1
m_arrColors(15) = cLime
m_arrColors(16) = cMediumSpringGreen
m_arrColors(17) = cCyan
m_arrColors(18) = cDeepSkyBlue
m_arrColors(19) = cDodgerBlue
m_arrColors(20) = cSeaBlue
m_arrColors(21) = cBlue
m_arrColors(22) = cBluePurple
m_arrColors(23) = cDeepPurple
m_arrColors(24) = cPurple
m_arrColors(25) = cPurpleRed
' -----------------------------------------------------------------------------
' INITIALIZE OTHER VARIABLES
bIgnoreTerrain = TRUE
' -----------------------------------------------------------------------------
' BEGIN DRAW GROUND
' -----------------------------------------------------------------------------
For iLoopZ%
= m_iMapMinZ
To m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
'PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cLightBrown
PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhiteSmoke
' -----------------------------------------------------------------------------
' END DRAW GROUND
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW TILE FLOOR
' -----------------------------------------------------------------------------
For iLoopZ%
= m_iMapMinZ
To m_iMapMinZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' ALTERNATE TILE COLORS
If IsEven%
(iLoopX%
) = TRUE
Then If IsEven%
(iLoopY%
) = TRUE
Then PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
If IsEven%
(iLoopY%
) = TRUE
Then PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cWhite
PlotTile iLoopX%, iLoopY%, iLoopZ%, c_iTile_Wall, cGray
' -----------------------------------------------------------------------------
' END DRAW TILE FLOOR
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW A TALL HOLLOW PYRAMID
' -----------------------------------------------------------------------------
iX% = 5
iY% = 10
iZ% = 1
iLevelSize% = 4
iPosX1% = iX%
iPosX2% = iX% + 7
iPosY1% = iY%
iPosY2% = iY% + 7
iNextColor~& = cRed
iColorScheme% = 1 ' 1 = Rainbow6 #1, 9 = Rainbow6 #2, etc.
'iNextColor~& = cWhite
'iColorScheme% = 3 ' 3, 11 = grayscale, ascending
iLevelCount% = 0
bContinue = TRUE
' Draw front/back walls
For iLoopX%
= iPosX1%
To iPosX2%
iLoopY% = iPosY1%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
iLoopY% = iPosY2%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
' Draw left/right walls
For iLoopY%
= iPosY1%
To iPosY2%
iLoopX% = iPosX1%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
iLoopX% = iPosX2%
PlotTile iLoopX%, iLoopY%, iZ%, c_iTile_Wall, iNextColor~&
' Add a door to middle of right wall
iX% = iPosX1% + ((iPosX2% - iPosX1%) \ 2)
PlotTile iX%, iPosY2%, iZ%, c_iTile_Empty, iNextColor~&
' Add a door to middle of front wall
iY% = iPosY1% + ((iPosY2% - iPosY1%) \ 2)
PlotTile iPosX2%, iY%, iZ%, c_iTile_Empty, iNextColor~&
' MOVE UP A LEVEL
iLevelCount% = iLevelCount% + 1
If iLevelCount%
> iLevelSize%
Then iLevelCount% = 0
iPosX1% = iPosX1% + 1
iPosX2% = iPosX2% - 1
iPosY1% = iPosY1% + 1
iPosY2% = iPosY2% - 1
' QUIT AFTER WE REACH THE TOP
If (iPosX1%
<= iPosX2%
) And (iPosY1%
<= iPosY2%
) Then iZ% = iZ% + 1
DoCycleColor iColorScheme%, iNextColor~&
bContinue = FALSE
bContinue = FALSE
' -----------------------------------------------------------------------------
' END DRAW A TALL HOLLOW PYRAMID
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW A CUBOID
' -----------------------------------------------------------------------------
'PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
PlotCuboid 1, 5, 2, 4, 2, 3, c_iTile_Wall, cHotPink
' -----------------------------------------------------------------------------
' END DRAW A CUBOID
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW SOME CIRCLES
' -----------------------------------------------------------------------------
' PlotCircle iAxis, startX, startY, startZ, radius, iTile, iColor
PlotCircle cPlaneXY, 15, 15, 2, 7, c_iTile_Wall, cRed
PlotCircle cPlaneYZ, 19, 20, 10, 6, c_iTile_Wall, cLime
PlotCircle cPlaneZX, 23, 25, 20, 8, c_iTile_Wall, cBlue
' -----------------------------------------------------------------------------
' END DRAW SOME CIRCLES
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN TEST SOME COLORS
' -----------------------------------------------------------------------------
GetGreenTreeColors arrColors()
iX% = 2
iY% = 2
iZ% = 2
iWidth = 2
iLength = 2
iHeight = 8
iMyColor~& = arrColors(iLoop1)
iY% = iY% + 2
if (iY%
> (m_iMapMaxY
- 2) ) then iY% = 2
iX% = iX% + 6
if (iX%
> (m_iMapMaxX
- 6) ) then iX% = 6
iZ% = iZ% + 8
if (iZ%
> (m_iMapMaxZ
- 8) ) then 'PlotCuboid startX, widthX, startY, lengthY, startZ, heightZ, iTile, iColor
PlotCuboid iX%, iWidth, iY%, iLength, iZ%, iHeight, c_iTile_Wall, iMyColor~&
' -----------------------------------------------------------------------------
' END TEST SOME COLORS
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW TREE
' -----------------------------------------------------------------------------
' x/y location of tree
iX% = 31
iY% = 31
' star is same as tree
oStar.x = iX%
oStar.y = iY%
' DRAW TRUNK
iRadius = 2
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
CircleFill cPlaneXY, iX%, iY%, iZ%, iRadius, c_iTile_Wall, cLightBrown
' DRAW THE TREE
iBaseZ% = 4 ' initial z location
iBaseRadius = 20 ' initial radius size
iLevelSize% = 6 ' how many blocks high each level is
iDR = 3 ' how fast radius decreases with each level
'iDL = 1
'sngDR = 0.5
'sngLevelSize = 7
'iHalfZ% = iBaseRadius / 2
iColorScheme% = 20
iNextColor~& = cGreen
bFinished = FALSE
' GET NEXT COLOR
DoCycleColor iColorScheme%, iNextColor~&
' GET CURVE
'GetSemicircle R, Q, arrSemicircle()
GetSemicircle iBaseRadius, 3, arrSemicircle()
iDrawY% = 0
iDrawX% = 0
if arrSemiCircle
(iLoopX%
, iLoopY%
) = 0 then iDrawX% = iDrawX% + 1
iDrawY% = iDrawY% + 1
arrDistance(iDrawY%) = iDrawX%
' NEXT PLOT A CONE IN THE CROSS SHAPE OF THE CURVE
'iHalfZ% = ubound(arrDistance) / 2
iRadius = arrDistance(iLoopZ%)
iZ% = iBaseZ% + iLoopZ%
bFinished = TRUE
' remember the highest point
oStar.z = iZ%
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
CircleFill cPlaneXY, iX%, iY%, iZ%, iRadius, c_iTile_Wall, iNextColor~&
' GET NEXT HEIGHT
iBaseZ% = iBaseZ% + iLevelSize%
iBaseRadius = iBaseRadius - iDR
if iBaseRadius
< 5 then bFinished
= TRUE
' GET NEXT LEVEL SIZE
'sngLevelSize = sngLevelSize - sngDR
'iLevelSize% = sngLevelSize
'iLevelSize% = iLevelSize% - iDL
' QUIT?
' -----------------------------------------------------------------------------
' END DRAW TREE
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW A TREE v1
' -----------------------------------------------------------------------------
iNextColor~& = cGreen
iColorScheme% = 20
iX% = 31
iY% = 31
'iZ% = 1
iPosZ1% = 1
iBaseRadius = 15
iLevelSize% = 3
bFinished = FALSE
iRadius = iBaseRadius
iLevelCount% = 0
iCount% = 0
iZ% = iPosZ1%
iDR = 1
iDDR = iRadius / 3
iZ% = iZ% + 1
bFinished = TRUE
DoCycleColor iColorScheme%, iNextColor~&
iLevelCount% = iLevelCount% + 1
if iLevelCount%
>= iLevelSize%
then iLevelCount% = 0
iRadius = iRadius - iDR
'PlotCircle cPlaneXY, iX%, iY%, iZ%, iRadius, c_iTile_Wall, iNextColor~&
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
CircleFill cPlaneXY, iX%, iY%, iZ%, iRadius, c_iTile_Wall, iNextColor~&
iCount% = iCount% + 1
if iCount%
<= iLevelSize%
then PlotTile iX%, iY%, iZ%, c_iTile_Wall, iNextColor~&
iDR = iDR + iDDR
iDDR = iDDR - 1
iPosZ1% = iPosZ1% + ( (iZ% - iPosZ1%) \ 2 )
iBaseRadius = iBaseRadius - 1
if iBaseRadius
< 2 then bFinished
= TRUE
' -----------------------------------------------------------------------------
' END DRAW A TREE v1
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW FRAME AROUND ENTIRE SPACE (TOP)
' -----------------------------------------------------------------------------
For iLoopX%
= m_iMapMinX
+ 3 To m_iMapMaxX
- 3 PlotTile iLoopX%, m_iMapMaxY - 3, m_iMapMaxZ, c_iTile_Wall, cPurple
PlotTile iLoopX%, m_iMapMinY + 3, m_iMapMaxZ, c_iTile_Wall, cCyan
For iLoopY%
= m_iMapMinY
+ 3 To m_iMapMaxY
- 3 PlotTile m_iMapMinX + 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cOrange
PlotTile m_iMapMaxX - 3, iLoopY%, m_iMapMaxZ, c_iTile_Wall, cLime
' -----------------------------------------------------------------------------
' END DRAW FRAME AROUND ENTIRE SPACE (TOP)
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
' -----------------------------------------------------------------------------
For iLoopX%
= m_iMapMinX
+ 2 To m_iMapMaxX
- 2 PlotTile iLoopX%, m_iMapMaxY - 2, m_iMapMidZ, c_iTile_Wall, cDodgerBlue
PlotTile iLoopX%, m_iMapMinY + 2, m_iMapMidZ, c_iTile_Wall, cDeepPurple
For iLoopY%
= m_iMapMinY
+ 2 To m_iMapMaxY
- 2 PlotTile m_iMapMinX + 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cDarkRed
PlotTile m_iMapMaxX - 2, iLoopY%, m_iMapMidZ, c_iTile_Wall, cGold
' -----------------------------------------------------------------------------
' END DRAW FRAME AROUND ENTIRE SPACE (MIDDLE)
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
' -----------------------------------------------------------------------------
For iLoopX%
= m_iMapMinX
+ 1 To m_iMapMaxX
- 1 PlotTile iLoopX%, m_iMapMaxY - 1, m_iMapMinZ + 1, c_iTile_Wall, cSeaBlue
PlotTile iLoopX%, m_iMapMinY + 1, m_iMapMinZ + 1, c_iTile_Wall, cChartreuse
For iLoopY%
= m_iMapMinY
+ 1 To m_iMapMaxY
- 1 PlotTile m_iMapMinX + 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, cOrangeRed
PlotTile m_iMapMaxX - 1, iLoopY%, m_iMapMinZ + 1, c_iTile_Wall, cDeepSkyBlue
' -----------------------------------------------------------------------------
' END DRAW FRAME AROUND ENTIRE SPACE (BOTTOM)
' -----------------------------------------------------------------------------
' =============================================================================
' PLACE PLAYER(S) <- ONLY ONE FOR THIS DEMO
For iPlayerLoop
= 1 To m_iPlayerCount
' -----------------------------------------------------------------------------
' BEGIN Map the 6 directional keys
' -----------------------------------------------------------------------------
'*** CURRENTLY THIS IS NOT USED ***
'TODO: GET THIS WORKING (CURRENTLY IT'S ALL WEIRD)
'TODO: WHATEVER THE KEYS MAPPED ARE, SWAP THEM NON-HARDCODED
' differently for each of the 6 directional orientations!
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyBack = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyForward = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyUp = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Down).KeyDown = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyBack = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyForward = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyUp = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Up).KeyDown = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyBack = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyForward = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyLeft = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyRight = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Left).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyBack = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyForward = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyLeft = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyRight = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Right).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyBack = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyForward = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyLeft = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyRight = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Back).KeyDown = c_iKeyDown_PgDn
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyBack = c_iKeyDown_Up
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyForward = c_iKeyDown_Down
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyLeft = c_iKeyDown_Left
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyRight = c_iKeyDown_Right
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyUp = c_iKeyDown_PgUp
m_arrDirKeyMap(iPlayerLoop, c_iDir_Forward).KeyDown = c_iKeyDown_PgDn
' -----------------------------------------------------------------------------
' END Map the 6 directional keys
' -----------------------------------------------------------------------------
' FIND START POSITION
iX% = RandomNumber(m_iMapMinX, m_iMapMaxX)
iY% = RandomNumber(m_iMapMinY, m_iMapMaxY)
iZ% = 1 ' RandomNumber(m_iMapMinZ, m_iMapMaxZ)
' MAKE SURE IT'S EMPTY
If m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iTile_Empty
Then bFound = TRUE
' IF NOT EMPTY THEN TRY TO FIND AN EMPTY SPOT
iTotal% = ((m_iMapMaxX - m_iMapMinX) + 1) * ((m_iMapMaxY - m_iMapMinY) + 1) * ((m_iMapMaxZ - m_iMapMinZ) + 1)
iCount% = 0
bFound = FALSE
iX% = iX% + 1
' reset x and move to next y
iX% = m_iMapMinX
iY% = iY% + 1
' reset y and move to next z
iY% = m_iMapMinY
iZ% = iZ% + 1
' RESET Z AND SEE IF WE HAVE CHECKED EVERYTHING
iZ% = m_iMapMinZ
iCount% = iCount% + 1
' NONE FOUND, EXIT
iCount% = iCount% + 1
iCount% = iCount% + 1
iCount% = iCount% + 1
If m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iTile_Empty
Then ' FOUND AN EMPTY SPACE, EXIT
bFound = TRUE
' PICK A DIRECTION (SIMPLE FOR NOW, LEFT OR RIGHT)
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
m_arrPlayer(iPlayerLoop).Tile1 = c_iTile_Player1
' SAVE COORDINATES TO PLAYER
' ****************************************************************************************************************************************************************
' for this demo we'll just use iX% instead of m_arrPlayer(iPlayerLoop).x, etc.
' to make it more readable
' ****************************************************************************************************************************************************************
m_arrPlayer(iPlayerLoop).x = iX%
m_arrPlayer(iPlayerLoop).y = iY%
m_arrPlayer(iPlayerLoop).z = iZ%
m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Forward
m_arrPlayer(iPlayerLoop).Color1 = cRed
m_arrPlayer(iPlayerLoop).Alpha1 = 255
m_arrPlayer(iPlayerLoop).AlphaOverride = 255
m_arrPlayer(iPlayerLoop).ColorScheme1 = 2
m_arrPlayer(iPlayerLoop).ColorSchemeSpeed1 = 5 ' change color every 5 frames
m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
' DISPLAY OPTIONS
m_arrPlayer(iPlayerLoop).GridSize = 4
m_arrPlayer(iPlayerLoop).MapSize = 2
' RESET MOVEMENT VARIABLES
m_arrPlayer(iPlayerLoop).IsMoving = FALSE
m_arrPlayer(iPlayerLoop).IsMoved = FALSE
' ********************************************************************************
' *** THIS IS NOW DONE AT THE RENDERING LEVEL FOR PLAYERS AND NON-TERRAIN OBJECTS
' ********************************************************************************
'' DRAW PLAYER
'm_arrMap(iX%, iY%, iZ%).Typ = m_arrPlayer(iPlayerLoop).Tile1
'm_arrMap(iX%, iY%, iZ%).Color1 = m_arrPlayer(iPlayerLoop).Color1
'm_arrMap(iX%, iY%, iZ%).AlphaOverride = m_arrPlayer(iPlayerLoop).Alpha1
sError = "Could not find an empty space to start player."
' =============================================================================
' OTHER SETUP
' RESET INPUT
iLastKey = c_iKeyDown_Enter
' INIT UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' =============================================================================
' BEGIN ANIMATION LOOP #1
' =============================================================================
' show text message
in$ = "Happy New Year 2022!"
iMyColor~& = cYellow
DoCycleColor 1, iMyColor~&
LOCATE 10, 18 + iLoop1
' <-- not sure why it starts to be truncated after column 20!
' reset snowflakes
arrSnow(iCount%).IsEnabled = FALSE
arrSnow(iCount%).xCount = 0
arrSnow(iCount%).xMax = 5
arrSnow(iCount%).yCount = 0
arrSnow(iCount%).yMax = 5
arrSnow(iCount%).zCount = 0
arrSnow(iCount%).zMax = 5
iSnow = 50
' set up star
oStar.Color1 = cYellow
oStar.Color2 = cGold
oStar.Color3 = cYellow
' these values control the star size
oStar.xCount = 0
oStar.xMax = 4
oStar.yCount = 0
oStar.yMax = 3
oStar.zCount = 0
oStar.zMax = 4
' set up rotation
iIncrementAngle = 1 ' angle to increase/decrease when rotating, set to 0 to disable rotation
iRotationMax = 5 ' rotates every # of frames
iRotationCount = 0 '
iAngleXY = 0
' Animate until user presses <ESC>
' MOVE EXISTING SNOWFLAKES
' IS THIS SNOWFLAKE ACTIVE?
if arrSnow
(iCount%
).IsEnabled
= TRUE
then
' maybe move along x axis
arrSnow(iCount%).xCount = arrSnow(iCount%).xCount + 1
if arrSnow
(iCount%
).xCount
> arrSnow
(iCount%
).xMax
then arrSnow(iCount%).xCount = arrSnow(iCount%).xMax
' maybe move
iNewX% = RandomNumber% (1, 255)
arrSnow(iCount%).xMax = 0
arrSnow(iCount%).x = arrSnow(iCount%).x - 1
if arrSnow
(iCount%
).x
< m_iMapMinX
then arrSnow(iCount%).x = m_iMapMaxX
arrSnow(iCount%).x = arrSnow(iCount%).x + 1
if arrSnow
(iCount%
).x
> m_iMapMaxX
then arrSnow(iCount%).x = m_iMapMinX
' maybe move along y axis
arrSnow(iCount%).yCount = arrSnow(iCount%).yCount + 1
if arrSnow
(iCount%
).yCount
> arrSnow
(iCount%
).yMax
then arrSnow(iCount%).yCount = arrSnow(iCount%).yMax
' maybe move
iNewY% = RandomNumber% (1, 255)
arrSnow(iCount%).yMax = 0
arrSnow(iCount%).y = arrSnow(iCount%).y - 1
if arrSnow
(iCount%
).y
< m_iMapMinY
then arrSnow(iCount%).y = m_iMapMaxY
arrSnow(iCount%).y = arrSnow(iCount%).y + 1
if arrSnow
(iCount%
).y
> m_iMapMaxY
then arrSnow(iCount%).y = m_iMapMinY
' fall to earth
arrSnow(iCount%).zCount = arrSnow(iCount%).zCount + 1
if arrSnow
(iCount%
).zCount
> arrSnow
(iCount%
).zMax
then arrSnow(iCount%).zMax = 0
arrSnow(iCount%).z = arrSnow(iCount%).z - 1
' has snowflake hit bottom or landed on something?
if arrSnow
(iCount%
).z
= m_iMapMinZ
+ 1 or m_arrMap
(arrSnow
(iCount%
).x
, arrSnow
(iCount%
).y
, arrSnow
(iCount%
).z
- 1).Typ
= c_iTile_Wall
then ' stop moving, copy to the world
arrSnow(iCount%).IsEnabled = FALSE
m_arrMap(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Typ = arrSnow(iCount%).Tile1
m_arrMap(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Color1 = arrSnow(iCount%).Color1
m_arrMap(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Alpha1 = arrSnow(iCount%).Alpha1
' CYCLE STAR COLOR
'DoCycleColor 1, oStar.Color1
if oStar.Color1
= cYellow
then oStar.Color1 = cGold
oStar.Color1 = cYellow
if oStar.Color2
= cYellow
then oStar.Color2 = cGold
oStar.Color2 = cYellow
if oStar.Color3
= cYellow
then oStar.Color3 = cGold
oStar.Color3 = cYellow
oStar.xCount = oStar.xCount + 1
if oStar.xCount
> oStar.xMax
then oStar.xCount
= 1 oStar.yCount = oStar.yCount + 1
if oStar.yCount
> oStar.yMax
then oStar.yCount
= 1 oStar.zCount = oStar.zCount + 1
if oStar.zCount
> oStar.zMax
then oStar.zCount
= 1
' CYCLE LIGHTS COLOR
' (UNDER CONSTRUCTION)
'For iCount% = lbound(arrLights) to ubound(arrLights)
' ' IS THIS LIGHT ACTIVE?
' if arrLights(iCount%).IsEnabled = TRUE then
' end if
'Next iCount%
' CLEAR SCREEN
' xMin = 310, yMin = -9
' xMax = 1090, yMax = 765
'DrawRect (iX%, iY%, iSizeW%, iSizeH%, iColor~&)
DrawRect 310, 0, 780, 765, cBlack
'galaxie
' DRAW SPLIT SCREEN (MAIN VIEW)
'DrawSnowScreen iAngleXY, iScreenOffsetX, iScreenOffsetY, iGridSize, arrSnow() As SnowflakeType
DrawSnowScreen iAngleXY, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, arrSnow(), arrLights(), oStar
' BIRTH A SNOWFLAKE?
iValue = RandomNumber% (1, 255)
if arrSnow
(iCount%
).IsEnabled
= FALSE
then arrSnow(iCount%).IsEnabled = TRUE
arrSnow(iCount%).x = RandomNumber%(m_iMapMinX, m_iMapMaxX)
arrSnow(iCount%).y = RandomNumber%(m_iMapMinY, m_iMapMaxY)
arrSnow(iCount%).z = m_iMapMaxZ
arrSnow(iCount%).Tile1 = c_iTile_Wall
arrSnow(iCount%).Color1 = cWhite
arrSnow(iCount%).Alpha1 = 255 ' RandomNumber%(190, 255)
arrSnow(iCount%).xCount = 0 ' snowflake x waver counter
arrSnow(iCount%).xMax = 20 ' snowflake can waver along x axis every n steps
arrSnow(iCount%).yCount = 0 ' snowflake y waver counter
arrSnow(iCount%).yMax = 20 ' snowflake can waver along y axis every n steps
arrSnow(iCount%).zCount = 10 ' snowflake descent counter
arrSnow(iCount%).zMax = 10 ' snowflake descends every n steps
'm_arrSnow(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z) = iCount%
iSnow = iSnow + 1 ' increase chance of snow
if iSnow
> 200 then iSnow
= 200
' UNDER CONSTRUCTION:
' (DOESN'T WORK!)
' ROTATE THE SCENE?
iRotationCount = iRotationCount + 1
if iRotationCount
> iRotationMax
then iRotationCount = 0
iAngleXY = iAngleXY + iIncrementAngle
iAngleXY = 359
iAngleXY = 0
' GET KEYBOARD INPUT
' REGULATE LOOP + REFRESH SCREEN
' =============================================================================
' END ANIMATION LOOP #1
' =============================================================================
' =============================================================================
' MAIN LOOP
iDrawColor% = 8 ' RED
iCursorColor~& = cRed
'TODO: ONLY DRAW IF IT CHANGES?
' -----------------------------------------------------------------------------
' BEGIN SHOW INSTRUCTIONS / COORDINATES ON SCREEN
' -----------------------------------------------------------------------------
Locate m_iInstrStartRow
+0, m_iInstrStartCol:
Print "IsometricDraw1" Locate m_iInstrStartRow
+2, m_iInstrStartCol:
Print "CRSR RT/LF MOVES X = " + cstr$
(iX%
) Locate m_iInstrStartRow
+3, m_iInstrStartCol:
Print "CRSR UP/DN MOVES Y = " + cstr$
(iY%
) Locate m_iInstrStartRow
+4, m_iInstrStartCol:
Print "PAGE UP/DN MOVES Z = " + cstr$
(iZ%
) Locate m_iInstrStartRow
+5, m_iInstrStartCol:
Print "= / - CHANGES GRID SIZE = " + cstr$
(m_arrPlayer
(1).GridSize
) Locate m_iInstrStartRow
+6, m_iInstrStartCol:
Print "[ / ] TOGGLES MOVEMENT = " + IIFSTR$
(m_arrPlayer
(1).IsMoving
, "TRUE", "FALSE") Locate m_iInstrStartRow
+7, m_iInstrStartCol:
Print "INS / DEL TOGGLES REPEAT KEYS = " + IIFSTR$
(bEnableRepeatingKeys
, "TRUE", "FALSE") Locate m_iInstrStartRow
+8, m_iInstrStartCol:
Print ", / . CHANGES MINI MAP SIZE = " + cstr$
(m_arrPlayer
(1).MapSize
) Locate m_iInstrStartRow
+9, m_iInstrStartCol:
Print "a / b FOR UNDO / REDO" Locate m_iInstrStartRow
+11, m_iInstrStartCol:
Print "PRESS <ESC> TO QUIT"
Locate m_iPaletteTextRow
+0, m_iPaletteTextCol:
Print "1 color-" Locate m_iPaletteTextRow
+1, m_iPaletteTextCol:
Print "2 color+" Locate m_iPaletteTextRow
+2, m_iPaletteTextCol:
Print "3 draw" Locate m_iPaletteTextRow
+3, m_iPaletteTextCol:
Print "4 erase" Locate m_iPaletteTextRow
+4, m_iPaletteTextCol:
Print "5 toggle" Locate m_iPaletteTextRow
+5, m_iPaletteTextCol:
Print "6 eyedropper" Locate m_iPaletteTextRow
+6, m_iPaletteTextCol:
Print "7 clear" Locate m_iPaletteTextRow
+7, m_iPaletteTextCol:
Print "8 open" Locate m_iPaletteTextRow
+8, m_iPaletteTextCol:
Print "9 save" ' -----------------------------------------------------------------------------
' END SHOW INSTRUCTIONS / COORDINATES ON SCREEN
' -----------------------------------------------------------------------------
' ****************************************************************************************************************************************************************
' BEGIN DRAW PALETTE
' ****************************************************************************************************************************************************************
'TODO: support variable screen resolutions instead of hardcoded 1280x1024
iSize% = 24 ' {n}x{n} pixels square
iDrawX% = 10
iOffsetY% = 250
iDrawY% = iOffsetY% + (iLoop1 * iSize%)
' COLOR = TRANSPARENT
' DRAW A CHECKERBOARD PATTERN FOR TRANSPARENT
iFirstColor~& = cDarkGray
For iLoopY%
= iDrawY%
To ((iDrawY%
+ iSize%
) - 4) Step 4 If iFirstColor~&
= cDarkGray
Then iFirstColor~& = cGray
iFirstColor~& = cDarkGray
iNextColor~& = iFirstColor~&
For iLoopX%
= iDrawX%
To ((iDrawX%
+ iSize%
) - 4) Step 4 DrawBox iLoopX%, iLoopY%, 4, iNextColor~&
If iNextColor~&
= cDarkGray
Then iNextColor~& = cGray
iNextColor~& = cDarkGray
' COLOR = BLACK
iNextColor~& = m_arrColors(iLoop1)
DrawBox iDrawX%, iDrawY%, iSize%, iNextColor~&
' DRAW A BORDER AROUND IT
iNextColor~& = cDarkGray
DrawOutlineBox iDrawX%, iDrawY%, iSize%, iNextColor~&, 1
' DRAW WHITE BOX AROUND CURRENT COLOR
DoCycleColor 1, iCursorColor~&
iDrawY% = iOffsetY% + (iDrawColor% * iSize%)
DrawOutlineBox iDrawX%, iDrawY%, iSize%, iCursorColor~&, 1
' ****************************************************************************************************************************************************************
' END DRAW PALETTE
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' BEGIN DRAW MAP
' ****************************************************************************************************************************************************************
' DRAW SPLIT SCREEN (MAIN VIEW)
DrawScreen c_iDir_Forward, m_arrSplitScreen(1).ScreenOffsetX, m_arrSplitScreen(1).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
'' DRAW SPLIT SCREEN (3 OTHER VIEWS)
'DrawScreen c_iDir_Back, m_arrSplitScreen(2).ScreenOffsetX, m_arrSplitScreen(2).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
'DrawScreen c_iDir_Left, m_arrSplitScreen(3).ScreenOffsetX, m_arrSplitScreen(3).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
'DrawScreen c_iDir_Right, m_arrSplitScreen(4).ScreenOffsetX, m_arrSplitScreen(4).ScreenOffsetY, m_arrPlayer(1).GridSize, iX%, iY%, iZ%
' ****************************************************************************************************************************************************************
' END DRAW MAP
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' BEGIN PLAYER LOOP
' ****************************************************************************************************************************************************************
For iPlayerLoop
= 1 To m_iPlayerCount
'DrawScreen m_arrPlayer(iPlayerLoop).View, cScreenOffsetX, cScreenOffsetY, iX%, iY%, iZ%
' this first person stuff is kind of hard
' ' -----------------------------------------------------------------------------
' ' BEGIN SHOW SIMPLE FIRST-PERSON MINI-DISPLAY ON SCREEN
' ' -----------------------------------------------------------------------------
' ' POINTING WHICHEVER WAY USER MOVED LAST
'
' ' ADD TEXT LABEL
' Locate m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextY, m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextX: Print "First person";
' Locate m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextY+1, m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonTextX: Print "(" + GetDirection$(m_arrPlayer(iPlayerLoop).Direction) + ")";
'
' ' ERASE OLD MAP
' iDrawX% = m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
' iDrawY% = m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
' iSize% = m_arrPlayer(1).MapSize * m_iMapMaxX ' m_iMapMaxY m_iMapMaxZ
' DrawBox iDrawX%, iDrawY%, iSize%, cBlack ' TODO: variable background color
'
' Select Case m_arrPlayer(iPlayerLoop).Direction
' Case c_iDir_Down:
'
' Case c_iDir_Up:
'
' Case c_iDir_Left:
'
' Case c_iDir_Right:
'
' Case c_iDir_Back:
' ' z = up/down
' ' x = left/right
' ' y = closeness (m_iMapMinY = farthest)
'
' ' first person tiles / scaling
' ' ----------------------------
' ' distance tile size # tiles # total # incl. partial
' ' 0 16 8 8 8
' ' 1 15 8 8/15 8 10
' ' 2 14 9 2/14 8 10
' ' 3 13 9 11/13 8 10
' ' 4 12 10 8/12 9 12
' ' 5 11 11 7/11 10 12
' ' 6 10 12 8/10 12 14
' ' 7 9 14 2/ 9 14 16
'
' ' each level closer, 1 pixel taller/wider, 4 pixels up & over
'
' ' draw in relation to player's position
' ' point blank range = 8 tiles x 8 tiles
'
' ' XoXoXoXoXoXoXoXo
' ' P
' ' 0123456789012345
' ' 111111
'
' ' XoXoXoXoXoXoXo
' ' P
' ' 01234567890123
' ' 1111
'
' ' XoXoXoXoXoXoXo
' ' P
' ' 01234567890123
' ' 1111
'
' ' FOR DISTANCE:
'
' ' y: 76543210
' ' P
' ' distance: 01234567
'
' ' y: 76543210
' ' P
' ' distance: 01234567
'
' ' y: 76543210
' ' P
' ' distance: 01234567
'
' ' y: 76543210
' ' P
' ' distance: 01234567
'
' ' start at iDistance
' ' y-7 7
' ' 0 y
'
' ' Q: where is player?
' ' m_arrPlayer(iLoop1).x
' ' m_arrPlayer(iLoop1).y
' ' m_arrPlayer(iLoop1).z
'
' ' scan from right X2 to left X1, step-1
' if m_arrPlayer(iLoop1).x < 7 then
' iPosX1% = m_iMapMinX
' iPosX2% = m_iMapMinX+13
' else
' iPosX1% = m_arrPlayer(iLoop1).x - 6
' iPosX2% = m_arrPlayer(iLoop1).x + 7
' end if
'
' ' scan from bottom Z1 to top Z2
' if m_arrPlayer(iLoop1).z < 7 then
' iPosZ1% = m_iMapMinZ
' iPosZ2% = m_iMapMinZ+13
' else
' iPosZ1% = m_arrPlayer(iLoop1).z - 6
' iPosZ2% = m_arrPlayer(iLoop1).z + 7
' end if
'
' ' scan from far Y2 to close Y1
' if m_arrPlayer(iLoop1).y < 7 then
' iPosY1% = 0
' iPosY2% = m_arrPlayer(iLoop1).y
' iDistance = m_arrPlayer(iLoop1).y
' else
' iPosY1% = m_arrPlayer(iLoop1).y - 7
' iPosY2% = m_arrPlayer(iLoop1).y
' iDistance = 7
' end if
'
' For iLoopZ% = iPosZ1% To iPosZ2%
' For iLoopX% = iPosX2% To iPosX1% Step -1
' For iLoopY% = iPosY1% To iPosY2%
'
' ' Q: how big does block grow with each step closer? 1*MapSize
' ' Q: what is the offset from the left/top? 4*MapSize
' ' Q: what is the size of the smallest blocks? 1*MapSize
' ' Q: what is the size of the largest blocks? 8*MapSize
' ' Q: how far away do we see? what is the minimum y? 8 tiles
'
' ' at y, offset = 0
' ' at y, what is x/y size of 1 block?
' ' m_arrPlayer(1).MapSize
' ' m_iMapMaxX
' ' at y, how many blocks? 8x8
'
' iWidth = arrFPBrickSize(iDistance)
'
' arrFP_From(iDistance)
' arrFP_To(iDistance)
'
' iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
' iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
'
'
' If m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall Then
' 'DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
'
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player1 Then
'
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player2 Then
'
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player3 Then
'
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player4 Then
'
' Else
' 'DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' End If
'
' Next iLoopY%
' Next iLoopX%
' Next iLoopZ%
'
' Case c_iDir_Forward:
'
' Case Else:
' ' (DO NOTHING)
' End Select
'
' 'm_arrPlayer(1).MapSize
'
' For iLoopX% = m_iMapMinX To m_iMapMaxX
' For iLoopY% = m_iMapMinY To m_iMapMaxY
' iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonX
' iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFirstPersonY
' If m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Wall Then
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player1 Then
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player2 Then
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player3 Then
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' ElseIf m_arrMap(iLoopX%, iLoopY%, iZ%).Typ = c_iTile_Player4 Then
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
' 'TODO: ADD OTHER TYPES
' Else
' DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' End If
' Next iLoopY%
' Next iLoopX%
' ' -----------------------------------------------------------------------------
' ' END SHOW SIMPLE FIRST-PERSON MINI-DISPLAY ON SCREEN
' ' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN SHOW TOP-DOWN X/Y 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextX:
Print "Top-down";
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextY
+1, m_arrSplitScreen
(iPlayerLoop
).MiniMapTopDownTextX:
Print "(Z-slice)";
' DRAW MAP
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
iDrawY% = (iLoopY% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
If m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Wall
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player1
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player2
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player3
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iLoopY%, iZ%).Color1
'TODO: ADD OTHER TYPES
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' DRAW THE PLAYERS ON THE MINI MAP
For iLoop1
= m_iPlayerMin
To m_iPlayerCount
iDrawX% = (m_arrPlayer(iLoop1).x * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownX
iDrawY% = (m_arrPlayer(iLoop1).y * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapTopDownY
' TODO: ADD Alpha PARAMETER TO DrawBox
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
' DRAW THE OBJECTS ON THE MINI MAP
' (TO DO WHEN WE ADD OBJECTS)
' -----------------------------------------------------------------------------
' END SHOW TOP-DOWN X/Y 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN SHOW FRONT-BACK X/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextX:
Print "Front/back";
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextY
+1, m_arrSplitScreen
(iPlayerLoop
).MiniMapFrontBackTextX:
Print "(Y-slice)";
' DRAW MAP
For iLoopZ%
= m_iMapMaxZ
To m_iMapMinZ
Step -1 For iLoopX%
= m_iMapMinX
To m_iMapMaxX
iDrawX% = (iLoopX% * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
If m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
ElseIf m_arrMap
(iLoopX%
, iY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iLoopX%, iY%, iLoopZ%).Color1
'TODO: ADD OTHER TYPES
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' DRAW THE PLAYERS ON THE MINI MAP
For iLoop1
= m_iPlayerMin
To m_iPlayerCount
iDrawX% = (m_arrPlayer(iLoop1).x * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackX
iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapFrontBackY
' TODO: ADD Alpha PARAMETER TO DrawBox
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
' DRAW THE OBJECTS ON THE MINI MAP
' (TO DO WHEN WE ADD OBJECTS)
' -----------------------------------------------------------------------------
' END SHOW FRONT-BACK X/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN SHOW RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' TODO: FOR MULTIPLAYER, DRAW A SEPARATE MAP PER PLAYER TO SPLIT SCREEN
' ADD TEXT LABEL
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextY
, m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextX:
Print "Right/left";
Locate m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextY
+1, m_arrSplitScreen
(iPlayerLoop
).MiniMapRightLeftTextX:
Print "(X-slice)";
' DRAW MAP
For iLoopZ%
= m_iMapMaxZ
To m_iMapMinZ
Step -1 For iLoopY%
= m_iMapMinY
To m_iMapMaxY
iDrawX% = ((m_iMapMaxY - iLoopY%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
iDrawY% = ((m_iMapMaxZ - iLoopZ%) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
If m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
ElseIf m_arrMap
(iX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrMap(iX%, iLoopY%, iLoopZ%).Color1
'TODO: ADD OTHER TYPES
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, cKhaki
' DRAW THE PLAYERS ON THE MINI MAP
For iLoop1
= m_iPlayerMin
To m_iPlayerCount
iDrawX% = ((m_iMapMaxY - m_arrPlayer(iLoop1).y) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftX
iDrawY% = ((m_iMapMaxZ - m_arrPlayer(iLoop1).z) * m_arrPlayer(1).MapSize) + m_arrSplitScreen(iPlayerLoop).MiniMapRightLeftY
' TODO: ADD Alpha PARAMETER TO DrawBox
DrawBox iDrawX%, iDrawY%, m_arrPlayer(1).MapSize, m_arrPlayer(iLoop1).Color1
' DRAW THE OBJECTS ON THE MINI MAP
' (TO DO WHEN WE ADD OBJECTS)
' -----------------------------------------------------------------------------
' END SHOW RIGHT/LEFT Y/Z 2D MINI MAP ON SCREEN
' -----------------------------------------------------------------------------
' =============================================================================
' BEGIN GET KEYBOARD INPUT WITH _BUTTON
' =============================================================================
' *** HEY WHY HAS _BUTTON STOPPED WORKING? DID I NOT GET A MEMO? ***
' -----------------------------------------------------------------------------
' BEGIN UNDO v1
' TODO: unlimited levels of undo, for now just 1
' -----------------------------------------------------------------------------
'IF _BUTTON(KeyCode_CtrlLeft%) OR _BUTTON(KeyCode_CtrlRight%) THEN
' IF _BUTTON(KeyCode_Z%) THEN
' IF Not m_bButton_Z THEN
' m_bButton_Z = TRUE
' ' UNDO!
' END IF
' ELSEIF _BUTTON(KeyCode_Y%) THEN
' IF Not m_bButton_Y THEN
' m_bButton_Y = TRUE
' ' REDO!
' END IF
' END IF
'END IF
'
' TRACK WHEN KEYS ARE RELEASED (DISABLES REPEATING KEYS)
'IF Not _BUTTON(KeyCode_Z%) THEN
' m_bButton_Z = FALSE
'END IF
'IF Not _BUTTON(KeyCode_Y%) THEN
' m_bButton_Y = FALSE
'END IF
' -----------------------------------------------------------------------------
' END UNDO v1
' -----------------------------------------------------------------------------
' =============================================================================
' END GET KEYBOARD INPUT WITH _BUTTON
' =============================================================================
' =============================================================================
' BEGIN GET DIRECTIONAL KEYBOARD INPUT
' =============================================================================
If iLastKey
<> c_iKeyDown_Up
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Up
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Down
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Down
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Left
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Left
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Right
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Right
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
bMoved = TRUE
If iLastKey
<> c_iKeyDown_PgUp
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_PgUp
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
bMoved = TRUE
If iLastKey
<> c_iKeyDown_PgDn
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_PgDn
m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
bMoved = TRUE
' =============================================================================
' END GET DIRECTIONAL KEYBOARD INPUT
' =============================================================================
' =============================================================================
' BEGIN GET UNDO/REDO INPUT
' =============================================================================
If iLastKey
<> c_iKeyDown_A
Then iLastKey = c_iKeyDown_A
' UNDO!
MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
m_MapTileUndo.Typ = MapTileTempUndo.Typ
m_MapTileUndo.Color1 = MapTileTempUndo.Color1
m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
If iLastKey
<> c_iKeyDown_B
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_B
' REDO! *** FOR NOW IT'S THE SAME AS UNDO, JUST SWAPS CURRENT WITH UNDO INFO ***
MapTileTempUndo.Typ = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ
MapTileTempUndo.Color1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1
MapTileTempUndo.Alpha1 = m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Typ = m_MapTileUndo.Typ
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Color1 = m_MapTileUndo.Color1
m_arrMap(m_MapTileUndo.x, m_MapTileUndo.y, m_MapTileUndo.z).Alpha1 = m_MapTileUndo.Alpha1
m_MapTileUndo.Typ = MapTileTempUndo.Typ
m_MapTileUndo.Color1 = MapTileTempUndo.Color1
m_MapTileUndo.Alpha1 = MapTileTempUndo.Alpha1
' =============================================================================
' END GET UNDO/REDO INPUT
' =============================================================================
' =============================================================================
' BEGIN GET DRAWING INPUT
' =============================================================================
' -----------------------------------------------------------------------------
' 1 color-
If iLastKey
<> c_iKeyDown_1
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_1
iDrawColor% = iDrawColor% - 1
iDrawColor% = 25
' -----------------------------------------------------------------------------
' 2 color+
If iLastKey
<> c_iKeyDown_2
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_2
iDrawColor% = iDrawColor% + 1
iDrawColor% = 0
' -----------------------------------------------------------------------------
' 3 draw
If iLastKey
<> c_iKeyDown_3
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_3
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' DRAW CURRENT COLOR (OR ERASE IF COLOR=TRANSPARENT)
PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 4 erase
If iLastKey
<> c_iKeyDown_4
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_4
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' ERASE CURRENT TILE
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 5 toggle
If iLastKey
<> c_iKeyDown_5
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_5
' SAVE UNDO INFO:
m_MapTileUndo.x = iX%
m_MapTileUndo.y = iY%
m_MapTileUndo.z = iZ%
m_MapTileUndo.Typ = m_arrMap(iX%, iY%, iZ%).Typ
m_MapTileUndo.Color1 = m_arrMap(iX%, iY%, iZ%).Color1
m_MapTileUndo.Alpha1 = m_arrMap(iX%, iY%, iZ%).Alpha1
' TOGGLE CURRENT TILE:
If m_arrMap
(iX%
, iY%
, iZ%
).Typ
= c_iTile_Empty
Then 'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Wall
PlotTile iX%, iY%, iZ%, c_iTile_Wall, m_arrColors(iDrawColor%)
'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'm_arrMap(iX%, iY%, iZ%).Typ = c_iTile_Empty
PlotTile iX%, iY%, iZ%, c_iTile_Empty, m_arrColors(iDrawColor%)
'' ADD TO RECORDING
'ReDim _Preserve m_arrRecord(0 To UBound(m_arrRecord) + 1) As RecordType
'iIndex = UBound(m_arrRecord)
'm_arrRecord(iIndex).Command = "plot"
'm_arrRecord(iIndex).intParam1 = iX%
'm_arrRecord(iIndex).intParam2 = iY%
'm_arrRecord(iIndex).intParam3 = iZ%
'm_arrRecord(iIndex).intParam4 = m_arrMap(iX%, iY%, iZ%).Typ
'm_arrRecord(iIndex).ulngParam1 = m_arrMap(iX%, iY%, iZ%).Color1
' -----------------------------------------------------------------------------
' 6 eyedropper
If iLastKey
<> c_iKeyDown_6
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_6
iDrawColor% = GetPaletteFromColor%(m_arrMap(iX%, iY%, iZ%).Color1)
' -----------------------------------------------------------------------------
' 7 clear all
If iLastKey
<> c_iKeyDown_7
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_7
ReDim m_arrRecord
(-1) As RecordType
ClearIsometricMap
'For iLoopX% = m_iMapMinX To m_iMapMaxX
' For iLoopY% = m_iMapMinY To m_iMapMaxY
' For iLoopZ% = m_iMapMinZ To m_iMapMaxZ
' m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
' m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1 = cEmpty
' m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1 = 255
' m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' Next iLoopZ%
' Next iLoopY%
'Next iLoopX%
' -----------------------------------------------------------------------------
' 8 open
If iLastKey
<> c_iKeyDown_8
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_8
sNextErr = LoadIsometricDrawing$
' -----------------------------------------------------------------------------
' 9 save
If iLastKey
<> c_iKeyDown_9
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_9
sNextErr = SaveIsometricDrawing$
' =============================================================================
' END GET DRAWING INPUT
' =============================================================================
' =============================================================================
' BEGIN GET OTHER KEYBOARD INPUT
' =============================================================================
If iLastKey
<> c_iKeyDown_BracketLeft
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_BracketLeft
m_arrPlayer(iPlayerLoop).IsMoving = TRUE
If iLastKey
<> c_iKeyDown_BracketRight
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_BracketRight
m_arrPlayer(iPlayerLoop).IsMoving = FALSE
If iLastKey
<> c_iKeyDown_Comma
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Comma
' TODO: HAVE MAP SIZE PER PLAYER
m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize - 1
If m_arrPlayer
(iPlayerLoop
).MapSize
< 1 Then m_arrPlayer(iPlayerLoop).MapSize = 1
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Period
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Period
m_arrPlayer(iPlayerLoop).MapSize = m_arrPlayer(iPlayerLoop).MapSize + 1
If m_arrPlayer
(iPlayerLoop
).MapSize
> m_iGridSizeMax
Then m_arrPlayer(iPlayerLoop).MapSize = m_iGridSizeMax
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Minus
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Minus
' TODO: HAVE SEPARATE GRID SIZE PER PLAYER / SPLIT SCREEN?
m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize - 1
If m_arrPlayer
(iPlayerLoop
).GridSize
< m_iGridSizeMin
Then m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMin
bMoved = TRUE
If iLastKey
<> c_iKeyDown_EqualPlus
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_EqualPlus
m_arrPlayer(iPlayerLoop).GridSize = m_arrPlayer(iPlayerLoop).GridSize + 1
If m_arrPlayer
(iPlayerLoop
).GridSize
> m_iGridSizeMax
Then m_arrPlayer(iPlayerLoop).GridSize = m_iGridSizeMax
bMoved = TRUE
If iLastKey
<> c_iKeyDown_Home
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Home
' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
m_arrPlayer
(iPlayerLoop
).
View = m_arrPlayer
(iPlayerLoop
).
View - 1 If m_arrPlayer
(iPlayerLoop
).
View < c_iDir_Min
Then m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Max
If iLastKey
<> c_iKeyDown_End
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_End
' c_iDir_Left, c_iDir_Right, c_iDir_Back, c_iDir_Forward, c_iDir_Down, c_iDir_Up
m_arrPlayer
(iPlayerLoop
).
View = m_arrPlayer
(iPlayerLoop
).
View + 1 If m_arrPlayer
(iPlayerLoop
).
View > c_iDir_Max
Then m_arrPlayer
(iPlayerLoop
).
View = c_iDir_Min
' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
If iLastKey
<> c_iKeyDown_Ins
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Ins
bEnableRepeatingKeys = TRUE
' TODO: DO WE NEED TO HANDLE REPEATING KEYS FOR MULTIPLAYER?
If iLastKey
<> c_iKeyDown_Del
Or bEnableRepeatingKeys
= TRUE
Then iLastKey = c_iKeyDown_Del
bEnableRepeatingKeys = FALSE
iLastKey = -1
' =============================================================================
' END GET OTHER KEYBOARD INPUT
' =============================================================================
' =============================================================================
' BEGIN MOVE PLAYER BASED ON DIRECTION
' =============================================================================
If m_arrPlayer
(iPlayerLoop
).IsMoving
= TRUE
Or bMoved
= TRUE
Then bMoved = FALSE
iNewX% = iX%
iNewY% = iY%
iNewZ% = iZ% - 1
iNewZ% = m_iMapMaxZ
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Up
iNewZ% = iZ%
iNewX% = iX%
iNewY% = iY%
iNewZ% = iZ% + 1
iNewZ% = m_iMapMinZ
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Down
iNewZ% = iZ%
iNewX% = iX% - 1
iNewY% = iY%
iNewZ% = iZ%
iNewX% = m_iMapMaxX
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Right
iNewX% = iX%
iNewX% = iX% + 1
iNewY% = iY%
iNewZ% = iZ%
iNewX% = m_iMapMinX
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Left
iNewX% = iX%
iNewX% = iX%
iNewY% = iY% - 1
iNewZ% = iZ%
iNewY% = m_iMapMaxY
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Forward
iNewY% = iY%
iNewX% = iX%
iNewY% = iY% + 1
iNewZ% = iZ%
iNewY% = m_iMapMinY
If (m_arrMap
(iNewX%
, iNewY%
, iNewZ%
).Typ
<> c_iTile_Empty
) And (bIgnoreTerrain
= FALSE
) Then m_arrPlayer(iPlayerLoop).Direction = c_iDir_Back
iNewY% = iY%
' (DO NOTHING)
'iNewX% = iX%
'iNewY% = iY%
'iNewZ% = iZ%
' SAVE NEW POSITION
iX% = iNewX%
iY% = iNewY%
iZ% = iNewZ%
' FOR MULTIPLAYER WE WOULD USE:
m_arrPlayer(iPlayerLoop).x = iNewX%
m_arrPlayer(iPlayerLoop).y = iNewY%
m_arrPlayer(iPlayerLoop).z = iNewZ%
' =============================================================================
' END MOVE PLAYER BASED ON DIRECTION
' =============================================================================
' =============================================================================
' BEGIN CYCLE COLOR
' =============================================================================
If m_arrPlayer
(iPlayerLoop
).ColorScheme1
> 0 Then m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = m_arrPlayer(iPlayerLoop).ColorSchemeCount1 + 1
If m_arrPlayer
(iPlayerLoop
).ColorSchemeCount1
> m_arrPlayer
(iPlayerLoop
).ColorSchemeSpeed1
Then m_arrPlayer(iPlayerLoop).ColorSchemeCount1 = 0
DoCycleColor m_arrPlayer(iPlayerLoop).ColorScheme1, m_arrPlayer(iPlayerLoop).Color1
' =============================================================================
' END CYCLE COLOR
' =============================================================================
' ****************************************************************************************************************************************************************
' END PLAYER LOOP
' ****************************************************************************************************************************************************************
' ****************************************************************************************************************************************************************
' BEGIN DRAW SCREEN MARKERS
' ****************************************************************************************************************************************************************
' -----------------------------------------------------------------------------
' BEGIN DRAW BITMAP GRID
' -----------------------------------------------------------------------------
' screen = 1280h x 1024w
iLoopX% = 1
DrawRect iLoopX%, iLoopY%, 1280, 1, cWhite
DrawRect iLoopX%, iLoopY%+50, 1280, 1, cCyan
iLoopY% = 1
DrawRect iLoopX%, iLoopY%, 1, 1024, cWhite
DrawRect iLoopX%+50, iLoopY%, 1, 1024, cCyan
' -----------------------------------------------------------------------------
' END DRAW BITMAP GRID
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' BEGIN DRAW TEXT GRID
' -----------------------------------------------------------------------------
iLoopY% = 64
' show 100s place
in$ = cstr$(iLoopX%)
in$ = " "
' show 10s place
in$ = cstr$(iLoopX%)
in$ = " "
' show 1s place
in$
= right$(cstr$
(iLoopX%
), 1)
iLoopX% = 1
in$
= right$(" " + cstr$
(iLoopY%
), 2) ' -----------------------------------------------------------------------------
' END DRAW TEXT GRID
' -----------------------------------------------------------------------------
' ****************************************************************************************************************************************************************
' END DRAW SCREEN MARKERS
' ****************************************************************************************************************************************************************
CleanupAndExit:
' FINISH UP AND EXIT
IsometricDraw1$ = sResult
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' PLOT TILE TO MAP AND SAVE TO RECORDING
'PlotTile iX, iY, iZ, iTile, ulngColor1
m_arrMap(iX, iY, iZ).Typ = iTile
m_arrMap(iX, iY, iZ).Color1 = ulngColor1
m_arrMap(iX, iY, iZ).Alpha1 = 255
m_arrMap(iX, iY, iZ).AlphaOverride = 255
LogPlotTile iX, iY, iZ, iTile, ulngColor1
' /////////////////////////////////////////////////////////////////////////////
' PLOT TILE TO SPECIFIED MAP, AND SAVE TO RECORDING IF SPECIFIED
' temporary function for now
' later we will update PlotTile and all will use that
' and global bSaveToRecording will control whether LogPlotTile is called
'PlotTile2 arrMap, iX, iY, iZ, iTile, ulngColor1
arrMap(iX, iY, iZ).Typ = iTile
arrMap(iX, iY, iZ).Color1 = ulngColor1
arrMap(iX, iY, iZ).Alpha1 = 255
arrMap(iX, iY, iZ).AlphaOverride = 255
'if bSaveToRecording = TRUE then
' LogPlotTile iX, iY, iZ, iTile, ulngColor1
'end if
' /////////////////////////////////////////////////////////////////////////////
' SAVE PLOT COMMAND TO RECORDING
'LogPlotTile iX, iY, iZ, iTile, ulngColor1
m_arrRecord(iIndex).Command = "plot"
m_arrRecord(iIndex).intParam1 = iX
m_arrRecord(iIndex).intParam2 = iY
m_arrRecord(iIndex).intParam3 = iZ
m_arrRecord(iIndex).intParam4 = iTile
m_arrRecord(iIndex).ulngParam1 = ulngColor1
' /////////////////////////////////////////////////////////////////////////////
' - save screens to file (stored as editable text)
' + FORMAT: [tile=t][color@x,y,z][color@x,y,z][color@x,y,z]...
Dim RoutineName
As String:: RoutineName
= "SaveIsometricDrawing$"
'IF m_bTesting = TRUE THEN
' _echo "--------------------------------------------------------------------------------"
' _echo "Started " + RoutineName
' _echo "--------------------------------------------------------------------------------"
'END IF
' Get file name
m_SaveFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "txt" Print "Default file name is " + Chr$(34) + m_SaveFileName$
+ Chr$(34) + "." Input "Type save file name, or blank for default: ", in$
m_SaveFileName$ = in$
sFile = m_ProgramPath$ + m_SaveFileName$
'IF m_bTesting = TRUE THEN
' _echo "sFile=" + CHR$(34) + sFile + CHR$(34)
'END IF
' Save recording to file
'[tile=t][color@x,y,z][color@x,y,z][color@x,y,z]
If m_arrRecord
(iIndex
).Command
= "plot" Then sLine = ""
sLine = sLine + "plot,"
sLine
= sLine
+ "tile=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam4
)) + "," sLine
= sLine
+ "color=" + _Trim$(Str$(m_arrRecord
(iIndex
).ulngParam1
)) + "," sLine
= sLine
+ "x=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam1
)) + "," sLine
= sLine
+ "y=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam2
)) + "," sLine
= sLine
+ "z=" + _Trim$(Str$(m_arrRecord
(iIndex
).intParam3
)) iCount = iCount + 1
'IF m_bTesting = TRUE THEN
' _echo "SKIPPED m_arrRecord(" + _Trim$(Str$(iIndex)) + ") INVALID .Command=" + CHR$(34) + m_arrRecord(iIndex).Command + CHR$(34)
'END IF
iError = iError + 1
Input "PRESS <ENTER> TO CONTINUE", in$
SaveIsometricDrawing$ = sError
' /////////////////////////////////////////////////////////////////////////////
' - load screens into array m_arrRecord
' + PARSER:
' 1. replace all ][ with [
' 2. split by "[" into simple 1D array
' 3. each element is either "tile=t" or "plot=color@x,y,z"
' 4. parse data into array to playback recording
' [n][0] = command$ = "draw"
' [n][1] = intParam1 = x
' [n][2] = intValue2 = y
' [n][3] = intValue3 = z
' [n][4] = intParam4 = tile #
' [n][5] = intValue5 = alpha1
' [n][6] = ulngValue1 = color1
Dim RoutineName
As String:: RoutineName
= "LoadIsometricDrawing$" ReDim m_arrRecord
(-1) As RecordType
'Dim sDebugLine As String
'IF m_bTesting = TRUE THEN
' _echo "--------------------------------------------------------------------------------"
' _echo "Started " + RoutineName
' _echo "--------------------------------------------------------------------------------"
'END IF
' Get file name
m_SaveFileName$
= Left$(m_ProgramName$
, _InStrRev(m_ProgramName$
, ".")) + "txt" Print "Default file name is " + Chr$(34) + m_SaveFileName$
+ Chr$(34) + "." Input "Type name of file to open, or blank for default: ", in$
m_SaveFileName$ = in$
sFile = m_ProgramPath$ + m_SaveFileName$
' Make sure file exists
sError
= "File not found: " + Chr$(34) + sFile
+ Chr$(34) 'IF m_bTesting = TRUE THEN
' _echo "Found file: " + chr$(34) + sFile + chr$(34)
'END IF
' Load recording from file
ClearIsometricMap
ReDim m_arrRecord
(-1) As RecordType
'IF m_bTesting = TRUE THEN
' _echo "OPEN sFile FOR BINARY AS #1"
'END IF
iTotal
= Len(sText
) - Len(Replace$
(sText
, Chr$(13), "")) sText = ""
' SPLIT IS TOO SLOW!
'IF m_bTesting = TRUE THEN
' _echo "split sText, CHR$(13), arrLines()"
'END IF
'split sText, CHR$(13), arrLines()
'iTotal = ubound(arrLines)-1
' PARSE LINES: plot,tile=2,color=4294901760,x=10,y=10,z=10
iStatusCount = 0
iStatusEvery = iTotal / 100
'Print "iTotal =" + _Trim$(Str$(iTotal))
'Print "iStatusEvery=" + _Trim$(Str$(iStatusEvery))
'Input "PRESS <ENTER> TO CONTINUE",in$
'FOR iLine = lbound(arrLines) TO ubound(arrLines)-1
'sLine = arrLines(iLine)
'INPUT #1, sLine
Line Input #1, sLine
' read entire text file line
iRead = iRead + 1
'IF m_bTesting = TRUE THEN
' _echo "Parsing line " + _Trim$(Str$(iRead))
'END IF
' SHOW STATUS
' TODO: FIX <- DOESN'T SEEM TO DISPLAY UNTIL THE END, ALL AT ONCE
iStatusCount = iStatusCount + 1
If iStatusCount
> iStatusEvery
Then iStatusCount = 0
iPercent = 100 * (iRead / iTotal)
'IF m_bTesting = TRUE THEN
' _echo _Trim$(Str$(iPercent)) + "%"
'END IF
'sDebugLine = sLine
'sDebugLine = Replace$(sDebugLine, CHR$(9), "\t")
'sDebugLine = Replace$(sDebugLine, CHR$(13), "\n")
'sDebugLine = Replace$(sDebugLine, CHR$(10), "\r")
'IF m_bTesting = TRUE THEN
' _echo " Raw =" + chr$(34) + sDebugLine + chr$(34)
'' _echo " Raw =" + chr$(34) + arrLines(iLine) + chr$(34)
'END IF
sLine = Replace$(sLine, " ", "") ' Remove spaces
sLine
= Replace$
(sLine
, Chr$(9), "") ' Remove tabs sLine
= Replace$
(sLine
, Chr$(10), "") ' Remove line breaks sLine
= Replace$
(sLine
, Chr$(13), "") ' Remove carriage returns 'IF m_bTesting = TRUE THEN
' _echo " Trimmed=" + chr$(34) + sLine + chr$(34)
'END IF
split sLine, ",", arrNextLine()
'IF m_bTesting = TRUE THEN
' _echo " lbound =" + _Trim$(Str$(lbound(arrNextLine))) '+ CHR$(10)
' _echo " ubound =" + _Trim$(Str$(ubound(arrNextLine))) '+ CHR$(10)
'END IF
sCommand
= arrNextLine
(LBound(arrNextLine
)) 'IF m_bTesting = TRUE THEN
' _echo " Command=" + chr$(34) + sCommand + chr$(34)
'END IF
iKnown = iKnown + 1
sPair = arrNextLine(iPair)
split sPair, "=", arrNameValue()
sValue
= arrNameValue
(LBound(arrNameValue
) + 1) sValue = ""
sName = ""
sNextErr = ""
sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Invalid value: " + sName
+ " = " + Chr$(34) + sValue
+ Chr$(34) sNextErr
= "Unknown parameter: " + Chr$(34) + sName
+ Chr$(34) + "," + Chr$(34) + sValue
+ Chr$(34) iValid = iValid + 1
'IF m_bTesting = TRUE THEN
' _echo "READ VALUES SUCCESSFULLY:" + CHR$(13)
' _echo "iTile =" + _Trim$(Str$(iTile)) + CHR$(13)
' _echo "ulngColor1=" + _Trim$(Str$(ulngColor1)) + CHR$(13)
' _echo "iX =" + _Trim$(Str$(iX)) + CHR$(13)
' _echo "iY =" + _Trim$(Str$(iY)) + CHR$(13)
' _echo "iZ =" + _Trim$(Str$(iZ)) + CHR$(13)
'' EXIT FOR
'END IF
PlotTile iX, iY, iZ, iTile, ulngColor1
iErrors = iErrors + 1
Print " ERROR: " + sNextErr
'IF m_bTesting = TRUE THEN
'' _echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
' _echo " ERROR: " + sNextErr
'' EXIT FOR
'END IF
'IF m_bTesting = TRUE THEN
'' _echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
' _echo " command not recognized: skipped"
'END IF
iUnknown = iUnknown + 1
'IF m_bTesting = TRUE THEN
'' _echo "Line " + _Trim$(Str$(iRead)) + "=" + CHR$(34) + sLine + CHR$(34) + CHR$(10)
' _echo " Line is blank: skipped"
'END IF
iSkipped = iSkipped + 1
'NEXT iLine
Input "PRESS <ENTER> TO CONTINUE", in$
LoadIsometricDrawing$ = sError
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END FILE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' =============================================================================
' LET'S GET THE COORDINATES STRAIGHT!
' Coordinates are m_arrMap(x,y,z)
' ________________
' /|e /|e
' / | / |
' / | / |z-axis
' / | / |
' / /---------/----/
' / / a / b/
' / / / /
' |--------------| /
' |f / g| / y-axis
' | / | /
' | / | /
' |/c d|/
' ----------------
' x-axis
'
' POINT ( X, Y, Z)
' a ( 0, 0, 0)
' b (32, 0, 0)
' c ( 0,32, 0)
' d (32,32, 0)
' e ( 0, 0,32)
' f ( 0,32,32)
' g (32,32,32)
' =============================================================================
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE MAP TO EMPTY
' Requires shared global variable:
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearIsometricMap"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE RENDERING MAP #1 TO EMPTY
' Requires shared global variable:
' m_arrRender1(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearRenderMap1"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrRender1(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 0
' /////////////////////////////////////////////////////////////////////////////
' INITIALIZE RENDERING MAP #2 TO EMPTY
' Requires shared global variable:
' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Dim RoutineName
As String: RoutineName
= "ClearRenderMap2"
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Typ = c_iTile_Empty
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 0
' /////////////////////////////////////////////////////////////////////////////
' Determine which squares are visible in isometric map
' Original operates directly on the main map array m_arrMap
' and not the copy (m_arrRender2) used to rotate the perspective.
' Requires shared global variable (3D array of map):
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' RECEIVES:
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
' Direction is assumed to be c_iDir_Forward.
' If iX% < 0 then we just render everything with its normal alpha value.
Sub ComputeVisible
(iX%
, iY%
, iZ%
, iGridSize
) Dim RoutineName
As String: RoutineName
= "ComputeVisible"
' CALCULATE PLAYER'S 2-D POSITION
iPX1% = iX% * iGridSize + cGridOffsetX
iPY1% = iY% * iGridSize + cGridOffsetY
iPZ1% = iZ% * iGridSize + cGridOffsetZ
iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
' LOOK AT EACH TILE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' *****************************************************************************
' IF SPACE HAS A TILE
' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
' THEN MAKE THE TILE TRANSPARENT
' *****************************************************************************
' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
If m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Or m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
Then ' CALCULATE TILE'S 2-D POSITION
iPX1% = iLoopX% * iGridSize + cGridOffsetX
iPY1% = iLoopY% * iGridSize + cGridOffsetY
iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
'If iLoopZ% >= iZ% Then
'If iLoopX% >= iX% Then
' FOR TILES FORWARD OF PLAYER
' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
If (iPlayer2Dy
>= (iTile2Dy
- iGridSize
)) And (iPlayer2Dy
<= (iTile2Dy
+ iGridSize
)) Then
' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
If (iPlayer2Dx
>= (iTile2Dx
- iGridSize
)) And (iPlayer2Dx
<= (iTile2Dx
+ iGridSize
)) Then ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
' TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'End If
'End If
' LEAVE THE TILE OPAQUE
' TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
' JUST MAKE ALL TILES VISIBLE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' LEAVE THE TILE OPAQUE
m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' /////////////////////////////////////////////////////////////////////////////
' Determine which squares are visible in isometric map
' Same as ComputeVisible except uses the rotated copy
' (m_arrRender2 instead of m_arrMap)
' Requires shared global variable (3D array of map):
' m_arrRender2(x,y,z) = rotated copy of 3D array map of world
' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' RECEIVES:
' iX% = player's X positon
' iY% = player's Y position
' iZ% = player's Z position
' If iX% < 0 then we just render everything with its normal alpha value.
' TODO: FIX FOR c_iDir_Down and c_iDir_Up DIRECTIONS
' "FOR TILES FORWARD OF PLAYER" SECTION BELOW
' NEEDS TO LOOK AT Z AXIS INSTEAD OF Y ?
Sub ComputeRenderVisible
(iX%
, iY%
, iZ%
, iGridSize
) Dim RoutineName
As String: RoutineName
= "ComputeRenderVisible"
' CALCULATE PLAYER'S 2-D POSITION
iPX1% = iX% * iGridSize + cGridOffsetX
iPY1% = iY% * iGridSize + cGridOffsetY
iPZ1% = iZ% * iGridSize + cGridOffsetZ
iPlayer2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iPlayer2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
' LOOK AT EACH TILE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
' *****************************************************************************
' IF SPACE HAS A TILE
' AND ITS 2D (X,Y) IS > PLAYER'S 2D (X,Y)
' THEN MAKE THE TILE TRANSPARENT
' *****************************************************************************
' TODO: COMPARE AGAINST ALL TYPES OF TILES NOT JUST WALL/FLOOR
If m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Or m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
Then ' CALCULATE TILE'S 2-D POSITION
iPX1% = iLoopX% * iGridSize + cGridOffsetX
iPY1% = iLoopY% * iGridSize + cGridOffsetY
iPZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iTile2Dx = CX2I(iPX1%, iPY1%) + cScreenOffsetX
iTile2Dy = (CY2I(iPX1%, iPY1%) + cScreenOffsetY) - iPZ1%
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, _RGB32(r, g, b, alpha&)
'If iLoopZ% >= iZ% Then
'If iLoopX% >= iX% Then
' FOR TILES FORWARD OF PLAYER
' IF PLAYER'S 2D Y POSITION IS WITHIN RANGE OF TILE'S 2D Y POSITION
If (iPlayer2Dy
>= (iTile2Dy
- iGridSize
)) And (iPlayer2Dy
<= (iTile2Dy
+ iGridSize
)) Then
' AND IF PLAYER'S 2D X POSITION IS WITHIN RANGE OF TILE'S 2D X POSITION
If (iPlayer2Dx
>= (iTile2Dx
- iGridSize
)) And (iPlayer2Dx
<= (iTile2Dx
+ iGridSize
)) Then ' RENDER THE TILE TRANSPARENT SO WE CAN SEE THE PLAYER
'TODO: CHANGE AlphaOverride TO BE RELATIVE TO ORIGINAL Alpha VALUE?
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 86
' LEAVE THE TILE OPAQUE
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' LEAVE THE TILE OPAQUE
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
'End If
'End If
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
' JUST MAKE ALL TILES VISIBLE
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = 255
'TODO: CHANGE 255 TO ORIGINAL Alpha VALUE
'TODO: SUPPORT CUSTOM ALPHA FOR COLORS (EVENTUALLY 3-COLOR TILES .Alpha1, .Alpha2, .Alpha3)
'm_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Alpha1
End Sub ' ComputeRenderVisible
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
' from the forward (default) perspective.
' Requires shared global variable
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
' params instead of constants:
' Const cScreenOffsetX = 500 ' 450
' Const cScreenOffsetY = 300 ' 50
' Const cScreenOffsetZ = 0
' what about?
' Const cGridOffsetX = 50
' Const cGridOffsetY = 50
' Const cGridOffsetZ = 0
Sub DrawIsometricScreen
(iScreenOffsetX
, iScreenOffsetY
, iGridSize
) Dim RoutineName
As String: RoutineName
= "DrawIsometricScreen"
alpha& = 255
bTile = FALSE
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' CALCULATE POSITION
iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iPosX1% = iLoopX% * iGridSize + cGridOffsetX
iPosY1% = iLoopY% * iGridSize + cGridOffsetY
iPosX2% = iPosX1% + iGridSize
iPosY2% = iPosY1% + iGridSize
' DETERMINE COLOR
If m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
bTile = FALSE
iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
bTile = TRUE
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then iColor = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Water
Then 'TODO: transparent for water
iColor = cEmpty
alpha& = 64
ElseIf m_arrMap
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Window
Then 'TODO: transparent for windows
iColor = cEmpty
alpha& = 64
iColor = cEmpty
' PLOT NEXT TILE
'IsoLine3D(x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective.
' Requires shared global variable
' m_arrRender2(x,y,z) = 3D array map of world
' m_arrRender2(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
Sub DrawRenderScreen
(iScreenOffsetX
, iScreenOffsetY
, iGridSize
) Dim RoutineName
As String: RoutineName
= "DrawRenderScreen"
alpha& = 255
bTile = FALSE
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
' CALCULATE POSITION
iPosZ1% = iLoopZ% * iGridSize + cGridOffsetZ
iPosX1% = iLoopX% * iGridSize + cGridOffsetX
iPosY1% = iLoopY% * iGridSize + cGridOffsetY
iPosX2% = iPosX1% + iGridSize
iPosY2% = iPosY1% + iGridSize
' DETERMINE COLOR
If m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Floor
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
bTile = FALSE
iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color2
bTile = TRUE
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Wall
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).AlphaOverride
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player1
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player2
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player3
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Player4
Then iColor = m_arrRender2(iLoopX%, iLoopY%, iLoopZ%).Color1
alpha& = 255
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Water
Then 'TODO: transparent for water
iColor = cEmpty
alpha& = 64
ElseIf m_arrRender2
(iLoopX%
, iLoopY%
, iLoopZ%
).Typ
= c_iTile_Window
Then 'TODO: transparent for windows
iColor = cEmpty
alpha& = 64
iColor = cEmpty
' PLOT NEXT TILE
'IsoLine3D(x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long, alpha&)
'IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, m_iGridSize, cScreenOffsetX, cScreenOffsetY, iColor, alpha&
IsoLine3D iPosX1%, iPosY1%, iPosX2%, iPosY2%, iPosZ1%, iGridSize, iScreenOffsetX, iScreenOffsetY, iColor, alpha&
' /////////////////////////////////////////////////////////////////////////////
' Draw the map in 3D Isometic Perspective
' from a different direction.
' This is the lazy man's version which simply copies the tiles to
' a temporary array, rotated to the specified direction/orientation.
' A more efficient + faster method would operate directly on the
' main array, but I am too bogged down to figure that out right now!
' RECEIVES:
' iDirection% = point of view to render from
' i.e. the direction we are looking at the scene FROM
' iDirection% can be one of the following:
' c_iDir_Down
' c_iDir_Up
' c_iDir_Left
' c_iDir_Right
' c_iDir_Back
' c_iDir_Forward = default
'
' If iDirection% = c_iDir_Forward, just call DrawIsometricScreen instead (faster).
'
' iScreenOffsetX, iScreenOffsetY = where on display to draw
'
' iX%, iY%, iZ% = player's position, used for ComputeRenderVisible
' to compute which tiles to hide / make transparent
' (tiles that might be hiding the player)
' If these are <0, then ComputeRenderVisible uses original alpha values.
' TODO: ADD OFFSET PARAMETERS FOR WHERE TO DRAW ON SCREEN (FOR SPLIT SCREEN)
' params instead of constants:
' Const cScreenOffsetX = 500 ' 450
' Const cScreenOffsetY = 300 ' 50
' Const cScreenOffsetZ = 0
' what about?
' Const cGridOffsetX = 50
' Const cGridOffsetY = 50
' Const cGridOffsetZ = 0
' TODO: player layer
' m_iPlayerCount
' shared for current player #?
' first copy world and superimpose player coords?
Sub DrawScreen
(iDirection%
, iScreenOffsetX
, iScreenOffsetY
, iGridSize
, iX%
, iY%
, iZ%
)
' =============================================================================
' USE FIRST TEMPORARY ARRAY TO STORE SCENE OVERLAID WITH PLAYERS + OBJECTS
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap1
' FIRST COPY THE MAP
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
'm_arrRender1(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
CopyMapTile m_arrMap(iLoopX%, iLoopY%, iLoopZ%), m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
' NEXT COPY THE PLAYERS
For iLoopX%
= m_iPlayerMin
To m_iPlayerCount
m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Typ = m_arrPlayer(iLoopX%).Tile1
m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Color1 = m_arrPlayer(iLoopX%).Color1
m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Alpha1 = m_arrPlayer(iLoopX%).Alpha1
m_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).AlphaOverride = m_arrPlayer(iLoopX%).AlphaOverride
' NEXT COPY THE OBJECTS
' (TO DO WHEN WE HAVE OBJECTS)
' =============================================================================
' USE SECOND TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap2
' COPY TILES, ROTATED TO DESIRED VIEWING PERSPECTIVE / ANGLE
' SCENE IS FLIPPED UP (TOP FACE NOW FACING AWAY FROM US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, m_iMapMaxZ - iLoopZ%, iLoopY%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, m_iMapMaxZ - iZ%, iY%, iGridSize
' SCENE IS FLIPPED DOWN (TOP FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, iLoopZ%, m_iMapMaxY - iLoopY%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, iZ%, m_iMapMaxY - iY%, iGridSize
' SCENE IS ROTATED COUNTER CLOCKWISE FROM TOP (LEFT FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopY%, m_iMapMaxX - iLoopX%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iY%, m_iMapMaxX - iX%, iZ%, iGridSize
' SCENE IS ROTATED CLOCKWISE FROM TOP (RIGHT FACE NOW FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(m_iMapMaxY - iLoopY%, iLoopX%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible m_iMapMaxY - iY%, iX%, iZ%, iGridSize
' SCENE IS TURNED AROUND (FRONT FACE NOW FACING AWAY FROM US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(m_iMapMaxX - iLoopX%, m_iMapMaxY - iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible m_iMapMaxX - iX%, m_iMapMaxY - iY%, iZ%, iGridSize
' FOR ALL OTHER CASES WE JUST DRAW FORWARD (FACING TOWARD US)
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
ComputeRenderVisible iX%, iY%, iZ%, iGridSize
DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
' /////////////////////////////////////////////////////////////////////////////
' similar to DrawScreen
' but instead of player, draws objects
' and free rotates (to angle iAngleXY)
' TODO: get free rotation working
Sub DrawSnowScreen
(iAngleXY
, iScreenOffsetX
, iScreenOffsetY
, iGridSize
, arrSnow
() As SnowflakeType
, arrLights
() As SnowflakeType
, oStar
As SnowflakeType
)
' =============================================================================
' USE FIRST TEMPORARY ARRAY TO STORE SCENE OVERLAID WITH OBJECTS
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap1
' FIRST COPY THE MAP
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
'm_arrRender1(iLoopX%,iLoopY%,iLoopZ%) = m_arrMap(iLoopX%, iLoopY%, iLoopZ%)
CopyMapTile m_arrMap(iLoopX%, iLoopY%, iLoopZ%), m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
' -----------------------------------------------------------------------------
' NEXT COPY THE OBJECTS
' STAR
' usage: iAxis can be cPlaneXY=1, cPlaneYZ=2, cPlaneZX=3
' PlotCircle2 arrMap(), iAxis, X, Y, Z, R, iTile, iColor
PlotCircle2 m_arrRender1(), cPlaneXY, oStar.x, oStar.y, oStar.z, oStar.xCount, c_iTile_Wall, oStar.Color1
PlotCircle2 m_arrRender1(), cPlaneYZ, oStar.x, oStar.y, oStar.z, oStar.yCount, c_iTile_Wall, oStar.Color2
PlotCircle2 m_arrRender1(), cPlaneZX, oStar.x, oStar.y, oStar.z, oStar.zCount, c_iTile_Wall, oStar.Color3
'CircleFill2 m_arrRender1(), cPlaneXY, oStar.x, oStar.y, oStar.z, oStar.xCount, c_iTile_Wall, oStar.Color1
'CircleFill2 m_arrRender1(), cPlaneYZ, oStar.x, oStar.y, oStar.z, oStar.yCount, c_iTile_Wall, oStar.Color1
'CircleFill2 m_arrRender1(), cPlaneZX, oStar.x, oStar.y, oStar.z, oStar.zCount, c_iTile_Wall, oStar.Color1
' LIGHTS
' (UNDER CONSTRUCTION)
' SNOW
'm_arrRender1(m_arrPlayer(iLoopX%).x, m_arrPlayer(iLoopX%).y, m_arrPlayer(iLoopX%).z).Typ = m_arrPlayer(iLoopX%).Tile1
' IS THIS SNOWFLAKE ACTIVE?
if arrSnow
(iCount%
).IsEnabled
= TRUE
then m_arrRender1(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Typ = arrSnow(iCount%).Tile1
m_arrRender1(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Color1 = arrSnow(iCount%).Color1
m_arrRender1(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).Alpha1 = arrSnow(iCount%).Alpha1
m_arrRender1(arrSnow(iCount%).x, arrSnow(iCount%).y, arrSnow(iCount%).z).AlphaOverride = arrSnow(iCount%).Alpha1
' =============================================================================
' USE SECOND TEMPORARY ARRAY TO STORE ROTATED SCENE THEN DRAW IT
' CLEAR THE MAP (NECESSARY?)
ClearRenderMap2
' COPY TILES, ROTATED TO DESIRED VIEWING PERSPECTIVE / ANGLE
For iLoopZ%
= m_iMapMinZ
To m_iMapMaxZ
'TODO: here is where we would do rotation
For iLoopX%
= m_iMapMinX
To m_iMapMaxX
For iLoopY%
= m_iMapMinY
To m_iMapMaxY
m_arrRender2(iLoopX%, iLoopY%, iLoopZ%) = m_arrRender1(iLoopX%, iLoopY%, iLoopZ%)
'ComputeRenderVisible iX%, iY%, iZ%, iGridSize
ShearRotate4 m_arrRender1(), m_arrRender2(), iAngleXY, cClockwise, cPlaneXY, iMissingTileCount
' =============================================================================
' DRAW THE FINAL SCENE
DrawRenderScreen iScreenOffsetX, iScreenOffsetY, iGridSize
' /////////////////////////////////////////////////////////////////////////////
' Copies a MapTileType user defined type variable, member by member
' (not sure if you can just do MyUDT1 = MyUDT2?)
Sub CopyMapTile
(SourceMap
As MapTileType
, DestMap
As MapTileType
) DestMap.Typ = SourceMap.Typ
DestMap.Color1 = SourceMap.Color1
DestMap.Color2 = SourceMap.Color2
DestMap.Color3 = SourceMap.Color3
DestMap.Alpha1 = SourceMap.Alpha1
DestMap.Alpha2 = SourceMap.Alpha2
DestMap.Alpha3 = SourceMap.Alpha3
DestMap.AlphaOverride = SourceMap.AlphaOverride
' /////////////////////////////////////////////////////////////////////////////
' RETURNS MAP AS TEXT
' Requires shared global variable
' m_arrMap(x,y,z) = 3D array map of world
' m_arrMap(m_iMapMinX To m_iMapMaxX, m_iMapMinY To m_iMapMaxY, m_iMapMinZ To m_iMapMaxZ) As MapTileType
' USAGE:
'Input "See a text dump (y/n)? ", in$
'If LCase$(in$) = LCase$("y") Then
' Print MapToText$
'End If
sResult = ""
' FIND USED BOUNDARIES OF MAP
iMinX% = -1
iMaxX% = -1
iMinY% = -1
iMaxY% = -1
iMinZ% = -1
iMaxZ% = -1
iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
If iType%
<> c_iTile_Empty
And iType%
<> c_iTile_Floor
Then iMinX% = iLoopX%
iMinY% = iLoopY%
iMinZ% = iLoopZ%
iMaxX% = iLoopX%
iMaxY% = iLoopY%
iMaxZ% = iLoopZ%
' GENERATE OUTPUT
For iLoopZ%
= iMinZ%
To iMaxZ%
sResult
= sResult
+ "-------------------------------------------------------------------------------" + Chr$(13) sResult
= sResult
+ "Map Z=" + cstr$
(iLoopZ%
) + ":" + Chr$(13) sResult
= sResult
+ "-------------------------------------------------------------------------------" + Chr$(13) For iLoopY%
= iMinY%
To iMaxY%
sLine = ""
For iLoopX%
= iMinX%
To iMaxX%
iType% = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Typ
iColor1& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color1
iColor2& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color2
iColor3& = m_arrMap(iLoopX%, iLoopY%, iLoopZ%).Color3
If iType%
= c_iTile_Empty
Then sLine = sLine + " "
sLine = sLine + " "
sLine = sLine + "#"
sResult
= sResult
+ sLine
+ Chr$(13)
sResult
= sResult
+ Chr$(13)
MapToText$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' Return string description for 2.5D movement constants
sDir = "Down"
sDir = "Up"
sDir = "Left"
sDir = "Right"
sDir = "Back"
sDir = "Forward"
sDir = "Unknown"
GetDirection$ = sDir
' /////////////////////////////////////////////////////////////////////////////
CX2I = x - y
' /////////////////////////////////////////////////////////////////////////////
CY2I = (x + y) / 2
' /////////////////////////////////////////////////////////////////////////////
' since we're drawing a diamond and not a square box, we can't use Line BF.
' We have to manually down the 4 points of the line.
Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), iColor
Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), iColor
Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), iColor
Paint (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + 4), iColor
'and fill the diamond solid Line (CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
)-(CX2I
(x2
, y
) + xoffset
, CY2I
(x2
, y
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x2
, y2
) + xoffset
, CY2I
(x2
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y2
) + xoffset
, CY2I
(x
, y2
) + yoffset
), &HFFFFFFFF Line -(CX2I
(x
, y
) + xoffset
, CY2I
(x
, y
) + yoffset
), &HFFFFFFFF
' /////////////////////////////////////////////////////////////////////////////
' Like IsoLine, we're going to have to draw our lines manually.
' only in this case, we also need a Z coordinate to tell us how
' THICK/TALL/HIGH to make our tile
' MODIFIED by madscijr to draw a single tile of height iHeight at Z axis
' MODIFIED by madscijr to accept an alpha& value to control transparency (where 0=fully transparent, 255=opaque)
''Sub IsoLine3D (x, y, x2, y2, z, xoffset, yoffset, iColor As _Unsigned Long)
'Sub IsoLine3D (x, y, x2, y2, z, iHeight, xoffset, yoffset, iColor As _Unsigned Long)
Sub IsoLine3D
(x
, y
, x2
, y2
, z
, iHeight
, xoffset
, yoffset
, iColor
As _Unsigned Long, alpha&
)
' Let's just do all the math first this time.
' We need to turn those 4 normal points into 4 isometric points (x, y, x1, y1)
TempX1 = CX2I(x, y) + xoffset
TempY1 = CY2I(x, y) + yoffset
TempX2 = CX2I(x2, y) + xoffset
TempY2 = CY2I(x2, y) + yoffset
TempX3 = CX2I(x2, y2) + xoffset
TempY3 = CY2I(x2, y2) + yoffset
TempX4 = CX2I(x, y2) + xoffset
TempY4 = CY2I(x, y2) + yoffset
' The top
'fquad TempX1, TempY1 - z, TempX2, TempY2 - z, TempX3, TempY3 - z, TempX4, TempY4 - z, iColor
fquad TempX1
, TempY1
- z
, TempX2
, TempY2
- z
, TempX3
, TempY3
- z
, TempX4
, TempY4
- z
, _RGB32(r
, g
, b
, alpha&
)
' TODO: maybe change which sides gets shaded depending on the direction of the light source?
' draw the left side, shaded 75%
'fquad TempX4, TempY4 - z, TempX4, TempY4 - z + iHeight, TempX3, TempY3 - z + iHeight, TempX3, TempY3 - z, _RGB32(.75 * r, .75 * g, .75 * b)
fquad TempX4
, TempY4
- z
, TempX4
, TempY4
- z
+ iHeight
, TempX3
, TempY3
- z
+ iHeight
, TempX3
, TempY3
- z
, _RGB32(.75 * r
, .75 * g
, .75 * b
, alpha&
)
' draw the right side,s haded 50%
'fquad TempX3, TempY3 - z, TempX3, TempY3 - z + iHeight, TempX2, TempY2 - z + iHeight, TempX2, TempY2 - z, _RGB32(.5 * r, .5 * g, .5 * b)
fquad TempX3
, TempY3
- z
, TempX3
, TempY3
- z
+ iHeight
, TempX2
, TempY2
- z
+ iHeight
, TempX2
, TempY2
- z
, _RGB32(.5 * r
, .5 * g
, .5 * b
, alpha&
) ' no need to draw any height, if there isn't any.
' /////////////////////////////////////////////////////////////////////////////
' found at abandoned, outdated and now likely malicious qb64 dot net website
' don't go there: http://www.qb64.[net]/forum/index.php?topic=14425.0
' /////////////////////////////////////////////////////////////////////////////
' 2019-11-20 Steve saves some time with STATIC
' and saves and restores last dest
' /////////////////////////////////////////////////////////////////////////////
' original fill quad that may be at fault using Steve's fTri version
' need 4 non linear points (not all on 1 line) list them clockwise
' so x2, y2 is opposite of x4, y4
ftri1 x1, y1, x2, y2, x4, y4, K
ftri1 x3, y3, x2, y2, x4, y4, K
' /////////////////////////////////////////////////////////////////////////////
' update 2019-12-16 needs orig fTri
' need 4 non linear points (not all on 1 line)
' list them clockwise so x2, y2 is opposite of x4, y4
ftri x1, y1, x2, y2, x3, y3, K
ftri x3, y3, x4, y4, x1, y1, K
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D RECTANGLE (SOLID)
' Based on DrawBox
'SUB DrawRect (iX%, iY%, iSizeW%, iSizeH%, iColor%)
Sub DrawRect
(iX%
, iY%
, iSizeW%
, iSizeH%
, iColor~&
) Line (iX%
, iY%
)-(iX%
+ iSizeW%
, iY%
+ iSizeH%
), iColor~&
, BF
' Draw a solid box 'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX (SOLID)
' https://www.qb64.org/wiki/LINE
'SUB DrawBox (iX%, iY%, iSize%, iColor%)
Sub DrawBox
(iX%
, iY%
, iSize%
, iColor~&
) Line (iX%
, iY%
)-(iX%
+ iSize%
, iY%
+ iSize%
), iColor~&
, BF
' Draw a solid box 'LINE (iX%, iY%)-(iX% + iSize%, iY% + iSize%), iColor%, BF ' Draw a solid box
'LINE (60, 60)-(130, 100), iColor%, B ' Draw a box outline
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX (OUTLINE)
' https://www.qb64.org/wiki/LINE
' The style parameter 0-255 doesn't seemt to have a solid line?
'SUB DrawStyledOutlineBox (iX%, iY%, iSize%, iColor%, iStyle%)
Sub DrawStyledOutlineBox
(iX%
, iY%
, iSize%
, iColor~&
, iStyle%
) ' LINE [STEP] [(column1, row1)]-[STEP] (column2, row2), color[, [{B|BF}], style%]
' B creates a box outline with each side parallel to the program screen sides. BF creates a filled box.
' The style% signed INTEGER value sets a dotted pattern to draw the line or rectangle outline.
Line (iX%
, iY%
)-(iX%
+ iSize%
, iY%
+ iSize%
), iColor~&
, B
, iStyle%
End Sub ' DrawStyledOutlineBox
' /////////////////////////////////////////////////////////////////////////////
' DRAW A 2-D BOX (OUTLINE) WITH A SOLID LINE
Sub DrawOutlineBox
(iX%
, iY%
, iSize2%
, iColor~&
, iWeight2%
) iSize% = iSize2% - 1
iWeight% = iWeight2% - 1
' TOP LINE
iFromX% = iX%
iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iY%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' BOTTOM LINE
iFromX% = iX%
iFromY% = iY% + iSize%
iToX% = iX% + iSize%
iToY% = iY% + iSize%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' LEFT LINE
iFromX% = iX%
iFromY% = iY%
iToX% = iX%
iToY% = iY% + iSize%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' RIGHT LINE
iFromX% = iX% + iSize%
iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iY% + iSize%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' TOP LINE
For iFromY%
= iY%
To (iY%
+ iWeight%
) iFromX% = iX%
'iFromY% = iY%
iToX% = iX% + iSize%
iToY% = iFromY%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' BOTTOM LINE
For iFromY%
= ((iY%
+ iSize%
) - iWeight%
) To (iY%
+ iSize%
) iFromX% = iX%
'iFromY% = iY% + iSize%
iToX% = iX% + iSize%
iToY% = iFromY%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' LEFT LINE
For iFromX%
= iX%
To (iX%
+ iWeight%
) 'iFromX% = iX%
iFromY% = iY%
iToX% = iFromX%
iToY% = iY% + iSize%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' RIGHT LINE
For iFromX%
= ((iX%
+ iSize%
) - iWeight%
) To (iX%
+ iSize%
) 'iFromX% = iX% + iSize%
iFromY% = iY%
iToX% = iFromX%
iToY% = iY% + iSize%
Line (iFromX%
, iFromY%
)-(iToX%
, iToY%
), iColor~&
, BF
' /////////////////////////////////////////////////////////////////////////////
Function GetPaletteFromColor%
(iColor~&
) GetPaletteFromColor% = 0
GetPaletteFromColor% = 1
GetPaletteFromColor% = 2
GetPaletteFromColor% = 3
GetPaletteFromColor% = 4
GetPaletteFromColor% = 5
GetPaletteFromColor% = 6
GetPaletteFromColor% = 7
GetPaletteFromColor% = 8
GetPaletteFromColor% = 9
GetPaletteFromColor% = 10
GetPaletteFromColor% = 11
GetPaletteFromColor% = 12
GetPaletteFromColor% = 13
GetPaletteFromColor% = 14
GetPaletteFromColor% = 15
GetPaletteFromColor% = 16
GetPaletteFromColor% = 17
GetPaletteFromColor% = 18
GetPaletteFromColor% = 19
GetPaletteFromColor% = 20
GetPaletteFromColor% = 21
GetPaletteFromColor% = 22
GetPaletteFromColor% = 23
GetPaletteFromColor% = 24
GetPaletteFromColor% = 25
GetPaletteFromColor% = 0
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GRAPHICS FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)
' /////////////////////////////////////////////////////////////////////////////
' based on code from:
' Qbasic Programs - Download free bas source code
' http://www.thedubber.altervista.org/qbsrc.htm
Sub DrawTextLine
(x%
, y%
, x2%
, y2%
, c$
) 'bError% = FALSE
'LOCATE 2, 2: PRINT "(" + STR$(x%) + "," + STR$(y%) + ") to (" + STR$(x2%) + "," + STR$(y2%) + ") of " + CHR$(34) + c$ + CHR$(34);
i% = 0
steep% = 0
e1% = 0
steep% = 1
e1% = 2 * dy% - dx%
'PSET (y%, x%), c%:
'PSET (x%, y%), c%
y% = y% + sy%: e1% = e1% - 2 * dx%
x% = x% + sx%: e1% = e1% + 2 * dy%
'PSET (x2%, y2%), c%
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
sResult = ""
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
GetBinary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
' See also: GetBit256%, SetBit256%
'DIM iTemp AS INTEGER
iResult = FALSE
bContinue = TRUE
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
'if any of the bits in iBit are false, return false
iResult = FALSE
bContinue = FALSE
iResult = TRUE
GetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the integer that corresponds to a binary string of length 8
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
iResult
= iResult
+ 2 ^ iLoop
* Val(Mid$(strBinary
, Len(strBinary
) - iLoop
, 1))
GetIntegerFromBinary% = iResult
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsEven% = TRUE
IsEven% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
IsOdd% = TRUE
IsOdd% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
IsNum% = TRUE
IsNum% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
' MWheatley
' « Reply #18 on: January 01, 2019, 11:24:30 AM »
' returns 1 if string is an integer, 0 if not
IsNumber = 1
IsNumber = 0
IsNumber = 0
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
LongABS& = 0 - lngValue
LongABS& = lngValue
' /////////////////////////////////////////////////////////////////////////////
' Writes sText to a debug file in the EXE folder.
' Debug file is named the same thing as the program EXE name with ".txt" at the end.
' For example the program "C:\QB64\MyProgram.BAS" running as
' "C:\QB64\MyProgram.EXE" would have an output file "C:\QB64\MyProgram.EXE.txt".
' If the file doesn't exist, it is created, otherwise it is appended to.
sFileName = ProgramPath$ + ProgramName$ + ".txt"
sError = ""
sOut = ""
sOut
= sOut
+ "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10) sOut
= sOut
+ "PROGRAM : " + ProgramName$
+ Chr$(13) + Chr$(10) sOut
= sOut
+ "RUN DATE: " + CurrentDateTime$
+ Chr$(13) + Chr$(10) sOut
= sOut
+ "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + Chr$(13) + Chr$(10) sError = PrintFile$(sFileName, sOut, FALSE)
sError = PrintFile$(sFileName, sText, TRUE)
Print CurrentDateTime$
+ " PrintDebugFile FAILED: " + sError
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
'x = 1: y = 2: z$ = "Three"
sError = "Error in PrintFile$ : File not found. Cannot append."
Open sFileName
For Output As #1 ' opens and clears an existing file or creates new empty file ' WRITE places text in quotes in the file
'WRITE #1, x, y, z$
'WRITE #1, sText
' PRINT does not put text inside quotes
'PRINT "File created with data. Press a key!"
'K$ = INPUT$(1) 'press a key
'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
'INPUT #2, a, b, c$
'CLOSE #2
'PRINT a, b, c$
'WRITE a, b, c$
PrintFile$ = sError
' /////////////////////////////////////////////////////////////////////////////
' iNum% = PromptForIntegerInRange%("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
Function PromptForIntegerInRange%
(sPrompt$
, iMin%
, iMax%
, iDefault%
)
sPrompt1$ = sPrompt$
sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
sPrompt1$ = Replace$(sPrompt1$, "{min}", cstr$(iMin%))
sPrompt1$ = Replace$(sPrompt1$, "{max}", cstr$(iMax%))
bFinished% = FALSE
If iValue%
>= iMin%
And iValue%
<= iMax%
Then 'bFinished% = TRUE
Print "Number out of range." Print "Not a valid number." iValue% = iDefault%
'bFinished% = TRUE
PromptForIntegerInRange% = iValue%
' /////////////////////////////////////////////////////////////////////////////
' iNum& = PromptForLongInRange&("Please type a number between {min} and {max} (or blank to quit).", 1, 4, 0)
Function PromptForLongInRange&
(sPrompt$
, iMin&
, iMax&
, iDefault&
)
bFinished& = FALSE
sPrompt1$ = sPrompt$
sPrompt1$ = "Please type a number between {min} and {max} (or blank to quit)."
sPrompt1$ = Replace$(sPrompt1$, "{min}", cstrl$(iMin&))
sPrompt1$ = Replace$(sPrompt1$, "{max}", cstrl$(iMax&))
If iValue&
>= iMin&
And iValue&
<= iMax&
Then bFinished& = TRUE
Print "Number out of range." Print "Not a valid number." iValue& = iDefault&
bFinished& = TRUE
PromptForLongInRange& = iValue&
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber%
= Int(Rnd * NumSpread%
) + Min%
' GET RANDOM # BETWEEN Max% AND Min%
' /////////////////////////////////////////////////////////////////////////////
sFileName = "c:\temp\maze_test_1.txt"
sText
= "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random" bAppend = FALSE
sError = PrintFile$(sFileName, sText, bAppend)
bAppend = TRUE
iErrorCount = 0
iMin = 0
iMax = iCols - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
iMin = 0
iMax = iRows - 1
iNum = RandomNumber%(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Print "Finished generating numbers. Errors: " + Str$(iErrorCount
) Print "Error creating file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Input "Press <ENTER> to continue", sInput$
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.qb64.org)
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
' VARIABLES:
Dim lngLocation
As Long ' The address of the [Find] substring within the [Text] string. Dim strBefore
As String ' The characters before the string to be replaced. Dim strAfter
As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation
= InStr(1, Text2
, Find2
)
' PROCESSING:
' While [Find2] appears in [Text2]...
' Extract all Text2 before the [Find2] substring:
strBefore
= Left$(Text2
, lngLocation
- 1)
' Extract all text after the [Find2] substring:
strAfter
= Right$(Text2
, ((Len(Text2
) - (lngLocation
+ Len(Find2
) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation
= InStr(1, Text2
, Find2
)
' Next instance of [Find2]...
' OUTPUT:
Replace$ = Text2
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------"
in$ = "Thiz iz a teZt."
in$ = Replace$(in$, "z", "s")
in$ = Replace$(in$, "Z", "s")
Print "ReplaceTest finished."
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
' See also: GetBit256%, SetBit256%
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
sVal = "1"
sVal = "0"
strResult = ""
strResult = strResult + sVal
strResult
= strResult
+ Mid$(sNum
, iLoop
, 1) iResult = GetIntegerFromBinary%(strResult)
iResult = iNum
SetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split
(in$
, delimiter$
, result$
())
iDelimLen
= Len(delimiter$
)
start = 1
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$
, start
, iDelimLen
) = delimiter$
'start = start + 1
start = start + iDelimLen
finish
= InStr(start
, in$
, delimiter$
)
result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////
Print "-------------------------------------------------------------------------------" Print "SplitAndReplaceTest"
in$
= "This line 1 " + Chr$(13) + Chr$(10) + "and line 2" + Chr$(10) + "and line 3 " + Chr$(13) + "finally THE END."
Print "Fixing linebreaks..."
split in$
, Chr$(13), arrTest$
()
Print "SplitAndReplaceTest finished."
' /////////////////////////////////////////////////////////////////////////////
Input "Press <ENTER> to continue", in$
' /////////////////////////////////////////////////////////////////////////////
' WaitForKey "Press <ESC> to continue", 27, 0
' WaitForKey "Press <ENTER> to begin;", 13, 0
' waitforkey "", 65, 5
Sub WaitForKey
(prompt$
, KeyCode&
, DelaySeconds%
) ' SHOW PROMPT (IF SPECIFIED)
' WAIT FOR KEY
' PAUSE AFTER (IF SPECIFIED)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Receives:
' cycleColor = determines how foreColor, backColor are modified
' foreColor = the foreground color
' backColor = the background color (if needed)
' /////////////////////////////////////////////////////////////////////////////
' DoCycleColor colorScheme%, myColor~&
' colorScheme = color scheme (value is alternated on subsequent calls)
' myColor = the current color (value is incremented/decremented on subsequent calls)
' colorScheme values:
' 1 Rainbow6 #1
' 9 Rainbow6 #2
' 2 Rainbow18 #1
' 10 Rainbow18 #2
' 3 Grayscale #1
' 11 Grayscale #2
' 4 Grayscale #1
' 12 Grayscale #2
' 20 green6 #1
' 21 green6 #2
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' CYCLE FORE COLOR
' 1, 9 = simple rainbow
If colorScheme
= 1 Or colorScheme
= 9 Then myColor = cOrange
myColor = cYellow
myColor = cGreen
myColor = cBlue
myColor = cPurple
myColor = cRed
' 2, 10 = complex rainbow
myColor = cOrangeRed
myColor = cDarkOrange
myColor = cOrange
myColor = cGold
myColor = cYellow
myColor = cOliveDrab1
myColor = cLime
myColor = cMediumSpringGreen
myColor = cCyan
myColor = cDeepSkyBlue
myColor = cDodgerBlue
myColor = cSeaBlue
myColor = cBlue
myColor = cBluePurple
myColor = cDeepPurple
myColor = cPurple
myColor = cPurpleRed
myColor = cRed
' 3, 11 = grayscale, ascending
myColor = cDarkGray
myColor = cDimGray
myColor = cGray
myColor = cLightGray
myColor = cSilver
myColor = cWhite
'myColor = cBlack
myColor = cSilver
' go in the other direction!
colorScheme = 4
colorScheme = 12
' 4, 8, 12 = grayscale, descending
myColor = cSilver
myColor = cLightGray
myColor = cGray
myColor = cDimGray
myColor = cDarkGray
myColor = cBlack
myColor = cDarkGray
' go in the other direction!
colorScheme = 3
colorScheme = 11
'yoda
' =============================================================================
' BEGIN GreenTreeColors 20,21
' =============================================================================
' 20 = GetGreenTreeColors ascending
GetGreenTreeColors ColorArray()
iPos = FindInColorArray%(ColorArray(), myColor, 0)
myColor = ColorArray(iPos+1)
myColor = ColorArray(iPos-1)
colorScheme = 21 ' go in the other direction!
' 21 = GetGreenTreeColors descending
GetGreenTreeColors ColorArray()
iPos = FindInColorArray%(ColorArray(), myColor, 0)
myColor = ColorArray(iPos-1)
myColor = ColorArray(iPos+1)
colorScheme = 20 ' go in the other direction!
' =============================================================================
' END GreenTreeColors 20,21
' =============================================================================
if ColorArray
(iLoop
) = iColor
then bFound = TRUE
FindInColorArray% = iLoop
FindInColorArray% = iDefaultIfNotFound
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR ROUTINES
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' NOTE: these are mostly negative numbers
' and have to be forced to positive
' when stored in the dictionary
' (only cEmpty should be negative)
cOrangeRed
= _RGB32(255, 69, 0)
cDarkOrange
= _RGB32(255, 140, 0)
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
cChartreuse
= _RGB32(127, 255, 0)
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
cOliveDrab1
= _RGB32(192, 255, 62)
cMediumSpringGreen
= _RGB32(0, 250, 154)
cDeepSkyBlue
= _RGB32(0, 191, 255)
cDodgerBlue
= _RGB32(30, 144, 255)
cBluePurple
= _RGB32(64, 0, 255)
cDeepPurple
= _RGB32(96, 0, 255)
cPurpleRed
= _RGB32(128, 0, 192)
cBrickRed
= _RGB32(192, 0, 32)
cDarkGreen
= _RGB32(0, 100, 0)
cOliveDrab
= _RGB32(107, 142, 35)
cLightPink
= _RGB32(255, 182, 193)
cHotPink
= _RGB32(255, 105, 180)
cDeepPink
= _RGB32(255, 20, 147)
cMagenta
= _RGB32(255, 0, 255)
cDimGray
= _RGB32(105, 105, 105)
cDarkGray
= _RGB32(169, 169, 169)
cSilver
= _RGB32(192, 192, 192)
cLightGray
= _RGB32(211, 211, 211)
cGainsboro
= _RGB32(220, 220, 220)
cWhiteSmoke
= _RGB32(245, 245, 245)
cWhite
= _RGB32(255, 255, 255) 'cWhite = _RGB32(254, 254, 254)
cDarkBrown
= _RGB32(128, 64, 0)
cLightBrown
= _RGB32(196, 96, 0)
cKhaki
= _RGB32(240, 230, 140)
'cEmpty~& = -1
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN CUSTOM COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
AddColor ColorArray
(), _RGB32(0, 71, 0) AddColor ColorArray
(), _RGB32(0, 102, 0) AddColor ColorArray
(), _RGB32(0, 153, 0) AddColor ColorArray
(), _RGB32(0, 204, 0) AddColor ColorArray
(), _RGB32(0, 255, 0)
ColorArray
(UBound(ColorArray
)) = iColor
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END CUSTOM COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
KeyCode_CtrlLeft% = 30
KeyCode_CtrlRight% = 286
KeyCode_Y% = 22
KeyCode_Z% = 45
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END KEYBOARD CODE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' #END
' ################################################################################################################################################################
