REM Project: Terra Pugna REM Created: 5/11/2007 10:02:58 AM REM REM ***** Main Source File ***** REM #constant battlefieldsize = 25 #constant cratenum = 40 #constant heavy = 5.0 sync on randomize timer() Tbm_init(60) global name as string titlescreen() selectname() loadgame() zoom = 8 do Tbm_update() `control player if keystate(17) then move object player, .1*Tbm.factor if keystate(31) then move object player, -.1*Tbm.factor if keystate(30) then yrotate object player, object angle y(player) - 2*Tbm.factor if keystate(32) then yrotate object player, object angle y(player) + 2*Tbm.factor px# = object position x(player) pz# = object position z(player) `collision for t = 0 to array count(crates()) if object collision(player, crates(t)) x# = get object collision x() z# = get object collision z() position object player, object position x(player) - x#, 0, object position z(player) - z# position object crates(t), object position x(crates(t)) + x#/heavy, 0, object position z(crates(t)) + z#/heavy endif next t `control intelligent munitions system for t = 0 to array count(IMSs()) if IMSs(t) x# = object position x(IMSs(t)) z# = object position z(IMSs(t)) if abs(px# - x#) + abs(pz# - z#) < 3 make_bomb(x#, 0, z#, (px# - x#)/10.0, .1, (pz# - z#)/10.0) endif endif next t `control bombs if array count(bombs()) for t = 0 to array count(bombs()) dec bombs(t).vy, .01 position object bombs(t).object, object position x(bombs(t).object)+bombs(t).vx*Tbm.factor,object position y(bombs(t).object)+bombs(t).vy*Tbm.factor,object position z(bombs(t).object)+bombs(t).vz*Tbm.factor next t endif `control camera inc zoom, mousemovez()/100.0 position camera object position x(player), zoom, object position z(player) point camera object position x(player), object position y(player), object position z(player) yrotate camera object angle y(player) text 0, 0, "FPS: " + str$(Tbm.realfps, 0) sync loop function make_bomb(x as float, y as float, z as float, vx as float, vy as float, vz as float) array insert at bottom bombs() bombs().object = make_object_sphere(0.1, 5, 5) position object bombs().object, x, y, z color object bombs().object, rgb(0, 255, 0) bombs().vx = vx bombs().vy = vy bombs().vz = vz endfunction type bomb object as dword vx as float vy as float vz as float endtype function loadgame() dim crates(cratenum) as dword dim IMSs(battlefieldsize+4, 4) as dword for t = 0 to cratenum crates(t) = make_object_cube(1) position object crates(t), rnd(battlefieldsize), 0, rnd(battlefieldsize) make object collision box crates(t), -0.5, -0.5, -0.5, 0.5, 0.5, 0.5, 0 yrotate object crates(t), rnd(50)-25 color object crates(t), rnd(0x00FFFFFF) next t global player as dword player = make_object_sphere(0.5, 12, 12) make object collision box player, -0.25, -0.25, -0.25, 0.25, 0.25, 0.25, 0 color object player, 0x000000FF null = make vector3(1) for t = -2 to battlefieldsize + 2 step 4 for side = 0 to 3 IMSs(t+2, side) = make_object_cone(.8) next side position object IMSs(t+2, 0), t, 0, -2 position object IMSs(t+2, 1), t, 0, battlefieldsize+2 position object IMSs(t+2, 2), -2, 0, t position object IMSs(t+2, 3), battlefieldsize+2, 0, t next t dim bombs(-1) as bomb endfunction function selectname() local how as string local name as string local repea as string talk("What's your name, soldier?") input name inc y, 15 talk("Ok, " + name + ", you've been chosen to lead this group of soldiers into") talk("a surprise attack on the ShiWii.") talk("Would you like me to tell you how to fight them?") input how inc y, 15 if upper$(mid$(how, 1)) = "Y" repeat talk("Use WASD to move around and the left mouse button to fire.") talk("Don't leave the battlefield or else the IMS network will blow you up.") talk("You can hide behind crates for cover but remember the ShiWii can blow them up.") talk("Do you want me to repeat the directions?") input repea inc y, 15 if upper$(mid$(repea, 1)) = "N" talk("Ah, you're a quick learner.") talk("We need smart people on the force out there like you.") else talk("Smart choice, war is life or death, so I'll explain it again so you're sure") talk("you can beat the ShiWii.") endif until upper$(mid$(repea, 1)) = "N" else talk("You must be very experienced if you already know that much") talk("about battling on ShiWii territory!") endif talk("Good luck, " + name + "!") endfunction function titlescreen() local title as string local piece as string local char as byte local fade as byte title = "Terra Pugna" for char = 1 to len(title) cls piece = left$(title, char) center text screen width()/2, screen height()/2, piece wait 200 sync next char wait 700 titley = screen height()/2 repeat cls center text screen width()/2, titley, title inc titley wait 7 sync until titley > screen height() endfunction global x as dword global y as dword function talk(str as string) x = 0 for t = 1 to len(str) set cursor x, y print mid$(str, t) inc x, text width(mid$(str, t)) wait 50 sync next t inc y, 10 endfunction `*********************** `**** Dynamic Media **** `*********************** `******************** `** Free Functions ** `******************** function free_object() id as dword repeat inc id until object exist(id) = 0 endfunction id function free_limb(object as dword) id as dword if object exist(object) repeat inc id until limb exist(object, id) = 0 endif endfunction id function free_dll() id as dword repeat inc id until dll exist(id) = 0 endfunction id function free_memblock() id as dword repeat inc id until memblock exist(id) = 0 endfunction id function free_sound() id as dword repeat inc id until sound exist(id) = 0 endfunction id function free_music() id as dword repeat inc id until music exist(id) = 0 endfunction id function free_animation() id as dword repeat inc id until animation exist(id) = 0 endfunction id function free_bitmap() id as dword repeat inc id until bitmap exist(id) = 0 endfunction id function free_effect() id as dword repeat inc id until effect exist(id) = 0 endfunction id function free_image() id as dword repeat inc id until image exist(id) = 0 endfunction id function free_light() id as dword repeat inc id until light exist(id) = 0 endfunction id function free_matrix() id as dword repeat inc id until matrix exist(id) = 0 endfunction id function free_mesh() id as dword repeat inc id until mesh exist(id) = 0 endfunction id function free_pixelshader() id as dword repeat inc id until pixel shader exist(id) = 0 endfunction id function free_particles() id as dword repeat inc id until particles exist(id) = 0 endfunction id function free_sprite() id as dword repeat inc id until sprite exist(id) = 0 endfunction id function free_terrain() id as dword repeat inc id until terrain exist(id) = 0 endfunction id function free_vertexshader() id as dword repeat inc id until vertex shader exist(id) = 0 endfunction id function free_file() id as dword repeat inc id until file open(id) = 0 endfunction id `******************* `** Object Making ** `******************* function load_object(filename as string) id as dword id = free_object() load object filename, id endfunction id function make_object_cube(size as float) id as dword id = free_object() make object cube id, size endfunction id function make_object_sphere(size as float, rows as integer, columns as integer) id as dword id = free_object() make object sphere id, size, rows, columns endfunction id function make_object_cylinder(size as float) id as dword id = free_object() make object cylinder id, size endfunction id function make_object_cone(size as float) id as dword id = free_object() make object cone id, size endfunction id function make_object_plain(width as float, height as float) id as dword id = free_object() make object plain id, width, height endfunction id function make_object_triangle(x1 as float, y1 as float, z1 as float, x2 as float, y2 as float, z2 as float, x3 as float, y3 as float, z3 as float) id as dword id = free_object() make object triangle id, x1, y1, z1, x2, y2, z2, x3, y3, z3 endfunction id function make_object(mesh as dword, image as dword) id as dword id = free_object() make object id, mesh, image endfunction id function make_object_from_limb(object as dword, limb as dword, copy as boolean) id as dword id = free_object() make object from limb id, object, limb, copy endfunction id function clone_object(object as dword) id as dword id = free_object() clone object id, object endfunction id function instance_object(object as dword) id as dword id = free_object() instance object id, object endfunction id `****************** `** Image Making ** `****************** function load_image(filename as string, textureflag as boolean) id as dword id = free_image() load image filename, textureflag endfunction id function get_image(left as dword, top as dword, right as dword, bottom as dword, textureflag as boolean) id as dword id = free_image() get image id, left, top, right, bottom, textureflag endfunction id `****************** `** Sound Making ** `****************** function load_sound(filename as string) id as dword id = free_sound() load sound filename, id endfunction id function load_3Dsound(filename as string) id as dword id = free_sound() load 3dsound filename, id endfunction id function clone_sound(sound as dword) id as dword id = free_sound() clone sound id, sound endfunction id function record_sound(duration as dword) id as dword id = free_sound() record sound id, duration endfunction id `******************* `** Sprite Making ** `******************* function make_sprite(xpos as integer, ypos as integer, image as dword) id as dword id = free_sprite() sprite id, xpos, ypos, image endfunction id function clone_sprite(sprite_ as dword) id as dword id = free_sprite() clone sprite sprite_, id endfunction id `***************** `** File Making ** `***************** function open_to_read(filename as string) id as dword id = free_file() open to read id, filename endfunction id function open_to_write(filename as string) id as dword id = free_file() open to write id, filename endfunction id REM *** Include File: Tbm.dba *** REM Created: 5/6/2007 12:29:35 PM REM REM Included in Project: C:\Program Files\The Game Creators\Dark Basic Professional\Projects\Mekal Engine\Mekal Engine.dbpro REM `this include file encapsulates timer based movement `Public `Tbm_init() `Tbm_update() `Tbm.realfps R `Tbm.factor R type Tbm targetfps as float realfps as float boot as dword factor as float lastcheck as dword endtype function Tbm_init(fps as float) global Tbm as Tbm Tbm.boot = timer() Tbm.lastcheck = Tbm.boot Tbm.targetfps = fps endfunction function Tbm_update() now as dword took as dword factor as float now = timer() took = now - Tbm.lastcheck Tbm.lastcheck = now Tbm.realfps = 1000.0/took Tbm.factor = Tbm.targetfps/Tbm.realfps endfunction