#!/usr/bin/perl -w

# Contains routines to create Thief (DTP/G/II) specific object stuff 
# like startingpoint, torches etc

# (c) Copyright by Tels 1999-2000. All Rights Reserved. Do NOT distribute.
# Updates and support on bloodgate.com/thief/genvbr

# 2000-01-09 v0.0.1 - torch, startingpoint from route.pm
# 2000-01-15 v0.0.2 - startingPoint revised
# 2000-01-18 v0.0.3 - added: makePhysical makeLight
# 2000-02-15 v0.0.4 - added: makeCreature,
#                     fixed: gamfile no longer needed for makeXXX
# 2000-02-27 v0.0.5 - added: makeLadder, makeLoot, makeDoor
# 2000-03-06 v0.0.6 - fixed: startingPoint, makeRotDoor, makeTRansDoor
#                     added: breakableWindow
# 2000-03-13 v0.0.7 - added: unlitTorch, makeAnimLight, linkObjects
# 2000-03-18 v0.0.8 - added: animLightDoor
# 2000-05-13 v0.0.9 - added: addSource/addReceptron
#                            

package Cowgen::Thief;
require Exporter;
@ISA    = qw(Exporter);
@EXPORT_OK = qw( 
            startingPoint 
            makePhysical makeLight makeAnimLight 
            makeCreature makeLadder makeLoot makeRotDoor makeTransDoor makeDoor
             
            addSource addReceptron
            linkObjects
            torch unlitTorch breakableWindow animLightDoor
            );

use Cowgen::Bunch;
use Cowgen::Dromed;
use Cowgen::Objsize;
use strict 'vars';

my $VERSION = '0.09';

my $count = "000";

sub startingPoint
  {
  # create a bunch, add a game startingpoint and link Garrett to it and then
  # merge a bunch containing some objects to it, and add the objects to 
  # the inventory
  # named parameters: gamfile, inventory, facing, 
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $b = Cowgen::Bunch->create("StartingPoint");
  my ($sp,$ob,@obj,$li);
  my $inv = $p->{inventory} || {};
  my $facing = $p->{facing} || aSouth();
  my $gf = $p->{gamfile};
  foreach (keys %$inv)
    {
    $ob = { base => $gf->obj($_), name => "$_##num##" };
 #   $sp = $b->addObject ( 
 #   int(rand(100)-50)/10,int(rand(100)-50)/10,int(rand(100)-50)/10, 0,0,0, $ob);
 #   $b->setProperty ($sp, "stackcount", $inv->{$_} );
 #   print "$_\n";
 #   push (@obj,$sp);
    }
  $ob = { base => $gf->obj("marker"), name => "StartingPoint" };
  $sp = $b->addObject ($x,$y,$z, 0,0,0, $ob);
  $b->addLink ($sp, $gf->obj("Garrett"), $gf->flavour("PlayerFactory") );
  $b->setProperty ($sp, "Scripts", "VictoryCheck" );
  my $fl = $gf->flavour("contains"); # for speed
  foreach (@obj)
    {
    $li = $b->addLink ($sp, $_, $fl, 0 ); # from, to, linktype, where (generic)
    }
  $b->rotateByFacing($x,$y,$z,$facing);
  $b; # bunch
  }

sub makePhysical 
  {
  # add the proper properties to an objet to make it a physical object
  # parameters: bunch, object
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $gf = shift; #  || return;
  $bunch->setProperty ($obj, "Physics->Misc->CollisionType", o_bounce());
  $bunch->setProperty ($obj, "Physics->Misc->Attributes", 100, 150, 0, 0, 0, 0, 0, 0, 0x0, 0x0);
  $bunch->setProperty ($obj, "Physics->Misc->Type", O_OBB, 6, 0);
  $bunch->setProperty ($obj, "Physics->Misc->ControlsActive", 
    O_LOCATION, 0,0,0, 0,0,0, 0,0,0);
  }

sub makeLight
  {
  # add the proper properties to an object to make it a physical light object
  # parameters: bunch, object, hash
  # named parameters: light (value or hash containing hue (0..1.0), 
  # saturation (0..1.0, bright (0..1000))
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $light = $p->{light};
  my $gf = $p->{gamfile};
  if (defined $light)
    {
    if (ref($light) eq "HASH")
      {
      $bunch->setProperty ($obj, "Renderer->LightColor", $light->{hue}, $light->{saturation});
      $light = $light->{bright};
      }
    $bunch->setProperty ($obj, "Renderer->Light", $light); 
    }
  makePhysical ($bunch, $obj, $gf);
  }

