`Initialisation section set display mode 1280, 1024, 32 sync on sync rate 0 backdrop on color backdrop 0 randomize timer() autocam off set camera range 0.1, 100.0 set ambient light 20 make memblock 1, 12 + (16*16*4) write memblock dword 1, 0, 16 write memblock dword 1, 4, 16 write memblock dword 1, 8, 32 c as DWORD for i = 0 to 15 for j = 0 to 15 a = 224 - (sqrt( ((i - 7.5)*(i - 7.5)) + ((j - 7.5) * (j - 7.5)) ) * 24.0) if a < 0 then a = 0 ang = abs(atanfull(i-8, j-8)) print ang write memblock dword 1, 12 + ((j + (i*16))*4), rgb(255 - ang, ang,0) && ((a << 24) || 0x00FFFFFF) next j ` wait key next i make image from memblock 2, 1 delete memblock 1 sprite 1, 0, 0, 2 set sprite 1, 0, 1 offset sprite 1, 8, 8 hide sprite 1 C_SIZE = 256 make memblock 1, 13 + (C_SIZE*C_SIZE*4) write memblock dword 1, 0, C_SIZE write memblock dword 1, 4, C_SIZE write memblock dword 1, 8, 32 c as dword d as dword SOFTNESS = 8 for i = 0 to C_SIZE-1 for j = 0 to C_SIZE-1 c = ((C_SIZE - abs(j - (C_SIZE-1-i))) * SOFTNESS) - ((C_SIZE*SOFTNESS)-255) d = ((C_SIZE - abs(j - i)) * SOFTNESS) - ((C_SIZE*SOFTNESS)-255) if d > c then c = d if c < 0 then c = 0 write memblock dword 1, 12 + ((j + (i*C_SIZE))*4), 0xFFFF0000 && ((c << 24) || 0x00FFFFFF) next j next i make image from memblock 3, 1 delete memblock 1 sprite 2, screen width() * 0.25, screen height() * 0.25, 3 size sprite 2, screen width() * 0.5, screen height() * 0.5 CROSS_ALPHA# = 0.0 set sprite alpha 2, 0.0 #Constant krtlt (rightkey()-leftkey()) ` returns a 1 if right or -1 if left #Constant kupdn (upkey()-downkey()) ` returns a 1 if up or -1 if down or 0 if both or nothing #Constant klrud (downkey()+(upkey()*2)+(rightkey()*4)+(leftkey()*8)) `returns binary result; bit 0=down, 1=up, 2=right, 3=left #Constant kadws (keystate(31)+(keystate(17)*2)+(keystate(32)*4)+(keystate(30)*8)) `returns binary result; bit 0="s", 1="w", 2="d", 3="a" #constant CamX camera position x() #constant CamY camera position y() #constant CamZ camera position z() `Declare some types type mazeCell N S E W endtype type Coord x y endtype `How many cells do we want? #constant M_WIDTH 12 #constant M_HEIGHT 12 global MAP_SCALE# MAP_SCALE# = 200.0 / M_HEIGHT `Create a maze dim Maze(M_WIDTH, M_HEIGHT) as mazeCell `Generate the maze GenerateMaze() make object cylinder 1000, 1 make mesh from object 1000, 1000 add limb 1000, 1, 1000 add limb 1000, 2, 1000 add limb 1000, 3, 1000 offset limb 1000, 0, 5, 0, -5 offset limb 1000, 1, 5, 0, 5 offset limb 1000, 2, -5, 0, -5 offset limb 1000, 3, -5, 0, 5 scale object 1000, 100, 750, 100 lock object on 1000 position object 1000, 0, 0, 10 rotate object 1000, 90, 0, 0 `Player Angle angle# = 0.0 target_angle = 0 `Player Target Position target_x# = 1.0 : target_z# = 1.0 `Player Energy #constant ENERGY_WIDTH 16 #constant ENERGY_HEIGHT 200 Dim EnergyArray(ENERGY_HEIGHT) as float global EnergyLevel# : EnergyLevel# = ENERGY_HEIGHT make memblock 2, 12 + (ENERGY_WIDTH * ENERGY_HEIGHT * 4) write memblock dword 2, 0, ENERGY_WIDTH write memblock dword 2, 4, ENERGY_HEIGHT write memblock dword 2, 8, 32 `Draw side lines and fill in the middle with see-through red (that way we only need to rewrite the alpha channel later) for i = 12 + (ENERGY_WIDTH * 4) to (ENERGY_WIDTH * ENERGY_HEIGHT * 4) + 8 step 4 `j is the row, calculated from i... j = ((i - 12) / 4) MOD ENERGY_WIDTH `Test if edge of middle if j > 0 AND j < ENERGY_WIDTH - 1 write memblock dword 2, i, 0x00FF0000 else write memblock dword 2, i, 0xFFFFFFFF endif next i `Write the top row white for i = 12 to 12 + (ENERGY_WIDTH * 4) step 4 : write memblock dword 2, i, 0xFFFFFFFF : next i `Write the bottom row white for i = 12 + (ENERGY_WIDTH * 4 * (ENERGY_HEIGHT-1)) to 11 + (ENERGY_WIDTH * 4 * ENERGY_HEIGHT) step 4 : write memblock dword 2, i, 0xFFFFFFFF : next i updateEnergy() `Make a sprite from it... sprite 4, (M_WIDTH + 1) * MAP_SCALE#, 0, 10 `MAKE CANNONS AND AMMO #constant X_OFFSET 0.189 #constant Y_OFFSET 0.198 #constant Z_OFFSET 0.607 make object sphere 2000, 0.05, 6, 6 hide object 2000 disable object zread 2000 for i = 2001 to 2100 instance object i, 2000 set object collision off i hide object i next i firedOne# = 0.0 `Key states UpKeyDown = 0 LastDirection = 0 LastMoveDirection = 0 MapPos as Coord position camera target_x#, 0.0, target_z# global frameTime# frameTime# = 1.0 startTime = timer() do frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2) startTime = timer() text MAP_SCALE# * (M_WIDTH + 3), 0, "FPS: " + str$(screen fps()) text MAP_SCALE# * (M_WIDTH + 3), 10, "Cam(x,y,z): " + str$(CamX) + ", " + str$(CamY) + ", " + str$(CamZ) text MAP_SCALE# * (M_WIDTH + 3), 20, "Obj(x,y,z): " + str$(objX#) + ", " + str$(objY#) + ", " + str$(objZ#) + ", SCALE: " + str$(objScale#) text MAP_SCALE# * (M_WIDTH + 3), 40, "MouseClick: " + str$(mouseclick()) `Get the arrows and wasd keys for control of the player adws = kadws lrud = klrud `Masks: ` %1000 = Left ` %0100 = Right ` %0010 = Up ` %0001 = Down `Combinations allowed, eg: %1100 = Left and Right `Left/Right (AD/LR) only... adlr = ((adws && %1100) || (lrud && %1100)) `Up/Down (UD/WS) only... udws = ((adws && %0011) || (lrud && %0011)) if LastDirection <> adlr AND EnergyLevel# > 5.0 LorR = 0 if adlr = %1000 then LorR = -1 : `Left if adlr = %0100 then LorR = 1 : `Right if adlr = %1100 then LorR = 0 : `Both, so dont turn inc target_angle, 90 * LorR dec EnergyLevel#, 5.0 endif LastDirection = adlr angle# = curvevalue(target_angle, angle#, 200.0 / frameTime#) yrotate camera angle# `Calculate a polar angle (0, 90, 180, 360) for use later polarAngle = target_angle mod 360 if polarAngle < 0 then inc polarAngle, 360 `Get the current position on the map MapPos.x = int(CamX+0.5) MapPos.y = int(CamZ+0.5) `Can we move? By default, no (1)... Best check for a wall in the polar target direction, if we can canMove=0 canMove = 1 select polarAngle case 0 : canMove = Maze(MapPos.x, MapPos.y).S : endcase case 90 : canMove = Maze(MapPos.x, MapPos.y).E : endcase case 180 : canMove = Maze(MapPos.x, MapPos.y).N : endcase case 270 : canMove = Maze(MapPos.x, MapPos.y).W : endcase endselect if EnergyLevel# < 20.0 then canMove = 1 `If we have a 1, we have a wall! if canMove = 1 CROSS_ALPHA# = curvevalue(255, CROSS_ALPHA#, 750.0 / frameTime#) else `Ok, now we need to move the target pointer based on the polar coord... select polarAngle case 0 : tX = MapPos.x : tZ = MapPos.y+1 : endcase case 90 : tX = MapPos.x+1 : tZ = MapPos.y : endcase case 180 : tX = MapPos.x : tZ = MapPos.y-1 : endcase case 270 : tX = MapPos.x-1 : tZ = MapPos.y : endcase endselect `Move in the correct direction (1 unit in the polar direction determined above)... if LastMoveDirection <> udws if udws = %0010 dec EnergyLevel#, 20.0 target_x# = tX target_z# = tZ endif endif LastMoveDirection = udws CROSS_ALPHA# = curvevalue(0, CROSS_ALPHA#, 100.0 / frameTime#) endif set sprite alpha 2, CROSS_ALPHA# `move the camers smoothly position camera curvevalue(target_x#, CamX, 200.0 / frameTime#), 0.0, curvevalue(target_z#, CamZ, 200.0 / frameTime#) `paste the map paste image 1, 0, 0, 1 `Offset it to the right place for a spot on the overhead map circX# = (CamX-0.5) * MAP_SCALE# circY# = (M_HEIGHT * MAP_SCALE#) - (CamZ-0.5) * MAP_SCALE# rotate sprite 1, angle#+90 paste sprite 1, circX#, circY# `Generate a new maze!! (CHEAT!!) `if spacekey() then GenerateMaze() inc firedOne#, frameTime# for i = 2000 to 2100 if object visible(i) oldX# = object position x(i) oldY# = object position y(i) oldZ# = object position z(i) move object i, frameTime# * 0.005 io# = intersect object(1, oldX#, oldY#, oldZ#, object position x(i), oldY#, object position z(i)) ` text 600, (i-2000) * 10, str$(i-2000) + ", COLLISION: " + str$(io#) if io# > 0 then hide object i else if spacekey() if firedOne# > 100.0 AND EnergyLevel# > 10.0 select rnd(3) case 0 : x# = -X_OFFSET : y# = Y_OFFSET : z# = Z_OFFSET : endcase case 1 : x# = -X_OFFSET : y# = -Y_OFFSET : z# = Z_OFFSET : endcase case 2 : x# = X_OFFSET : y# = Y_OFFSET : z# = Z_OFFSET : endcase case 3 : x# = X_OFFSET : y# = -Y_OFFSET : z# = Z_OFFSET : endcase endselect select polarAngle case 90 : t# = z# : z# = x# : x# = t# : endcase case 180 : z# = -z# : x# = -x# : endcase case 270 : t# = z# : z# = -x# : x# = -t# : endcase endselect position object i, x# + CamX, y# + CamY, z# + CamZ yrotate object i, polarAngle show object i firedOne# = 0.0 dec EnergyLevel#, 10.0 endif endif endif next i inc EnergyLevel#, frameTime# * 0.01 if EnergyLevel# > ENERGY_HEIGHT then EnergyLevel# = ENERGY_HEIGHT updateEnergy() set point light 0, CamX, CamY, CamZ set light range 0, 40 sync loop end `******************************* `** ** `** UPDATE ENERGY BAR ** `** ** `******************************* function updateEnergy() for i = 1 to ENERGY_HEIGHT-2 `If current line is less than the current energy level then fade towards full, else fade to clear if i <= EnergyLevel# EnergyArray(i) = curvevalue(255.0, EnergyArray(i), 1000.0 / frameTime#) else EnergyArray(i) = curvevalue(0.0, EnergyArray(i), 500.0 / frameTime#) endif ` Draw a line of this colour for j = 1 to ENERGY_WIDTH - 2 p = 12 + ((j + (i * ENERGY_WIDTH)) * 4) write memblock byte 2, p+3, int(EnergyArray(i)) next j next i make image from memblock 10, 2 endfunction `******************************* `** ** `** MAZE GENERATION ** `** ** `******************************* function GenerateMaze() for i = 1 to M_WIDTH for j = 1 to M_HEIGHT Maze(i,j).N = 1 Maze(i,j).S = 1 Maze(i,j).E = 1 Maze(i,j).W = 1 next j next i dim CellStack() as Coord : empty array CellStack() : array index to stack CellStack() TotalCells = M_WIDTH * M_HEIGHT VisitedCells = 1 currentCell as Coord currentCell.x = rnd(M_WIDTH-2)+1 currentCell.y = rnd(M_HEIGHT-2)+1 Dim Available(4) while VisitedCells < TotalCells Available(0) = 0 Available(1) = 0 Available(2) = 0 Available(3) = 0 found = 0 if currentCell.y > 1 tX = currentCell.x tY = currentCell.y-1 if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1 inc found Available(0) = 1 endif endif if currentCell.y < M_HEIGHT tX = currentCell.x tY = currentCell.y+1 if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1 inc found Available(1) = 1 endif endif if currentCell.x > 1 tX = currentCell.x-1 tY = currentCell.y if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1 inc found Available(2) = 1 endif endif if currentCell.x < M_WIDTH tX = currentCell.x+1 tY = currentCell.y if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1 inc found Available(3) = 1 endif endif if found > 0 choice = rnd(3) while Available(choice) = 0 choice = rnd(3) endwhile select choice `North case 0 Maze(currentCell.x, currentCell.y).N = 0 Maze(currentCell.x, currentCell.y-1).S = 0 add to stack CellStack() CellStack() = currentCell dec currentCell.y endcase `South case 1 Maze(currentCell.x, currentCell.y).S = 0 Maze(currentCell.x, currentCell.y+1).N = 0 add to stack CellStack() CellStack() = currentCell inc currentCell.y endcase `West case 2 Maze(currentCell.x, currentCell.y).W = 0 Maze(currentCell.x-1, currentCell.y).E = 0 add to stack CellStack() CellStack() = currentCell dec currentCell.x endcase `East case 3 Maze(currentCell.x, currentCell.y).E = 0 Maze(currentCell.x+1, currentCell.y).W = 0 add to stack CellStack() CellStack() = currentCell inc currentCell.x endcase endselect inc VisitedCells else currentCell = CellStack() remove from stack CellStack() endif endwhile `Create a 2D Map image cls IMGX# = M_WIDTH * MAP_SCALE# IMGY# = M_HEIGHT * MAP_SCALE# SCALEX# = (IMGX#-1) / M_WIDTH SCALEY# = (IMGY#-1) / M_HEIGHT for i = 1 to M_WIDTH for j = 1 to M_HEIGHT x1 = (i-1) * SCALEX# x2 = i * SCALEX# y1 = (j-1) * -SCALEY# + (M_HEIGHT * MAP_SCALE#) y2 = j * -SCALEY# + (M_HEIGHT * MAP_SCALE#) if Maze(i,j).N = 1 then line x1, y1, x2, y1 if Maze(i,j).S = 1 then line x1, y2, x2, y2 if Maze(i,j).E = 1 then line x2, y1, x2, y2 if Maze(i,j).W = 1 then line x1, y1, x1, y2 next j next i get image 1, 0, 1, IMGX#, IMGY#+1, 1 `Create a 3D Maze `Create a template wall ` NEW WAY - USING MEMBLOCK if memblock exist(1) then delete memblock 1 if object exist(1) then delete object 1 if mesh exist(1) then delete mesh 1 `Wall count formula - not sure why this works though :-) ` (((W*H) + 1) * 2) + (2 * W) + (2 * H) WALL_COUNT = (2 * M_WIDTH) + (2 * M_HEIGHT) + (2 * (1 + (M_WIDTH * M_HEIGHT))) `32 bytes per vertex, 3 vertexs per poly, 2 polies per square... 1 square = 1 wall make memblock 1, 12 + (32 * 3 * 2 * WALL_COUNT) write memblock dword 1, 0, 274 : ` format write memblock dword 1, 4, 32 : `number of bytes per vertex write memblock dword 1, 8, WALL_COUNT * 2 * 3 : ` number of vertices n = 12 for i = 1 to M_WIDTH for j = 1 to M_HEIGHT if Maze(i,j).N then n = makeNorthWall(i, j, n) if Maze(i,j).S then n = makeSouthWall(i, j, n) if Maze(i,j).E then n = makeEastWall(i, j, n) if Maze(i,j).W then n = makeWestWall(i, j, n) if i = 1 then n = makeEastWall (i-1, j , n) if i = M_WIDTH then n = makeWestWall (i+1, j , n) if j = 1 then n = makeSouthWall(i , j-1, n) if j = M_HEIGHT then n = makeNorthWall(i , j+1, n) next j next i make mesh from memblock 1, 1 make object 1, 1, -1 color object 1, rgb(128, 128, 128) && (96 << 24) set object transparency 1, 5 disable object zread 1 delete mesh 1 delete memblock 1 endfunction function makeNorthWall(i, j, n) x1# = i - 0.5 : x2# = i + 0.5 : z# = j - 0.5 `Triangle 1 n = writeVertex(1, n, x1#, -0.5, z#, 0, 0, -1, 0, 0) n = writeVertex(1, n, x1#, 0.5, z#, 0, 0, -1, 0, 1) n = writeVertex(1, n, x2#, -0.5, z#, 0, 0, -1, 1, 0) `Triangle 2 n = writeVertex(1, n, x2#, -0.5, z#, 0, 0, -1, 1, 0) n = writeVertex(1, n, x1#, 0.5, z#, 0, 0, -1, 0, 1) n = writeVertex(1, n, x2#, 0.5, z#, 0, 0, -1, 1, 1) endfunction n function makeSouthWall(i, j, n) x1# = i - 0.5 : x2# = i + 0.5 : z# = j + 0.5 `Triangle 1 n = writeVertex(1, n, x1#, -0.5, z#, 0, 0, 1, 0, 0) n = writeVertex(1, n, x2#, -0.5, z#, 0, 0, 1, 1, 0) n = writeVertex(1, n, x1#, 0.5, z#, 0, 0, 1, 0, 1) `Triangle 2 n = writeVertex(1, n, x2#, -0.5, z#, 0, 0, 1, 1, 0) n = writeVertex(1, n, x2#, 0.5, z#, 0, 0, 1, 1, 1) n = writeVertex(1, n, x1#, 0.5, z#, 0, 0, 1, 0, 1) endfunction n function makeEastWall(i, j, n) x# = i + 0.5 : z1# = j - 0.5 : z2# = j + 0.5 `Triangle 1 n = writeVertex(1, n, x#, -0.5, z1#, -1, 0, 0, 0, 0) n = writeVertex(1, n, x#, 0.5, z1#, -1, 0, 0, 0, 1) n = writeVertex(1, n, x#, -0.5, z2#, -1, 0, 0, 1, 0) `Triangle 2 n = writeVertex(1, n, x#, -0.5, z2#, -1, 0, 0, 1, 0) n = writeVertex(1, n, x#, 0.5, z1#, -1, 0, 0, 1, 1) n = writeVertex(1, n, x#, 0.5, z2#, -1, 0, 0, 0, 1) endfunction n function makeWestWall(i, j, n) x# = i - 0.5 : z1# = j - 0.5 : z2# = j + 0.5 `Triangle 1 n = writeVertex(1, n, x#, -0.5, z1#, 1, 0, 0, 0, 0) n = writeVertex(1, n, x#, -0.5, z2#, 1, 0, 0, 1, 0) n = writeVertex(1, n, x#, 0.5, z1#, 1, 0, 0, 0, 1) `Triangle 2 n = writeVertex(1, n, x#, -0.5, z2#, 1, 0, 0, 1, 0) n = writeVertex(1, n, x#, 0.5, z2#, 1, 0, 0, 0, 1) n = writeVertex(1, n, x#, 0.5, z1#, 1, 0, 0, 1, 1) endfunction n function writeVertex(mb, n, x#, y#, z#, nx#, ny#, nz#, u#, v#) write memblock float 1, n + 0, x# write memblock float 1, n + 4, y# write memblock float 1, n + 8, z# write memblock float 1, n + 12, nx# write memblock float 1, n + 16, ny# write memblock float 1, n + 20, nz# write memblock float 1, n + 24, u# write memblock float 1, n + 28, v# inc n, 32 endfunction n function RoundFloat(inp#) `Calc the MOD using decimal LeftOver# = inp# - int(inp#) if LeftOver# > -0.5 AND LeftOver# < 0.5 `Round towards 0, ie return int() out = int(inp#) else if LeftOver# >= 0.5 `Round Up, ie int() + 1 out = int(inp#) + 1 else `Round down, ie int() - 1 out = int(inp#) - 1 endif endif endfunction out