' #############################################################################
' NOTES:
' https://www.qb64.org/forum/index.php?topic=3949.0
' SpriggsySpriggs:
' To make a console in QB64 you need to use the metacommand $CONSOLE.
' You toggle it ON or OFF with _CONSOLE ON or _CONSOLE OFF.
' _ECHO allows you to output to the window.
' Example:
' $CONSOLE
' _DELAY 4
' _CONSOLE ON
' _ECHO "Window Handle: "; STR$(imgScreen&)
' (etc)
' _CONSOLE OFF
' =============================================================================
' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
' 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
Const c_North
= -3.65 ' 6.28
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
Const MaxVis&
= 15 ' how many squares away you can see (warning: massive performance implications at this stage) Const HardwareOnly&
= 1 ' set to 1 to disable the software "SCREEN" (you will lose PRINTed debugging output but will get performance gains)
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ACTIVATE DEBUGGING WINDOW
'$CONSOLE
'_DELAY 4
'_CONSOLE ON
' =============================================================================
' GLOBAL VARIABLES
'DIM arrMap(16, 16, 16) AS STRING ' z, y, x
Dim iLoopX%
, iLoopY%
, iLoopZ%
' =============================================================================
' INITIALIZE
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' FIND IMAGE FOLDER(S)
Print "ERROR: Could not locate resource files." Print "in the same folder as the program file." Input "Press <ENTER> to exit", i2$
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' SHOW SOME INSTRUCTIONS
Print "Galleon's Mycraft" Print "From: https://www.qb64.org/forum/index.php?topic=1199.0" Print "* Added this instruction screen" Print "* Added ESC key to exit program" Print "* Changed controls to all keyboard, no mouse" Print "* Played with world generation (random + from text map)" Print "* Runs much slower than original - why??" Print "Crsr Left/right... turn right/left" Print "Page Up/Down...... look up/down" Print "Crsr Up........... walk forwards" Print "Crsr Down......... walk backwards" Print "Home.............. move vertically / jump (teleport up 1 square)" Print "End............... move vertically / down?" Print "<Spacebar>........ high jump / fly (teleport up 2 squares)" Print "<ESC>............. quit game" Input "Press <ENTER> to begin", in$
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'$DYNAMIC
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Generate Perlin Noise
' Modified from http://forum.qbasicnews.com/index.php?action=printpage;topic=3459.0
' -generates noise from 0 to 255
' -doesn't use x=0,y=0
' -noise tiles
Iter = 8
BumpFactor = 1.2
CloudWidth% = 2 ^ Iter + 1
CloudHeight% = 2 ^ Iter + 1
Dim Cloud%
(CloudWidth%
, CloudHeight%
) Dim CloudBumpFactor
(CloudWidth%
, CloudHeight%
) As Single
' 1.5=undulating hills (mostly walkable, quite bumpy)
' 2.0=ultra-flat
Dim CloudDirectionBias
(CloudWidth%
, CloudHeight%
) As Single '-0.3 to 0.3 For y
= 0 To CloudHeight%
'1.3=perfect mountains
'1.5=plains
CloudBumpFactor(x, y) = 1.3 '1.4 '+ x * 0.002 '1.2 + x
For y
= 0 To CloudHeight%
CloudDirectionBias(x, y) = 0 '0.3 'x * 0.0008 '1.1 + x * 0.004 '1.2 + x
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Init the corners
Cloud%(1, 1) = 128
Cloud%(1, CloudHeight%) = 128
Cloud%(CloudWidth%, 1) = 128
Cloud%(CloudWidth%, CloudHeight%) = 128
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Init the edges
dx = 2 ^ (Iter - Rank% + 1)
dy = 2 ^ (Iter - Rank% + 1)
Nx% = 2 ^ (Rank% - 1) + 1
Ny% = 2 ^ (Rank% - 1) + 1
x% = (kx - 1) * dx + 1: y% = 1
Alt% = (Cloud%(x%, y%) + Cloud%(x% + dx, y%)) / 2
'zNew% = Bump%(Alt%, Rank%, BumpFactor)
zNew% = Bump%(Alt%, Rank%, CloudBumpFactor(x% + dx / 2, 1), CloudDirectionBias(x% + dx / 2, 1))
Cloud%(x% + dx / 2, 1) = zNew%
Cloud%(x% + dx / 2, CloudHeight%) = zNew%
x% = 1: y% = (ky - 1) * dy + 1
Alt% = (Cloud%(x%, y%) + Cloud%(x%, y% + dy)) / 2
'zNew% = Bump%(Alt%, Rank%, BumpFactor)
zNew% = Bump%(Alt%, Rank%, CloudBumpFactor(1, y% + dy / 2), CloudDirectionBias(1, y% + dy / 2))
Cloud%(1, y% + dy / 2) = zNew%
Cloud%(CloudWidth%, y% + dy / 2) = zNew%
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Fill the clouds
dx = 2 ^ (Iter - Rank% + 1): dy = dx
Nx% = 2 ^ (Rank% - 1) + 1: Ny% = Nx%
x% = (kx - 1) * dx + 1
y% = (ky - 1) * dy + 1
Alt% = (Cloud%(x%, y%) + Cloud%(x% + dx, y%) + Cloud%(x%, y% + dy) + Cloud%(x% + dx, y% + dy)) / 4
Cloud%(x% + dx / 2, y% + dy / 2) = Bump%(Alt%, Rank%, CloudBumpFactor(x% + dx / 2, y% + dy / 2), CloudDirectionBias(x% + dx / 2, y% + dy / 2))
Alt% = (Cloud%(x%, y%) + Cloud%(x% + dx, y%)) / 2
If y%
<> 1 Then Cloud%
(x%
+ dx
/ 2, y%
) = Bump%
(Alt%
, Rank%
, CloudBumpFactor
(x%
+ dx
/ 2, y%
), CloudDirectionBias
(x%
+ dx
/ 2, y%
)) Alt% = (Cloud%(x%, y%) + Cloud%(x%, y% + dy)) / 2
If x%
<> 1 Then Cloud%
(x%
, y%
+ dy
/ 2) = Bump%
(Alt%
, Rank%
, CloudBumpFactor
(x%
, y%
+ dy
/ 2), CloudDirectionBias
(x%
, y%
+ dy
/ 2)) Alt% = (Cloud%(x% + dx, y%) + Cloud%(x% + dx, y% + dy)) / 2
If (x%
+ dx
) <> CloudWidth%
Then Cloud%
(x%
+ dx
, y%
+ dy
/ 2) = Bump%
(Alt%
, Rank%
, CloudBumpFactor
(x%
+ dx
, y%
+ dy
/ 2), CloudDirectionBias
(x%
+ dx
, y%
+ dy
/ 2)) Alt% = (Cloud%(x%, y% + dy) + Cloud%(x% + dx, y% + dy)) / 2
If (y%
+ dy
) <> CloudHeight%
Then Cloud%
(x%
+ dx
/ 2, y%
+ dy
) = Bump%
(Alt%
, Rank%
, CloudBumpFactor
(x%
+ dx
/ 2, y%
+ dy
), CloudDirectionBias
(x%
+ dx
/ 2, y%
+ dy
)) For y
= 0 To CloudHeight%
MapLimitX = CloudWidth% - 1 ' 256
MapLimitY = CloudHeight% - 1 ' 256
MapLimitZ = 100
'_ECHO "MapLimitX=" + cstrl$(MapLimitX)
'_ECHO "MapLimitY=" + cstrl$(MapLimitY)
'_ECHO "MapLimitZ=" + cstrl$(MapLimitZ)
'WaitForEnter
TexLast = 0
Dim Shared Tex
(1000, 15, 3) As Long 'handle, brightness, hue-specific to time of day
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' DEFAULT STARTING LOCATION
PX = 73
PY = 78
PZ = 2 ' start at ground level
'PZ = 70
' DEFAULT STARTING ORIENTATION
ax = c_North ' direction player is pointing
ay = 0 ' viewing angle (up/down)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'TYPE BoxType
' left AS LONG
' right AS LONG
' top AS LONG
' bottom AS LONG
' front AS LONG
' back AS LONG
'END TYPE ' BoxType
'DIM SHARED Box(1000) AS BoxType
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' load textures
grass = LoadTexture("grass")
water = LoadTexture("water")
'I = 0
'I = I + 1
'h = grass
'Box(I).left = h
'Box(I).right = h
'Box(I).top = h
'Box(I).bottom = h
'Box(I).front = h
'Box(I).back = h
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' VARIABLES THAT HOLD THE WORLD
Dim Blk
(-1 To MapLimitX
+ 1, -1 To MapLimitY
+ 1, -1 To MapLimitZ
+ 1) As MapBlockType
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' place bottom layer (a single layer of "rock" which cannot be crossed)
z = 0
Blk(x, y, z).Typ = 1: boxcount = boxcount + 1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim GM
(-1 To MapLimitX
+ 1, -1 To MapLimitY
+ 1)
' get GM
h = Cloud%(x + 1, y + 1) \ 4 + 30
GM(x, y) = h
' despeckle "pinacles"
h = GM(x, y)
c = 0
c2 = 0
h2 = GM(x2, y2)
GM(x, y) = GM(x, y) - 1
'END
'GM(x, y) = 2
GM(x, y) = GM(x, y) + 1
wl = 128 \ 4 + 30 - 3 ' result = 59
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' place "dirt"
zz = GM(x, y)
Blk(x, y, z).Typ = 1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' place water
zz = GM(x, y)
Blk(x, y, wl).Typ = 2
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN CLEAR WORLD
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' z=0 = floor, layer of rock
Blk(x, y, z).Typ = 0
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END CLEAR WORLD
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN TEMP DRAW WORLD #1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' 0 = air
' 1 = dirt
' 2 = water
'FOR z = 0 TO MapLimitZ
For z
= 16 To (MapLimitZ
- 16) 'iNum% = RandomNumber%(1, 10)
'if iNum% > 7 then
iNum% = RandomNumber%(1, 20)
bFound = FALSE
' IS THERE A BLOCK UNDERNEATH?
If Blk
(x
, y
, z
- 1).Typ
= 1 Then bFound = TRUE
' IS THERE A BLOCK ADJACENT?
If Blk
(x
- 1, y
, z
).Typ
= 1 Then bFound = TRUE
If Blk
(x
+ 1, y
, z
).Typ
= 1 Then bFound = TRUE
If Blk
(x
, y
- 1, z
).Typ
= 1 Then bFound = TRUE
If Blk
(x
, y
+ 1, z
).Typ
= 1 Then bFound = TRUE
'iNum% = RandomNumber%(1, 10)
iNum% = RandomNumber%(1, 20)
'if iNum% > 4 then
Blk(x, y, z).Typ = 1
Blk(x, y, z).Typ = 0
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END TEMP DRAW WORLD #1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN TEMP DRAW WORLD #2 (draw pillars of varying height every 8 squares)
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' 0 = air
' 1 = dirt
' 2 = water
iCount = 0
iCount = iCount + 2
iCount = 0
Blk(x, y, z).Typ = 1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END TEMP DRAW WORLD #2
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN CLEAR SPACE AROUND #3
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
x = (iLoopX% + 62)
y = (iLoopY% + 62)
Blk(x, y, z).Typ = 0
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END CLEAR SPACE AROUND #3
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN TEMP DRAW WORLD #3 (defined in GetPyramidMap16x16$ and GetNextMapArray)
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
'DIM arrMap(16, 16) AS STRING ' y, x
'DIM iLoopX%, iLoopY%, iLoopZ%
'PRINT "ubound(arrMap,1 ) = " + STR$(UBOUND(arrMap, 1))
'PRINT "ubound(arrMap,2 ) = " + STR$(UBOUND(arrMap, 2))
'PRINT "ubound(arrMap,3 ) = " + STR$(UBOUND(arrMap, 2))
''FOR z = 0 TO MapLimitZ
'FOR iLoopZ% = LBOUND(arrNextObject, 1) TO UBOUND(arrNextObject, 1)
' GET SLICE OF MAP FOR THE CURRENT LEVEL (iLoopZ%)
GetNextMapArray arrMap(), iLoopZ%
x = (iLoopX% + 64)
y = (iLoopY% + 64)
z = iLoopZ%
If arrMap
(iLoopY%
, iLoopX%
) = "#" Then Blk(x, y, z).Typ = 1
PX = x
PY = y
PZ = z + 1 ' for player we use z+1 for some reason
ax = c_North ' direction player is pointing
PX = x
PY = y
PZ = z + 1 ' for player we use z+1 for some reason
ax = c_South ' direction player is pointing
PX = x
PY = y
PZ = z + 1 ' for player we use z+1 for some reason
ax = c_West ' direction player is pointing
PX = x
PY = y
PZ = z + 1 ' for player we use z+1 for some reason
ax = c_East ' direction player is pointing
Blk(x, y, z).Typ = 0
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END TEMP DRAW WORLD #3
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
zrange = 10
For basez
= 1 To MapLimitZ
- zrange
- 50 For I
= 1 To (MapLimitX
* MapLimitY
) * 10 x
= Int(Rnd * (MapLimitX
+ 1)) y
= Int(Rnd * (MapLimitY
+ 1)) z
= basez
+ Int(Rnd * (10)) 'cannot replace lowest layer
'''IF Blk(x, y, z).Typ = 0 AND Blk(x, y, z - 1).Typ <> 0 THEN
n = 0
dist
= Abs(x2
- x
) + Abs(y2
- y
) + Abs(z2
- z
) x3 = x2: y3 = y2: z3 = z2
MapOffset x3, y3, z3
If Blk
(x3
, y3
, z3
).Typ
> 0 Then n = n + 1
Blk(x, y, z).Typ = 1: boxcount = boxcount + 1
If z
> highestz
Then highestz
= z
'''END IF
' fill map till top reached
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' assess visibility
visible = 0
If Blk
(x2
, y
, z
).Typ
<> 1 Then visible
= 1 If Blk
(x
, y2
, z
).Typ
<> 1 Then visible
= 1 If Blk
(x
, y
, z2
).Typ
<> 1 Then visible
= 1
Blk(x, y, z).Vis = 1: viscount = viscount + 1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' assess lighting offsets
If Blk
(x
, y
, z
).Vis
Then 'it is visible count = 0
If Blk
(x2
, y2
, z2
).Typ
<> 0 Then count
= count
+ 1 Blk(x, y, z).Lit = -count / 2
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
zz = -10
TOD = 0
'gun32 = _LOADIMAGE("items\gun1.png", 32)
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' sets of vertexes for scaling/rotation/etc
Dim Shared VertexCount
As Long 'the number of vertices to apply an operation to VertexLast = 0
Dim Shared TriangleSource
As Long 'the base index of the first triangle's vertex
TriangleLast = 0
Dim Shared TriangleCount
As Long 'the number of triangles to apply an operation to
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' add object
tex = gun
p = VertexLast
t = TriangleLast
d = 1
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' convert 2D image into a 3D object by giving it depth
' place image onto a canvas which has an extra unit on each size
tex = gun32
x1 = x - 1
y1 = y - 1
bp = p
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 2
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 4
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1: VertexZ(p) = 0
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1 + 1: VertexY(p) = -y1: VertexZ(p) = 0
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1 + 1: VertexY(p) = -y1: VertexZ(p) = d
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1: VertexZ(p) = d
VertexTX(p) = x1: VertexTY(p) = y1
x1 = x - 1
y1 = y - 1
bp = p
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 2
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 4
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1: VertexZ(p) = 0
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1: VertexZ(p) = d
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1 - 1: VertexZ(p) = d
VertexTX(p) = x1: VertexTY(p) = y1
p = p + 1: VertexX(p) = x1: VertexY(p) = -y1 - 1: VertexZ(p) = 0
VertexTX(p) = x1: VertexTY(p) = y1
itemPicture = I
bp = p
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 2
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 1
t = t + 1: TriangleVertex(t) = bp + 3
t = t + 1: TriangleVertex(t) = bp + 4
p = p + 1: VertexX(p) = 0: VertexY(p) = 0: VertexZ(p) = oz
VertexTX(p) = -0.49: VertexTY(p) = -0.49
p = p + 1: VertexX(p) = tx: VertexY(p) = 0: VertexZ(p) = oz
VertexTX(p) = tx - 1 + 0.49: VertexTY(p) = -0.49
p = p + 1: VertexX(p) = tx: VertexY(p) = -ty: VertexZ(p) = oz
VertexTX(p) = tx - 1 + 0.49: VertexTY(p) = ty - 1 + 0.49
p = p + 1: VertexX(p) = 0: VertexY(p) = -ty: VertexZ(p) = oz
VertexTX(p) = -0.49: VertexTY(p) = ty - 1 + 0.49
VertexCount = p - VertexLast
TriangleCount = (t - TriangleLast) \ 3
m = 1
Model(m).VertexCount = VertexCount
Model(m).FirstVertex = VertexLast + 1
Model(m).TriangleCount = TriangleCount
Model(m).FirstTriangle = TriangleLast + 1
VertexLast = p
TriangleLast = t
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN MAIN GAME LOOP
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ET = T# - ETT
ETT = T#
TOD = TOD + ET
If TOD
>= 24 Then TOD
= TOD
- 24
'LOCATE 1, 1
'PRINT TOD
'PRINT boxcount, viscount
'PRINT zz
'PRINT PX, PY, PZ
'PRINT OX, OY, oz
x = OX
y = OY
z = oz
MapOffset x, y, z
'PRINT x, y, z, "!"
nn = 0
' opaque pass
For mapz
= oz
+ MaxVis
To oz
- MaxVis
Step -1 For mapx
= OX
- MaxVis
To OX
+ MaxVis
For mapy
= OY
- MaxVis
To OY
+ MaxVis
x = mapx
y = mapy
z = mapz
MapOffset x, y, z
typ = Blk(x, y, z).Typ
DrawCube mapx - PX, mapz - PZ, mapy - PY, typ, Blk(x, y, z).Lit
' semi-tranparent pass
'_DEPTHBUFFER LOCK
For mapz
= oz
- MaxVis
To oz
+ MaxVis
For mapx
= OX
- MaxVis
To OX
+ MaxVis
For mapy
= OY
- MaxVis
To OY
+ MaxVis
x = mapx
y = mapy
z = mapz
MapOffset x, y, z
typ = Blk(x, y, z).Typ
DrawCube mapx - PX, mapz - PZ, mapy - PY, typ, Blk(x, y, z).Lit
' draw object(s)
' preserve offsets of permanent content
oldVertexLast = VertexLast
oldTriangleLast = TriangleLast
VertexSource = Model(1).FirstVertex
TriangleSource = Model(1).FirstTriangle
TriangleCount = Model(1).TriangleCount
VertexCount = Model(1).VertexCount
TriangleSource = TriangleLast + 1
VertexSource = VertexLast + 1
CopyModel (1)
tex = gun
' orient pointing forwards
VertexRotateXZ_YZ -90, 0
' scale
VertexScale 0.1 * 0.7 * 2
' move to right hand
VertexTranslate 1, 0, -2 - 0.5
' render the objects
For t
= TriangleSource
To TriangleSource
+ TriangleCount
* 3 - 3 Step 3 p1 = TriangleVertex(t)
p2 = TriangleVertex(t + 1)
p3 = TriangleVertex(t + 2)
_MapTriangle (VertexTX
(p1
), VertexTY
(p1
))-(VertexTX
(p2
), VertexTY
(p2
))-(VertexTX
(p3
), VertexTY
(p3
)), tex
To(VertexX
(p1
), VertexY
(p1
), VertexZ
(p1
))-(VertexX
(p2
), VertexY
(p2
), VertexZ
(p2
))-(VertexX
(p3
), VertexY
(p3
), VertexZ
(p3
))
bMove = FALSE
' -----------------------------------------------------------------------------
' move vertically
ms! = 0.1
'IF _KEYDOWN(ASC("q")) THEN
PZ = PZ + ms! * 4
'bMove = TRUE
'IF _KEYDOWN(ASC("z")) THEN
PZ = PZ - ms! * 4
'bMove = TRUE
oPX = PX: oPY = PY: oPZ = PZ
' -----------------------------------------------------------------------------
' SPACE = JUMP
' c_iKeyDown_Spacebar
'k$ = INKEY$
'IF k$ = " " THEN 'jump (teleport up 2 squares)
PZ = PZ + 2
'bMove = TRUE
' -----------------------------------------------------------------------------
' walk forwards
'IF _KEYDOWN(ASC("w")) THEN
'PZ = PZ + SIN(ay) * ms!
'bMove = TRUE
' -----------------------------------------------------------------------------
' walk backwards
'IF _KEYDOWN(ASC("s")) THEN
'PZ = PZ - SIN(ay) * ms!
'bMove = TRUE
' -----------------------------------------------------------------------------
' get coordinates
bMove = TRUE
' -----------------------------------------------------------------------------
PZ = PZ - 1 * ms!
MapOffset x, y, z
t = Blk(x, y, z).Typ
'PX = oPX
'PY = oPY
'PZ = oPZ
' calculate x/y/z dist to adjacent blocks
' check z movement
newpx! = PX
newpy! = PY
newpz! = PZ
PX = oPX
PY = oPY
PZ = newpz!
' IF PX >= 0 THEN
dx1! = ox!
dx2! = 1 - ox!
' ELSE
' dx2! = ox!
' dx1! = 1 - ox!
' END IF
' IF PY >= 0 THEN
dy1! = oy!
dy2! = 1 - oy!
' ELSE
' dy2! = oy!
' dy1! = 1 - oy!
' END IF
' IF PZ >= 0 THEN
dz1! = oz!
dz2! = 1 - oz!
' ELSE
' dz2! = oz!
' dz1! = 1 - oz!
' END IF
'PRINT
'PRINT PX; PY; PZ
'PRINT dx1!; dx2!; dy1!; dy2!; dz1!; dz2!;
'PRINT
relevant = 0
If z2
= z
Then relevant
= 0 ' if we are already in the square--too bad!
'IF z2 <> z THEN
'check z relevance
'relvant = 0
'IF relevant THEN PRINT z2
relevant = 0
' check if location should be checked
dx! = 0
dy! = 0
relevant = 1
'PRINT "["; x2 - x; ","; y2 - y; "]";
relevant = 1
'END IF
x3 = x2: y3 = y2: z3 = z2
MapOffset x3, y3, z3
t2 = Blk(x3, y3, z3).Typ
'PZ = oPZ
newpz! = oPZ
PX = newpx!
PY = oPY
PZ = newpz!
' IF PX >= 0 THEN
dx1! = ox!
dx2! = 1 - ox!
' ELSE
' dx2! = ox!
' dx1! = 1 - ox!
' END IF
' IF PY >= 0 THEN
dy1! = oy!
dy2! = 1 - oy!
' ELSE
' dy2! = oy!
' dy1! = 1 - oy!
' END IF
' IF PZ >= 0 THEN
dz1! = oz!
dz2! = 1 - oz!
' ELSE
' dz2! = oz!
' dz1! = 1 - oz!
' END IF
z2 = z
relevant = 0
relevant = 0
' check if location should be checked
dz! = 0
dy! = 0
relevant = 1
relevant = 1
x3 = x2: y3 = y2: z3 = z2
MapOffset x3, y3, z3
t2 = Blk(x3, y3, z3).Typ
'PX = oPX
newpx! = oPX
PX = newpx!
PY = newpy!
PZ = newpz!
' IF PX >= 0 THEN
dx1! = ox!
dx2! = 1 - ox!
' ELSE
' dx2! = ox!
' dx1! = 1 - ox!
' END IF
' IF PY >= 0 THEN
dy1! = oy!
dy2! = 1 - oy!
' ELSE
' dy2! = oy!
' dy1! = 1 - oy!
' END IF
' IF PZ >= 0 THEN
dz1! = oz!
dz2! = 1 - oz!
' ELSE
' dz2! = oz!
' dz1! = 1 - oz!
' END IF
z2 = z
relevant = 0
relevant = 0
' check if location should be checked
dz! = 0
dx! = 0
relevant = 1
relevant = 1
x3 = x2: y3 = y2: z3 = z2
MapOffset x3, y3, z3
t2 = Blk(x3, y3, z3).Typ
'PY = oPY
newpy! = oPY
PX = newpx!
PY = newpy!
PZ = newpz!
'DO WHILE _MOUSEINPUT
' mmx = mmx + _MOUSEMOVEMENTX
' mmy = mmy + _MOUSEMOVEMENTY
'LOOP
'PRINT mmx, mmy
'
'ax = mmx / 100
'ay = -mmy / 400
'
'my = _MOUSEY
'MX = _MOUSEX
' -----------------------------------------------------------------------------
' turn left
ax = ax - 0.05
ax = 6.28
'bMove = TRUE
' -----------------------------------------------------------------------------
' turn right
ax = ax + 0.05
ax = -6.28
'bMove = TRUE
' -----------------------------------------------------------------------------
' turn up
ay = ay - 0.05
ay = -1.65
'bMove = TRUE
' -----------------------------------------------------------------------------
' turn down
ay = ay + 0.05
ay = 1.65
'bMove = TRUE
'' ****************************************************************************************************************************************************************
'' SHOW COORDS IN DEBUG WINDOW
'IF bMove = TRUE THEN
' _ECHO "x=" + cstr$(x) + " " + "y=" + cstr$(y) + " " + "z=" + cstr$(z) + " " + "ax=" + cstrs$(ax) + " " + "ay=" + cstrs$(ay)
'END IF
'' ****************************************************************************************************************************************************************
' -----------------------------------------------------------------------------
'_LIMIT 120
VertexLast = oldVertexLast
TriangleLast = oldTriangleLast
'imgScreen& = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
'SCREEN imgScreen&
' -----------------------------------------------------------------------------
' SHOW COORDINATES ON SCREEN
'_DEST imgScreen&
'LOCATE 2, 2 : PRINT " ax=" + cstrs$(ax)
'LOCATE 2, 2 : PRINT " ay=" + cstrs$(ay)
'_ECHO "ax=" + cstrs$(ax) + " " + "ay=" + cstrs$(ay)
' -----------------------------------------------------------------------------
' ESC = QUIT
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END MAIN GAME LOOP
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' =============================================================================
' FINISH
'' -----------------------------------------------------------------------------
'' DEACTIVATE DEBUGGING WINDOW
'_CONSOLE OFF
System ' return control to the operating system Print ProgramName$
+ " finished."
' ################################################################################################################################################################
' BEGIN WORLD ROUTINES
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
m$ = ""
' 1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111222222222222222222222222222222222222222222222222222222222
' 1111111111222222222233333333334444444444555555555566666666667777777777888888888899999999990000000000111111111122222222223333333333444444444455555555556666666666777777777788888888889999999999000000000011111111112222222222333333333344444444445555555
' 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456
m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) GetBlankMap16x16$ = m$
' /////////////////////////////////////////////////////////////////////////////
' air: 0
' dirt : Blk(x, y, z).Typ = 1
' water: Blk(x, y, wl).Typ = 2
' TEXT VALUE MAP TYPE COMMENT
' . 46 0 open space can move freely
' G 71 ? grass can walk on
' ~ 126 2 water can move freely through
' # 35 1 rock grass
' % 37 stone (not in use yet)
' S 83 sand (not in use yet)
' W 88 wood (not in use yet)
' @ 64 lava (not in use yet)
' ^ 94 player facing north starting position of player
' v 118 player facing south starting position of player
' < 60 player facing west starting position of player
' > 62 player facing east starting position of player
' Receives iY% = which level to return map for
' Returns string with map for level iY%
' delimited by CHR$(13)
m$ = ""
m$
= m$
+ "................" + Chr$(13) m$
= m$
+ ".####......####." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".#.....^......#." + Chr$(13) m$
= m$
+ ".#............#." + Chr$(13) m$
= m$
+ ".##############." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "..####....####.." + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "..#..........#.." + Chr$(13) m$
= m$
+ "..###..##..###.." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "...####..####..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...##########..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...#........#..." + Chr$(13) m$
= m$
+ "...##########..." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "....########...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....#......#...." + Chr$(13) m$
= m$
+ "....########...." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ ".....######....." + Chr$(13) m$
= m$
+ ".....######....." + Chr$(13) m$
= m$
+ ".....###.##....." + Chr$(13) m$
= m$
+ ".....######....." + Chr$(13) m$
= m$
+ ".....######....." + Chr$(13) m$
= m$
+ ".....######....." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "......####......" + Chr$(13) m$
= m$
+ "......##.#......" + Chr$(13) m$
= m$
+ "......####......" + Chr$(13) m$
= m$
+ "......####......" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ ".......#........" + Chr$(13) m$
= m$
+ ".......##......." + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) m$
= m$
+ "................" + Chr$(13) GetPyramidMap16x16$ = m$
' /////////////////////////////////////////////////////////////////////////////
' VIRTUAL WORLD v1
GetMap$ = GetPyramidMap16x16$(iY%)
' /////////////////////////////////////////////////////////////////////////////
' Receives:
' byref arrMap1 = 2D map array of string
' iY% = which level to return map for
' Returns 2D array with map for level iY%
in$ = GetMap$(iY%)
split in$, delim$, arrLines$()
'PRINT "arrLines$(" + LTRIM$(RTRIM$(STR$(iRow%))) + ") = " + CHR$(34) + arrLines$(iRow%) + CHR$(34)
sChar$
= Mid$(arrLines$
(iRow%
), iCol%
, 1) arrMap1(iRow%, iCol%) = sChar$
' Exit if out of bounds
' Exit if out of bounds
' ################################################################################################################################################################
' END WORLD ROUTINES
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////////////////////////
''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
' /////////////////////////////////////////////////////////////////////////////
Function IIF
(Condition
, IfTrue
, IfFalse
)
' /////////////////////////////////////////////////////////////////////////////
Function IIFSTR$
(Condition
, IfTrue$
, IfFalse$
) If Condition
Then IIFSTR$
= IfTrue$
Else IIFSTR$
= IfFalse$
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
sResult = ""
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
GetBinary$ = sResult
' /////////////////////////////////////////////////////////////////////////////
' wonderfully inefficient way to read if a bit is set
' ival = GetBit256%(int we are comparing, int containing the bits we want to read)
' See also: GetBit256%, SetBit256%
'DIM iTemp AS INTEGER
iResult = FALSE
bContinue = TRUE
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
'if any of the bits in iBit are false, return false
iResult = FALSE
bContinue = FALSE
iResult = TRUE
GetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the integer that corresponds to a binary string of length 8
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
iResult
= iResult
+ 2 ^ iLoop
* Val(Mid$(strBinary
, Len(strBinary
) - iLoop
, 1))
GetIntegerFromBinary% = iResult
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
IsNum% = TRUE
IsNum% = FALSE
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
result$ = result$ + delimiter$ + in$(i)
join$ = result$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
LongABS& = 0 - lngValue
LongABS& = lngValue
' /////////////////////////////////////////////////////////////////////////////
' Returns blank if successful else returns error message.
'x = 1: y = 2: z$ = "Three"
sError = "Error in PrintFile$ : File not found. Cannot append."
Open sFileName
For Output As #1 ' opens and clears an existing file or creates new empty file ' WRITE places text in quotes in the file
'WRITE #1, x, y, z$
'WRITE #1, sText
' PRINT does not put text inside quotes
'PRINT "File created with data. Press a key!"
'K$ = INPUT$(1) 'press a key
'OPEN sFileName FOR INPUT AS #2 ' opens a file to read it
'INPUT #2, a, b, c$
'CLOSE #2
'PRINT a, b, c$
'WRITE a, b, c$
PrintFile$ = sError
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber%
= Int(Rnd * NumSpread%
) + Min%
' GET RANDOM # BETWEEN Max% AND Min%
' /////////////////////////////////////////////////////////////////////////////
sFileName = "c:\temp\maze_test_1.txt"
sText
= "Count" + Chr$(9) + "Min" + Chr$(9) + "Max" + Chr$(9) + "Random" bAppend = FALSE
sError = PrintFile$(sFileName, sText, bAppend)
bAppend = TRUE
iErrorCount = 0
iMin = 0
iMax = iCols - 1
iNum = RandomNumber(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
iMin = 0
iMax = iRows - 1
iNum = RandomNumber(iMin, iMax)
sError = PrintFile$(sFileName, sText, bAppend)
iErrorCount = iErrorCount + 1
Print " " + "Could not write to file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Print "Finished generating numbers. Errors: " + Str$(iErrorCount
) Print "Error creating file " + Chr$(34) + sFileName
+ Chr$(34) + "."
Input "Press <ENTER> to continue", sInput$
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there])
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
' VARIABLES:
Dim lngLocation
As Long ' The address of the [Find] substring within the [Text] string. Dim strBefore
As String ' The characters before the string to be replaced. Dim strAfter
As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation
= InStr(1, Text2
, Find2
)
' PROCESSING:
' While [Find2] appears in [Text2]...
' Extract all Text2 before the [Find2] substring:
strBefore
= Left$(Text2
, lngLocation
- 1)
' Extract all text after the [Find2] substring:
strAfter
= Right$(Text2
, ((Len(Text2
) - (lngLocation
+ Len(Find2
) - 1))))
' Return the substring:
Text2 = strBefore + Add2 + strAfter
' Locate the next instance of [Find2]:
lngLocation
= InStr(1, Text2
, Find2
)
' Next instance of [Find2]...
' OUTPUT:
Replace$ = Text2
' /////////////////////////////////////////////////////////////////////////////
' fantastically inefficient way to set a bit
' example use: arrMaze(iX, iY) = SetBit256%(arrMaze(iX, iY), cS, FALSE)
' See also: GetBit256%, SetBit256%
' newint=SetBit256%(oldint, int containing the bits we want to set, value to set them to)
sNum = GetBinary$(iNum)
sBit = GetBinary$(iBit)
sVal = "1"
sVal = "0"
strResult = ""
strResult = strResult + sVal
strResult
= strResult
+ Mid$(sNum
, iLoop
, 1) iResult = GetIntegerFromBinary%(strResult)
iResult = iNum
SetBit256% = iResult
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM »
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
Sub split
(in$
, delimiter$
, result$
()) start = 1
start = start + 1
finish
= InStr(start
, in$
, delimiter$
) result$
(UBound(result$
)) = Mid$(in$
, start
, finish
- start
) start = finish + 1
' /////////////////////////////////////////////////////////////////////////////
in$ = "this" + delim$ + "is" + delim$ + "a" + delim$ + "test"
split in$, delim$, arrTest$()
Print "Split test finished."
' /////////////////////////////////////////////////////////////////////////////
Input "Press <ENTER> to continue", in$
' /////////////////////////////////////////////////////////////////////////////
' WaitForKey "Press <ESC> to continue", 27, 0
' WaitForKey "Press <ENTER> to begin;", 13, 0
' waitforkey "", 65, 5
Sub WaitForKey
(prompt$
, KeyCode&
, DelaySeconds%
) ' SHOW PROMPT (IF SPECIFIED)
' WAIT FOR KEY
' PAUSE AFTER (IF SPECIFIED)
' /////////////////////////////////////////////////////////////////////////////
size = 1
vert(i).x = x: vert(i).y = y: vert(i).z = z
If i
> 4 Then vert
(i
).y
= vert
(i
).y
+ size
If i
= 2 Or i
= 3 Or i
= 6 Or i
= 7 Then vert
(i
).x
= vert
(i
).x
+ size
If i
= 3 Or i
= 4 Or i
= 7 Or i
= 8 Then vert
(i
).z
= vert
(i
).z
+ size
' rotate verticies horizontally x/z
x = vert(i).x
z = vert(i).z
x2 = SINax * z + x * COSax
z2 = COSax * z - SINax * x
x = x2
z = z2
vert(i).x = x
vert(i).z = z
y = vert(i).y
z = vert(i).z
y2 = SINay * z + y * COSay
z2 = COSay * z - SINay * y
y = y2
z = z2
vert(i).y = y
vert(i).z = z
'base:
'1-2
'| |
'4-3
'top:
'5-6
'| |
'8-7
i = 0
' front
i = i + 1
side(i).p1.p = vert(8)
side(i).p2.p = vert(7)
side(i).p3.p = vert(3)
side(i).p4.p = vert(4)
' right
i = i + 1
side(i).p1.p = vert(7)
side(i).p2.p = vert(6)
side(i).p3.p = vert(2)
side(i).p4.p = vert(3)
' back
i = i + 1
side(i).p1.p = vert(6)
side(i).p2.p = vert(5)
side(i).p3.p = vert(1)
side(i).p4.p = vert(2)
' left
i = i + 1
side(i).p1.p = vert(5)
side(i).p2.p = vert(8)
side(i).p3.p = vert(4)
side(i).p4.p = vert(1)
' top
i = i + 1
side(i).p1.p = vert(5)
side(i).p2.p = vert(6)
side(i).p3.p = vert(7)
side(i).p4.p = vert(8)
' bottom
i = i + 1
side(i).p1.p = vert(4)
side(i).p2.p = vert(3)
side(i).p3.p = vert(2)
side(i).p4.p = vert(1)
b = 1
'IF i = 1 THEN t = Box(b).front
'IF i = 2 THEN t = Box(b).right
'IF i = 3 THEN t = Box(b).back
'IF i = 4 THEN t = Box(b).left
'IF i = 5 THEN t = Box(b).top
'IF i = 6 THEN t = Box(b).bottom
l = lit - i
t = Tex(typ, 15 + l, 0)
_MapTriangle _Clockwise
(0, 0)-(63, 0)-(63, 63), t
To(side
(i
).p1.p.x
, side
(i
).p1.p.y
, side
(i
).p1.p.z
)-(side
(i
).p2.p.x
, side
(i
).p2.p.y
, side
(i
).p2.p.z
)-(side
(i
).p3.p.x
, side
(i
).p3.p.y
, side
(i
).p3.p.z
), , _SmoothShrunk _MapTriangle _Clockwise
(0, 0)-(63, 63)-(0, 63), t
To(side
(i
).p1.p.x
, side
(i
).p1.p.y
, side
(i
).p1.p.z
)-(side
(i
).p3.p.x
, side
(i
).p3.p.y
, side
(i
).p3.p.z
)-(side
(i
).p4.p.x
, side
(i
).p4.p.y
, side
(i
).p4.p.z
), , _SmoothShrunk _MapTriangle (0, 0)-(63, 0)-(63, 63), t
To(side
(i
).p1.p.x
, side
(i
).p1.p.y
, side
(i
).p1.p.z
)-(side
(i
).p2.p.x
, side
(i
).p2.p.y
, side
(i
).p2.p.z
)-(side
(i
).p3.p.x
, side
(i
).p3.p.y
, side
(i
).p3.p.z
), , _SmoothShrunk _MapTriangle (0, 0)-(63, 63)-(0, 63), t
To(side
(i
).p1.p.x
, side
(i
).p1.p.y
, side
(i
).p1.p.z
)-(side
(i
).p3.p.x
, side
(i
).p3.p.y
, side
(i
).p3.p.z
)-(side
(i
).p4.p.x
, side
(i
).p4.p.y
, side
(i
).p4.p.z
), , _SmoothShrunk
' /////////////////////////////////////////////////////////////////////////////
TexLast = TexLast + 1
T = TexLast
path$ = "blocks\"
Print path$
+ filename$
+ ".png" For TOD
= 0 To 3 'time of day (will support sunrise & sunset) '_DEST i2
'LOCATE 1, 1
'PRINT l;
'PRINT tod;
LoadTexture = TexLast
' /////////////////////////////////////////////////////////////////////////////
x
= x
Mod (MapLimitX
+ 1) x
= ((MapLimitX
+ 1) - ((-x
) * -1)) Mod (MapLimitX
+ 1) y
= y
Mod (MapLimitY
+ 1) y
= ((MapLimitY
+ 1) - ((-y
) * -1)) Mod (MapLimitY
+ 1) z = 0
z = MapLimitZ
' /////////////////////////////////////////////////////////////////////////////
Function Bump%
(Alt%
, Rank%
, BumpFactor
, Bias
) dAlt = r / (BumpFactor ^ Rank%) * Alt%
' /////////////////////////////////////////////////////////////////////////////
Sub VertexTranslate
(x
, y
, z
) For p
= VertexSource
To VertexSource
+ VertexCount
- 1 VertexX(p) = VertexX(p) + x
VertexY(p) = VertexY(p) + y
VertexZ(p) = VertexZ(p) + z
' /////////////////////////////////////////////////////////////////////////////
For p
= VertexSource
To VertexSource
+ VertexCount
- 1 VertexX(p) = VertexX(p) * s
VertexY(p) = VertexY(p) * s
VertexZ(p) = VertexZ(p) * s
' /////////////////////////////////////////////////////////////////////////////
' positive XZ/a1 is clockwise (when viewing from above)
' positive YZ/a2 is clockwise (when viewing from the right)
Sub VertexRotateXZ_YZ
(a1
, a2
)
a1_rad = a1 * -0.0174532925
a1_sin
= Sin(a1_rad
): a1_cos
= Cos(a1_rad
)
a2_rad = a2 * 0.0174532925
a2_sin
= Sin(a2_rad
): a2_cos
= Cos(a2_rad
)
For p
= VertexSource
To VertexSource
+ VertexCount
- 1 x = VertexX(p)
y = VertexY(p)
z = VertexZ(p)
x2 = a1_sin * z + x * a1_cos
z = a1_cos * z - a1_sin * x
x = x2
y2 = a2_sin * z + y * a2_cos
z = a2_cos * z - a2_sin * y
y = y2
VertexX(p) = x
VertexY(p) = y
VertexZ(p) = z
' /////////////////////////////////////////////////////////////////////////////
v2 = VertexLast
dif = (v2 + 1) - Model(m).FirstVertex
For v1
= Model
(m
).FirstVertex
To Model
(m
).FirstVertex
+ Model
(m
).VertexCount
- 1 v2 = v2 + 1
VertexX(v2) = VertexX(v1)
VertexY(v2) = VertexY(v1)
VertexZ(v2) = VertexZ(v1)
VertexTX(v2) = VertexTX(v1)
VertexTY(v2) = VertexTY(v1)
VertexLast = v2
t2 = TriangleLast
For t1
= Model
(m
).FirstTriangle
To Model
(m
).FirstTriangle
+ Model
(m
).TriangleCount
* 3 - 1 t2 = t2 + 1
TriangleVertex(t2) = TriangleVertex(t1) + dif
TriangleLast = t2
' /////////////////////////////////////////////////////////////////////////////