sub makeAnimLight
  {
  # add the proper properties to an object to make it a physical light object
  # which can be animated (fade etc)
  # parameters: bunch, object, hash
  # named parameters: type (O_SLIDE etc), bright (light bright), maxbright, minbright,
  # saturation (0..1.0), hue, radius, brighttime, dimtime, ox, oy, oz, rising,
  # countdown, inactive
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $l = $p->{light} || {};
  my $gf = $p->{gamfile};
  $bunch->setProperty ($obj, "Renderer->AnimLight", $l->{type} || O_MAX_BRIGHT,
    $l->{brighttime} || 0, $l->{dimtime} || 0, $l->{maxbright} || 0,
    $l->{minbright} || 0, $l->{radius} || 0, 
    $l->{ox} || 0, $l->{oy} || 0, $l->{oz} || 0, $l->{rising} || 0, $l->{countdown} || 0,
    $l->{inactive}  );
  $bunch->setProperty ($obj, "Renderer->LightColor", $l->{hue}, $l->{saturation});
  $bunch->setProperty ($obj, "Renderer->Light", 0); 
  makePhysical ($bunch, $obj, $gf);
  }

sub makeCreature
  {
  # add the proper properties to a creature it a physical creature
  # parameters: bunch, object, 
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $gf = $p->{gamfile};
  $bunch->setProperty ($obj, "DarkGameSys->AirSupply", 5000 );
  #$bunch->setProperty ($obj, "AI->State->CurrentMode", o_normal() );
  #my $hp = 5;
  #$bunch->setProperty ($obj, "DarkGameSys->HitPoints", $hp );
  #$bunch->setProperty ($obj, "DarkGameSys->MaxHitPoints", $hp );
  my $type = o_humanoid();
  $bunch->setProperty ($obj, "CreatureType", $type );
  makePhysical ($bunch, $obj, $gf);
  # overwrite collisiontype
  $bunch->setProperty ($obj, "Physical->Misc->CollisionType", o_bounce()+o_no_collision_sound());
  $bunch->setProperty ($obj, "Physics->Misc->Type", O_SPHERE, 2, 0);
  }

sub makeLadder
  {
  # add the proper properties to a creature it a physical creature
  # parameters: bunch, object, 
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $gf = $p->{gamfile};
  makePhysical ($bunch, $obj, $gf);
  # overwrite now
  # +xaxis, +zaxis, - axis = 0xD
  $bunch->setProperty ($obj, 
    "Physiks->Misc->Attributes", 100, 0, 1, 1, 0.96, 0, 0, 0, 0x0, 0x0, 0xD, 0);
  $bunch->setProperty ($obj, "Physics->Misc->ControlsActive", 
    O_LOCATION+O_ROTATION, 0,0,0, 0,0,0, 0,0,0);
  }

sub makeLoot
  {
  # add the proper properties to an object to make it lootable
  # you should add property "loot" to override the default 100 gold loot!
  # parameters: bunch, object, 
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $gf = $p->{gamfile};
  $bunch->setProperty ($obj, "Physics->Misc->CollisionType", o_bounce());
  $bunch->setProperty ($obj, "MetaProperty", $gf->obj("IsLoot") ); 
  }

sub makeDoor
  {
  # add the proper properties to an object to make it a door/portcullis etc
  # parameters: bunch, object, gamefile
  my $bunch = shift || return; 
  my $obj = shift || return;
  makePhysical($bunch,$obj,@_);
  $bunch->setProperty ($obj, "Physics->Misc->AICollidesWith", true());
  $bunch->setProperty ($obj, "Physics->Misc->ControlsActive", 
    O_LOCATION+O_ROTATION, 0,0,0, 0,0,0, 0,0,0);
  $bunch->setProperty ($obj, "Physics->Misc->Attributes", 100, 30, 1, 1, 0.96,  
    1.5, 0, 0, 0x0, 0x0);
  }

