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