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