sub makeRotDoor
  {
  # add the proper properties to an object to make it a door/portcullis etc
  # parameters: bunch, obj, hash
  # named parameters: closedangle, openedangle, gamfile
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $gf = $p->{gamfile};
  my $oa = $p->{openedangle} || 0;
  my $ca = $p->{closededangle} || 0;
  my $cw = $p->{clockwise} || FALSE;
  makeDoor($bunch,$obj,$gf);
  $bunch->setProperty ($obj, "Door->Rotating", 
    $oa, $ca, 1, 2, O_CLOSED, false(), true(), 60, 25, $cw );
  #$bunch->setProperty ($obj, 'JointPositions', 90, );
  $bunch->setProperty ($obj, 'LockState', O_NONE, O_NONE, 90, 0 );
  }

sub makeTransDoor
  {
  # add the proper properties to an object to make it a door/portcullis etc
  # parameters: bunch, object, gamefile
  my $bunch = shift || return; 
  my $obj = shift || return;
  my $p = shift || {};
  my $gf = $p->{gamfile};
  my $op = $p->{openedpos} || 0;
  my $cp = $p->{closedpos} || 0;
  makeDoor($bunch,$obj,$gf);
  $bunch->setProperty ($obj, "Door->Translating", 
    $op, $cp, 1, 2, O_CLOSED, false(), true(), 60, 25, false() );
  }

sub addMetaProperties
  {
  # lets you easily add metaproperties by specifing only the name, also keeps existings
  # instead of writing
  #b->setProperty ($obj, "MetaProperty", 
  # $gf->obj("BashyDoor"), $gf->obj("FrobInert"), $gf->obj("MatGlass") );
  # write addMetaProperties ($bunch,$obj,$gf,'BashyDoor','FronInert','MatGlass');
  my $bunch = shift || return;
  my $obj = shift || return;
  my $gf = shift || return;
  my @mt = @_;
  my $mp;
  my @p = $bunch->getProperty ($obj, "MetaProperty"); # get old ones 
  foreach (@mt)
    {
    $mp = $gf->obj($_);
    push @p, $mp if (defined $mp);
    }
  $bunch->setProperty ($obj, "MetaProperty", @p);
  $bunch;
  }

############################################################################
# some stuff for creating special objects, vworld compatible

sub breakableWindow
  {
  # make a secret door and redesign/resize it so that it is a breakable window/door
  # named parameters: texture (full path name plus texture name w/o extension; like
  # need door translating someday but this is not ready yet
  # fam\church\glass1), facing, name, gamefile
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $txt = $p->{texture} || 'fam\church\glass1';
  my $facing = $p->{facing} || aSouth();
  my $name = $p->{name} || "breakableWindow##num##";
  my $gf = $p->{gamfile} || return;
  my $b = Cowgen::Bunch->create($name);
  my $e = { base => $gf->obj('7x6secret-door'), name => $name, };
  setObjSize($e);
  $w = $w/7; $l = $l/2; $h = $h/6;
  my $obj = $b->addObject ($x,$y,$z,0,0,0, $e);
  makePhysical($b,$obj);
  addMetaProperties ($b,$obj, $gf, 'BashyDoor', 'FrobInert', 'MatGlass');
  $b->setProperty ($obj, "Game->DamageModel->HitPoints", 1 );
  $b->setProperty ($obj, "Game->DamageModel->SlayResult", O_DESTROY );
  $b->setProperty ($obj, "Door->Rotating", 
    0, 0, 1, 2, O_CLOSED, false(), false(), 60, 0.25, false() );
  $b->setProperty ($obj, "Renderer->Transparency", 0.55 );
  $b->setProperty ($obj, "Shape->TextureReplace0", $txt );
  $b->setProperty ($obj, "Shape->Scale", $w,$l,$h );
  $b->rotate($p->{rx},$p->{ry},$p->{rz},$x,$y,$z);
  $b->rotateByFacing($x,$y,$z,$facing);
  $b; # window
  }

sub torch
  {
  # create a torch, consisting of body, and two particle attachments
  # named parameters: facing, light (default light value
  # or light hash), gamfile (ref to gamefile)
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $facing = $p->{facing} || aSouth();
  my $gf = $p->{gamfile};
  return if (!defined $gf);
  my $b = Cowgen::Bunch->create("torch##num##");
  my $ob = { base => $gf->obj("contorch"), name => $p->{name} || "torch##num##", };
  setObjSize($ob);
  my $to = $b->addObject ( $x+0.4, $y, $z+1.1, 0, 0, 0, $ob );

  $ob = { base => $gf->obj("TorchFlameYellow"), name => "flameyellow##num##", };
  setObjSize($ob);
  my $flame = $b->addObject ( $x+0.4, $y, $z+1.1, 0, 0, 0, $ob );
  $b->setProperty ($flame, "Shape->Scale", 1,1,0.5 );

  $b->addLink ( $flame, $to, $gf->flavour("ParticleAttachement"), L_VHOT,3,0,0 );
  $ob = { base => $gf->obj("TorchFlameSmoke"), name => "flamesmoke##num##", };
  setObjSize($ob);
  $flame = $b->addObject ( $x+0.4, $y, $z+1.1, 0, 0, 0, $ob );
  $b->setProperty ($flame, "Shape->Scale", 1,1,0.5 );

  $b->addLink ($flame, $to, $gf->flavour("ParticleAttachement"),L_VHOT,3,0,0 );
  makeAnimLight ($b,$to,$p);
  $b->setProperty ($to, "Tweq->ModelState", ON );
 $b->setProperty ($to, "AmbientHacked",  12,0,0,"torch_flame");
  $b; # bunch
  }

sub unlitTorch
  {
  # create a torch, consisting of body, and two particle attachments
  # not quite ready yet!
  # named parameters: facing, light (default light value
  # or light hash), gamefile (ref to gamefile)
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $facing = $p->{facing} || aSouth();
  my $gf = $p->{gamfile};
  return if (!defined $gf);
  my $b = Cowgen::Bunch->create("unlittorch##num##");
  my $ob = { base => $gf->obj("contorch"), name => $p->{name} || "torch##num##", };
  my $to = $b->addObject ( $x+0.4, $y, $z+1.1, 0, 0, 0, $ob );
  my $li = $p->{light} || {};
  $b->setProperty ($to, "Renderer->AnimLight", O_MIN_BRIGHT,
    $li->{brighttime} || 0, $li->{dimtime} || 0, $li->{maxbright} || 0,
    $li->{minbright} || 0, $li->{radius} || 0, 
    $li->{ox} || 0, $li->{oy} || 0, $li->{oz} || 0, $li->{rising} || 0, $li->{countdown} || 0,
    $li->{inactive} );
  $b->setProperty ($to, "Tweq->ModelState", OFF );
  $b->setProperty ($to, "AmbientHacked",  0,0,0,"torch_flame");
  $b->setProperty ($to, "Shape->ModelName", "newt01" );
  $b; # bunch
  }

sub animLightDoor
  {
  # Create a door connected with an animlight, so that the light goes on when the
  # door is open and off when the door is closed. This is to
  # named parameters: facing, light (light hash; brighttime; dimtime; maxbright; minbright;
  # radius; rising; countdown; ox oy oz), gamefile (ref to gamefile),
  # ldx (distance pos/neg of light from door center; in x), ldy, ldz,
  # base (base archetype of door), name
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $facing = $p->{facing} || aSouth();
  my $gf = $p->{gamfile};
  return if (!defined $gf);
  my $b = Cowgen::Bunch->create('lightDoor##num##');
  my $ob = { base => $p->{base} || $gf->obj('door13'), 
    name => $p->{name} || 'lightDoor##num##', };
  my $do = $b->addObject ( $x, $y, $z, 0, 0, 0, $ob );
  makeRotDoor($b,$do,$p);
  my $li = $p->{light} || {};
  $ob = { base => $gf->obj('AnimLight'), name => 'animlight##num##', };
  my $ldx = $p->{ldx} || 0;  my $ldy = $p->{ldy} || 0;  my $ldz = $p->{ldz} || 0;
  my $al = $b->addObject ( $x+$ldx, $y+$ldy, $z+$ldz, 0, 0, 0, $ob );
  $b->setProperty ($al, "Renderer->AnimLight", O_SMOOTHLY_DIM,
    $li->{brighttime} || 500, $li->{dimtime} || 250, $li->{maxbright} || 35,
    $li->{minbright} || 0, $li->{radius} || 0, 
    $li->{ox} || 0, $li->{oy} || 0, $li->{oz} || 0, 
    $li->{rising} || 0, $li->{countdown} || 0, TRUE );
  $b->setProperty ($do, 'Scripts', 'TrigDoorOpen', 'LockSounds', '', '', FALSE );
  $b->addLink ($do,$al,$gf->flavour('ControlDevice'));
  $b; # bunch
  }


#################################################################################
# Helper functions

sub linkObjects
  {
  # link two object groups together
  # parameters: bunch, gamefile, from (ref to array), to (ref to array),
  # flavour, flags (CD_xxx), data (ref to array), bx (blueroom center), by, bz
  my ($b,$gf,$from,$to,$flavour,$flags,$data,$bx,$by,$bz) = @_;

  my $cd = $gf->flavour("controldevice");
  my ($f,$t,$in,$out,$node,$p); my @d = @$data;
  $f = scalar @$from; $t = scalar @$to;
  #debug: print "list $f $t $flavour $flags $bx,$by,$bz\n"; 
  if ( ($flavour == $cd)  
   && ((($f+$t) < $f*$t) || ($flags != CD_DIRECT)) )
    {
    # default relay
    $node = "RelayTrap"; 
    if (($flags & CD_INVERTED) != 0)
      {   
      $node = "Inverter"; 
      }
    if (($flags & CD_REQUIRE_ANY) != 0)
      {   
      $node = "RequireAnyTrap"; 
      }
    if (($flags & CD_REQUIRE_ALL) != 0)
      {   
      $node = "RequireAllTrap"; 
      }
    if (($flags & CD_DESTROY) != 0)
      {   
      $node = "DestroyTrap"; 
      }
    $p = { base => $gf->obj($node), name => "$node##num##", };
    $node = $b->addObject(
      int(rand(8)*4-40)/4+$bx,int(rand(8)*4-40)/4+$by,int(rand(8)*4-40)/4+$bz,0,0,0,$p);
    $out = $node; $in = $node;
    foreach $f (@$from) 
      {
      $b->addLink ($f,$in,$flavour,@d);
      #debug: print "from: $f => $in\n";
      }
    foreach $t (@$to) 
      {
      $b->addLink ($out,$t,$flavour,@d);
      #debug: print "to: $out => $t\n";
      }
    if (($flags & CD_ONE_SHOT) != 0)
      {   
      if (($flags & CD_DESTROY) != 0)
        {
        $b->addLink ($out,$out,$flavour,@d);
        #debug: print "destroy: $out => $out\n";
        }
      else
        {
        $p = { base => $gf->obj('DestroyTrap'), name => 'DestroyTrap##num##', };
        $node = $b->addObject(int(rand(8)*4-40)/4+$bx,
          int(rand(8)*4-40)/4+$by,int(rand(8)*4-40)/4+$bz,0,0,0,$p);
        #debug: print "oneshot: $in => $node, $node => $in\n";
        $b->addLink ($in,$node,$flavour,@d);
        $b->addLink ($node,$in,$flavour,@d);
        }
      }
    }
  else
    {
    foreach $f (@$from) 
      {
      foreach $t (@$to)   
        {
        $b->addLink ($f,$t,$flavour,@d);
        #debug: print "direct: $f => $t\n";
        }
      }
    }
  }

sub addSource
  {
  # first param is objectlist, second object ID to attach source to 
  # this makes it easier to set a source property, since you dont need to 
  # remember the order of the property params
  # named params: stimulus, propagator ("script","flow","radius", "contact","none"),
  # intensity, lifecylce (containing flags, period, max_firings, intensity_slope, 
  # shape (ref to hash containing: radius, flags (or contacttypes), dispersion 
  # (O_LINEAR, O_INVERSE_QUADRATIC), velocity_coeff, frobtime_coeff)
  my $ol = shift || return;
  my $o = shift || return;
  my $p = shift || {};
  my $ob = $ol->objectbyId($o);
  return if (!defined $ob);
  my $l = $p->{lifecylce} || {};
  my $s = $p->{shape} || {};
  $ol->setProperty($o, $p->{stimulus}, $p->{propagator}, $p->{intensity}, 
   $s->{radius}, $s->{flags}, $s->{dispersion}, $s->{velocity_coeff}, $s->{frobtime_coeff},
   $l->{flags}, $l->{period}, $l->{max_firings}, $l->{intensity_slope}); 
  }

1;

