#!/usr/bin/perl -w

# This contains A virtual room/cell description/generator. You divide the 
# world into cubicles and these into smaller cubicles a.s.o. and then just 
# definee the look for each of the subrooms, then call worldAsBunch which 
# will spring it into life.

# usage: see vroom.pl

# ANNOTATIONS: see doc/notes.txt

# This should really divided into the independed cells and the stuff using 
# Bunch to make a world out of it.

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

# 1999-11-17 v0.0.1 - from scratch
# 1999-11-20 v0.0.2 - fixed inheritance added Doors/Windows
# 1999-11-24 v0.0.3 - flooding, some fixed
# 1999-11-27 v0.0.4 - noWall, emptyCell
# 1999-12-05 v0.0.5 - placement of Things now generic
#                     atWall, atCell, atThing
#                     ceilingthick, floorthick in cell/room hash
# 1999-12-24 v0.0.6 - coordFromFacing honours top/bottom
#                     fixed: place things even if cell is divided further
#                            small bug if x,y, or z of thing was undefined
# 2000-01-08 v0.0.7 - create list of virtual terrain points (for automatic 
#                     patrol routes etc)
#                     added: cell ( name => 'blah' ); works now
# 2000-01-18 v0.0.8 - added: terrainPoint
#                     fixed: IDs for things/TPS etc, type
#                            get coords gives hash
# 2000-01-26 v0.0.9 - added: cell->{level}, thing/cell->{parent}, makeObject 
#                            path support, thing inheritance
# 2000-02-13 v0.1.0 - added: relative thing sizes, object rotation
#                            objThing, adjust in makeObject 
# 2000-02-22 v0.1.1 - added: addCells, 
#                     fixed: place things even for empty cells, 
#                            things rel size also can be > cells size
# 2000-02-27 v0.1.2 - added: things relative to others
# 2000-03-05 v0.1.3 - fixed: things relative to others (includes relativeto size)
#                     added: nogen
# 2000-03-10 v0.1.4 - added: aLink etc, support base => 'objname" (caller doesnt need gf->obj())
# 2000-03-15 v0.1.5 - added: ##path## support, support for 'prop' inside $room
#            

package Cowgen::VWorld::Room;
require Exporter;
@ISA     = qw(Exporter);
@EXPORT  = qw(
             inX inY inZ empty none cell worldAsBunch pushCell cell
             cellByName cellById
             emptyCell
             atWall atCell atThing
             aTP aCell aThing aLink
             openDoor openWindow unlitWindow litWindow fakeDoor omniLight thing
             objThing objLink
             terrainPoint makeObject addCells
             );
@EXPORT_OK = qw( cellsToBunch );

use Cowgen::Bunch;
use Cowgen::Dromed;
use Cowgen::Thief;                  # for link objects
use Cowgen::Objsize;
use Cowgen::Architecture::Basics;
use strict 'vars';

my $version = '0.15';
my $count = "000";
my $id = 1;
my $tpcnt = "000";

sub none 
  {
  # dont divide cell any further, instead generate room out of it
  0; 
  }

sub inX 
  {
  # divide cell in the X-axis
  1; 
  }

sub inY 
  {
  # divide cell in the Y-axis
  2; 
  }

sub inZ 
  {
  # divide cell in the Z-axis
  4; 
  }

sub empty
  {
  # dont do anything with that room
  -1; 
  }

sub aCell() { 1; }
sub aThing() { 2; }
sub aTP() { 4; }
sub aLink() { 8; }

sub atThing
  {
  # align a thing flush with its outer border to the wall (center is 
  # wall-thing->size) like things standing inside the walls and not stickin 
  # into them
  0; 
  }

sub atWall
  {
  # align a thing flush with its center to the wall (like columns, things 
  # sticking in the wall)
  1; 
  }

sub atCell
  {
  # align a thing flush with its center to the cells outer border (like doors,
  # windows)
  2; 
  }

sub coordFromFacing
  {
  # create relative x,y,z from facing
  my ($facing) = @_;
  $facing = aSouth() if (!defined $facing);
  if ($facing == aSouth()) { return ($facing,0.5,0,0); }
  if ($facing == aNorth()) { return ($facing,-0.5,0,0); }
  if ($facing == aWest())  { return ($facing,0,-0.5,0); }
  if ($facing == aEast())  { return ($facing,0,+0.5,0); }
  if ($facing == aTop())   { return ($facing,0,0,0.5);  }
  if ($facing == aBottom()) { return ($facing,0,0,-0.5); }
  return (aSouth(),0,0,0); # center if none
  }

sub thing
  {
  # make a thing from x,y,z (relative coords), facing and hash
  # parameters: x,y,z,facing (aSouth() etc), thinghash 
  my ($x,$y,$z,$facing,$p) = @_;
  my $d = copyHash($p);
  $d->{height} = $p->{height} || 5; # set some defaults
  $d->{width} = $p->{width} || 6;
  $d->{length} = $p->{length}; # if length is left of, dont set def(for doors!)
  $d->{facing} = $facing || aSouth();
  $d->{ax} = $p->{ax} || atThing();
  $d->{ay} = $p->{ay} || atThing();
  $d->{az} = $p->{az} || atThing(); # make at floor
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{x} = $x; $d->{y} = $y; $d->{z} = $z;
  $d->{gen} = $p->{gen} || \&frame;
  $d->{id} = $id++; # my id
  $d->{type} = aThing();
  $d->{inherit} = $p->{inherit} || false();
  return $d;
  }

sub objLink
  {
  # make a link between two things, given by path/name
  # named parameters: from, to, flavour, inherit, data (anon array)
  my ($p) = @_;
  my $l = copyHash($p);
  # set some defaults
  $l->{from} = $p->{from} || "object##num##"; 
  $l->{to} = $p->{to} || "object##num##"; 
  $l->{flavour} = $p->{flavour} || "contains"; 
  $l->{data} = $p->{data} || [ ]; 
  $l->{id} = $id++; # my id
  $l->{type} = aLink();
  $l->{inherit} = $p->{inherit} || false();
  return $l;
  }

sub objThing
  {
  # just like thing, but sets some defaults special for objects
  # parameters: x,y,z,facing (aSouth() etc), thinghash 
  my ($x,$y,$z,$facing,$p) = @_;
  my $d = copyHash($p);
  # set proper objectsize
  $d->{width} = $p->{width} || 0; $d->{length} = $p->{length} || 0; 
  $d->{height} = $p->{height} || 0;  
  setObjSize($d) if (($d->{width} == 0) && ($d->{length} == 0) && ($d->{height} == 0));
  $d->{facing} = $facing || aSouth();
  $d->{ax} = $p->{ax} || atThing();
  $d->{ay} = $p->{ay} || atThing();
  $d->{az} = $p->{az} || atThing(); # make at floor
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{x} = $x; $d->{y} = $y; $d->{z} = $z;
  $d->{gen} = $p->{gen} || \&makeObject;
  $d->{prop} = {} if (!defined $d->{prop});
  $d->{id} = $id++; # my id
  $d->{type} = aThing();
  $d->{inherit} = $p->{inherit} || false();
  $d->{nogridsnap} = 1; # objects dont need to be gridsnapped
  return $d;
  }

sub terrainPoint
  {
  # make a tp from x,y,z (relative coords), facing and hash
  # parameters: x,y,z,facing (aSouth() etc), thinghash 
  my ($x,$y,$z,$facing,$p) = @_;
  my $d = copyHash($p);
  $d->{facing} = $facing || aSouth();
  $d->{ax} = $p->{ax} || atWall();
  $d->{ay} = $p->{ay} || atWall();
  $d->{az} = $p->{az} || atWall(); # make at floor
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{x} = $x || 0; $d->{y} = $y || 0; $d->{z} = $z || 0;
  $d->{gen} = \&tPoint;
  $d->{id} = $id++; # my id
  $d->{type} = aTP();
  $d->{inherit} = $p->{inherit} || false();
  return $d;
  }

sub openDoor
  {
  # make a door description hash from given place and hash. door() will return 
  # a standard door at the south wall 
  # x,y,z are relative coordinates X,Y,Z (all -0.5 .. 0.5) and ax,ay,az are
  # of atWall/atCell/atThing. see VRoom
  # parameters: x,y,z,facing (aSouth() etc), doorhash
  my ($facing,$p) = @_;
  my $d = copyHash($p);
  $d->{height} = $p->{height} || 7;
  $d->{width} = $p->{width} || 4;
  $d->{framethick} = $p->{framethick} || 0.25;
  $d->{blockthick} = 0;
  # make x,y from facing
  ($d->{facing},$d->{x},$d->{y}) = coordFromFacing($facing);
  # override if not defined by caller
  $d->{x} = $p->{x} if (defined $p->{x}); 
  $d->{y} = $p->{y} if (defined $p->{y}); 
  $d->{z} = -0.5 if !defined $d->{z};
  $d->{ax} = atCell(); $d->{ay} = atCell();
  $d->{ax} = $p->{ax} if (defined $p->{x}); 
  $d->{ay} = $p->{ay} if (defined $p->{y}); 
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{az} = $p->{az} || atThing(); # make at floor
  $d->{gen} = \&frame;
  $d->{id} = $id++; # my id
  $d->{type} = aThing();
  $d->{inherit} = $p->{inherit} || false();
  return $d;
  }

sub openWindow
  {
  # make a window description hash from given place and hash. openWindow() 
  # will return a standard window at the south wall 
  # parameters: facing (aSouth() etc), windowhash
  my ($facing,$p) = @_;
  my $w = copyHash($p);
  $w->{height} = $p->{height} || 4;
  $w->{width} = $p->{width} || 4;
  $w->{framethick} = $p->{framethick} || 0.25;
  $w->{blockthick} = 0;
  # make x,y from facing
  ($w->{facing},$w->{x},$w->{y}) = coordFromFacing($facing);
  # override if defined by caller
  $w->{x} = $p->{x} if (defined $p->{x}); 
  $w->{y} = $p->{y} if (defined $p->{y}); 
  $w->{z} = 0 if !defined $w->{z};
  $w->{sx} = $p->{sx} || 0; # space from wall
  $w->{sy} = $p->{sy} || 0;
  $w->{sz} = $p->{sz} || 0; 
  $w->{ax} = atCell(); $w->{ay} = atCell();
  $w->{ax} = $p->{ax} if (defined $p->{x}); 
  $w->{ay} = $p->{ay} if (defined $p->{y}); 
  $w->{az} = $p->{az} || atThing(); 
  $w->{gen} = \&frame;
  $w->{id} = $id++; # my id
  $w->{type} = aThing();
  $w->{inherit} = $p->{inherit} || false();
  return $w;
  }

sub unlitWindow 
  {
  # make a unlit window description hash from given place and hash. unlitWindow() will return 
  # a standard window at room center (not very usefull :o)
  # parameters: facing (aSouth() etc), windowhash
  my $w = litWindow(@_);
  delete $w->{light};
  return $w;
  }

sub litWindow
  {
  # make a unlit window description hash from given place and hash. litWindow() will return 
  # a standard window at the south wall. 
  # parameters: place (aSouth() etc), windowhash
  my ($facing,$p) = @_;
  my $w = copyHash($p);
  $w->{height} = $p->{height} || 4;
  $w->{width} = $p->{width} || 4;
  $w->{framethick} = $p->{framethick} || 0.5;
  $w->{blockthick} = $p->{blockthick} || 0.5;
  $w->{light} = $p->{light} || 128;
  # make x,y from facing
  ($w->{facing},$w->{x},$w->{y}) = coordFromFacing($facing);
  # override if defined by caller
  $w->{x} = $p->{x} if (defined $p->{x}); 
  $w->{y} = $p->{y} if (defined $p->{y}); 
  $w->{z} = 0 if !defined $w->{z};
  $w->{ax} = atCell(); $w->{ay} = atCell();
  $w->{ax} = $p->{ax} if (defined $p->{x}); 
  $w->{ay} = $p->{ay} if (defined $p->{y}); 
  $w->{az} = $p->{az} || atThing(); 
  $w->{gen} = \&frame;
  $w->{sx} = $p->{sx} || 0; # space from wall
  $w->{sy} = $p->{sy} || 0;
  $w->{sz} = $p->{sz} || 0; 
  $w->{id} = $id++; # my id
  $w->{type} = aThing();
  $w->{inherit} = $p->{inherit} || false();
  return $w;
  }

sub fakeDoor
  {
  # make a fake door description hash from given place and hash. fakeDoor() 
  # will return a standard fake door at the south wall 
  # parameters: facing (aSouth() etc), doorhash
  my ($x,$y,$z,$facing,$p) = @_;
  my $d = copyHash($p);
  $d->{height} = $p->{height} || 7;
  $d->{width} = $p->{width} || 4;
  $d->{framethick} = $p->{framethick} || 0.5;
  $d->{blockthick} = $p->{blockthick} || 0.5;
  # make x,y from facing
  ($d->{facing},$d->{x},$d->{y}) = coordFromFacing($facing);
  # override if defined by caller
  $d->{x} = $p->{x} if (defined $p->{x}); 
  $d->{y} = $p->{y} if (defined $p->{y}); 
  $d->{ax} = atCell(); $d->{ay} = atCell();
  $d->{ax} = $p->{ax} if (defined $p->{x}); 
  $d->{ay} = $p->{ay} if (defined $p->{y}); 
  $d->{z} = $p->{z} if (defined $p->{z});
  $d->{z} = -0.5 if (!defined $d->{z}); 
  $d->{az} = $p->{az} || atThing(); # make at floor
  $d->{gen} = \&frame;
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{id} = $id++; # my id
  $d->{type} = aThing();
  $d->{inherit} = $p->{inherit} || false();
  return $d;
  }

sub omniLight
  {
  # make a omni light description hash from given x,y,z (relatively in room)
  # and hash. omniLight() will return a standard light at room center 
  # parameters: x ( -.5 <= z <= 0.5),y (-0.5 <= z <= 0.5),z (-0.5 <= z <= 0.5), 
  # lighthash (light)
  my ($x,$y,$z,$p) = @_;
  my $d = copyHash($p);
  $d->{light} = $p->{light} || 128;
  $d->{x} = range ($x,-0.5,0.5); $d->{y} = range ($y,0-.5,0.5); $d->{z} = range ($z,0-.5,0.5);
  $d->{gen} = \&putLight;
  $d->{ax} = atWall(); $d->{ay} = atWall(); $d->{az} = atWall();
  $d->{sx} = $p->{sx} || 0; # space from wall
  $d->{sy} = $p->{sy} || 0;
  $d->{sz} = $p->{sz} || 0; 
  $d->{id} = $id++; # my id
  $d->{type} = aThing();
  $d->{inherit} = $p->{inherit} || false();
  return $d;
  }

sub cell 
  { 
  # create a new cell
  # named parameters: name, div (inX();inY();inZ() or none() for not),
  # size ( relative size from >0.0 .. 1.0), min (absolut), max (absolut),
  # room (room description hash), list of subchilds (optional), gen
  # (ref to room generator function; defaults to Basics:basicRoom)
  my $c = {};
  my $p = $_[0];
  if (!defined $p)
    {
    $p = {}; 
    print "Warning: Description hash is undefined in cell().\n";
    }
  $p = { @_ } if (ref($p) ne 'HASH');
  $c = copyHash($p);
  $c->{name} = $p->{name} || "cell##num##"; 
  $c->{name} =~ s/##num##/ $count++; /eg; 
  $c->{div} = $p->{div} || none();
  $c->{size} = $p->{size} || 1;
  $c->{min} = $p->{min} || 0;
  $c->{max} = $p->{max} || 0;
  $c->{room} = $p->{room} if (defined $p->{room}); # room descr. (or inherit)
  $c->{cells} = $p->{cells} || []; # list with subcells
  $c->{gen} = $p->{gen} if (defined $p->{gen}); # room generator
  $c->{grid} = $p->{grid} || 0.25;
  $c->{things} = $p->{things} || []; # empty list of things to place
  $c->{debug} = $p->{debug} if (defined $p->{debug});
  $c->{flood} = $p->{flood} if (defined $p->{flood});
  $c->{nowall} = $p->{nowall} if (defined $p->{nowall});
  $c->{noinherit} = $p->{noinherit} || false();
  $c->{id} = $id++; # my id
  $c->{type} = aCell();
  return $c;  # cell
  }

sub emptyCell
  {
  # create a new cell, that has no room in it (for filling left over space in
  # a cell)
  # parameters: size, min (absolut), 
  # max (absolut),
  my $c = {};
  $c->{name} = "empty##num##"; $c->{name} =~ s/##num##/ $count++; /eg; 
  $c->{div} = empty();
  $c->{size} = shift || 1;
  $c->{min} = shift || 0;
  $c->{max} = shift || 0;
  $id ++; $c->{id} = $id; # my id
  $c->{type} = aCell();
  $c->{things} = [];
  $c->{cells} = [];
  return $c;  # cell
  }

sub pushCell
  {
  # take a cell and push it up the list of subcells of one cell
  my $c = shift || return;
  my $p = shift || return;
  push (@{$c->{cells}}, $p);
  }

sub cellByName
  {
  # walk all child-cells recursively and return first cell with that name or 
  # undefined.
  # So name your rooms unique if you want to seperate them later on :)
  # parameter: parent cell, name
  my $c = shift || return;
  my $name = shift || return;
  my ($i,$j,$n);
  return $c if ($c->{name} =~ /$name/);
  if (($c->{div} != none()) && ($c->{div} != empty()))
    {
    $j = scalar @{$c->{cells}}; 
    for ($i = 0; $i < $j; $i++)
      {
      $n = cellByName ($c->{cells}->[$i],$name);
      return $n if (defined $n); # fast way out
      }
    }
  return;
  }

sub cellById
  {
  # walk all child-cells recursively and return cell with given ID
  # parameter: parent cell, id
  my $c = shift || return;
  my $id = shift || return;
  my ($i,$j,$n);
  return $c if ($c->{id} eq $id);
  if (($c->{div} != none()) && ($c->{div} != empty()))
    {
    $j = scalar @{$c->{cells}}; 
    for ($i = 0; $i < $j; $i++)
      {
      $n = cellById ($c->{cells}->[$i],$id);
      return $n if (defined $n); # fast way out
      }
    }
  return;
  }

sub cloneCell
  {
  # take a ref to a cell and clone it including all subcells
  my $o = shift || return;
  # print "at clone $o->{name}\n";
  my $c = copyHash($o); # clone
  $c->{cells} = [];
  foreach (@{$o->{cells}})
    {
    pushCell ($o,cloneCell($_));
    }
  return $c;
  }

sub addCells
  {
  # add cell(s) to cell
  # parameters: cell, count, sizestring, namestring
  my ( $cell, $count, $size, $name) = @_;
  return if (!defined $cell); 
  $count = abs($count || 0); $count = 64 if ($count > 64);
  return if ($count == 0);
  $size =~ tr/0-9,//cd;
  my @s = split (",",$size);
  my @n = split (",",$name);
  my ($c,$sa,$lasts,$lastn);
  my $last = $s[0] || 1; my $mn;
  for (my $i = 0; $i < $count; $i++)
    {
    $lasts = $s[$i] || $lasts; 
    $lastn = $n[$i] || $lastn; 
    $lastn =~ s/^\s*//g; $lastn =~ s/\s*$//g;
    $mn = $lastn; $mn =~ s/##num##/_$i/;
    pushCell ($cell, cell ( name => $mn, size => $lasts, ));
    } 
  $cell;
  } 

#######################################################################
# To bunch stuff

sub worldAsBunch
  {
  # create the world from the cells as a bunch
  # Return either a Bunch or a list consisting of the Bunch and a Hash
  # containing the terrain points. cell needs gamfile set!
  # parameters: x,y,z, w,l,h, cell, gamefile
  my ($x,$y,$z,$w,$l,$h,$c,$gf) = @_;
  my $tp = {};
  my $b1 = Cowgen::Bunch->create($c->{name});
  # create things as seperate cuz timeline
  my $b2 = Cowgen::Bunch->create("things"); 
  cellsToBunch( $x,$y,$z,$l,$w,$h,$b1,$b2,$tp,$c);  # swap w/l
  $b1->merge ($b2); # insert things into world
  # now generate all the links
  my (@from,@to);
  my $ol = $b1->getObjList();
  my $bx = $x - $w/2; my $by = $y; my $bz = $z;
  foreach my $l (keys %$tp)
    {
    if ($tp->{$l}->{type} == aLink())
      {
      # add link to object system
      # find from/to object
      # it wouldnt help when we remember the OIDs on creation, since merging bunches
      # shuffles them around, sight...lets hope that searching for 2*links*objects isnt
      # to slow...
      @from = $b1->{olist}->idByPathName ($tp->{$l}->{from});
      @to = $b1->{olist}->idByPathName ($tp->{$l}->{to});
      if ((!defined @to) || (!defined @from))
        {
        print "Room.pm: Error: Cant find:\n";
        print " From for link from '$tp->{$l}->{from}' to '$tp->{$l}->{to}'.\n" 
         if (!defined @from == 0);
        print " To for link from '$tp->{$l}->{from}' to '$tp->{$l}->{to}'.\n" 
         if (!defined @to == 0);
        }
      else
        {
        Cowgen::Thief::linkObjects ($b1,$c->{gamfile},\@from,\@to,
         $tp->{$l}->{flavour} || 0,$tp->{$l}->{flags} || 0,$tp->{$l}->{data}, $bx,$by,$bz);
        }
      }
    }
  wantarray() ? return ($b1,$tp) : return $b1;
  }

sub cellsToBunch
  {
  # walk cell list recursively and create as bunch, intern usage only
  # if tp = \@ then rectangles are created, otherwise terrainpoints
  # parameters: x,y,z, w,l,h, bunch, me, parent
  my ($x,$y,$z,$l,$w,$h,$bunch,$things,$tp,$c,$p,$level,$path) = @_;

  return if (!defined $c);
  my ($gen,$ro,$debug);
  $c->{parent} = $p; $p = {} if (!defined $p);
  if ((!defined $c->{room}) && (!defined $p->{room}))
    {
    print "Error! Neither me ($c->{name}) nor parent ($p->{name}) have room!\n";
    return;
    }
  my $pname = $c->{name} || ""; 
  $path = "" if (!defined $path); $path .= $pname.'->'; 
  # we need to make some copies here, since we dont want cellsTobunch to 
  # actively modify the cells while creating them. Caller might need the them.
  $ro = copyHash($p->{room});
  # now overwrite with our own stuff so that it takes precedence
  if (defined $c->{room}) # ? should an empty hash spring into existence?
    {
    foreach (keys %{$c->{room}}) { $ro->{$_} = $c->{room}->{$_}; }
    }
  # altough flood and nowall are attached to cell, we copy it into room, so 
  # that it gets inherited. you could override flood and nowall for one room 
  # by putting it in $room, but cell is prefered
  $ro->{flood} = $c->{flood} if (defined $c->{flood});
  $ro->{nowall} = $c->{nowall} if (defined $c->{nowall});
  $ro->{clobberwall} = $c->{clobberwall} if (defined $c->{clobberwall});
#  print "$ro->{name} $ro->{nowall}\n" if (defined $ro->{nowall});
  $gen = $c->{gen} || $p->{gen} || $ro->{gen} || \&basicRoom; # room generator
  $ro->{gridsize} = 0.25 if (!defined $ro->{gridsize});
  adjustFlood($z,$h,$ro);
  $ro->{debug} = $c->{debug} if (defined $c->{debug});
  $ro->{prop} = {} if !defined $ro->{prop};
  $debug = $ro->{debug};
  $level = 0 if (!defined $level); # debug
 print " " x $level."$pname: $x $y $z ($w $l $h)\n" if (defined $debug);
  $c->{level} = $level; $level++; 
  $tpcnt = "000"; # reset terrain point count for this cell
  if (ref ($things) eq "Cowgen::Bunch") # only rectangle info?
    { 
    if (($c->{div} == none()) && (scalar @{$c->{cells}} == 0))
      {
      # noWall and wallthick is used by gen since ledge has to be adjusted there
      my $b = &{$gen}($x,$y,$z,$w,$l,$h,$ro);
      if (keys %{$ro->{prop}} != 0)
        {
        # make custom sound room, add it
        my $po = { base => $ro->{gamfile}->obj('Base Room'), name => "room_$c->{name}", };
        my $roid = $b->addObject( 0,0,0,0,0,0, $po);
        $b->optimize(); $b->autoRoom(1,$roid);
        }
      $bunch->merge( $b );
      } 
    }
  # generate rectangle info
  $tp->{$c->{id}} = { x => $x, y => $y, z => $z, w => $w, l => $l, 
    h => $h, type => aCell(), level => $level }; # the cell
  if ((defined $c->{things}) && (@{$c->{things}} > 0))
    {
    placeThings ($x,$y,$z,$w,$l,$h, $ro, $c, $bunch, $things, $tp, $level, $path);
    }
  # end recursion
  return if (($c->{div} == none()) || ($c->{div} == empty()) || (scalar @{$c->{cells}} == 0)); 
  # divide now
  my ($j,$factor,$size,$ofs,@coord,@sizes,$i,$child,$s,$parent);
  $coord[0] = $x; $coord[1] = $y; $coord[2] = $z;
  $coord[3] = $l; $coord[4] = $w; $coord[5] = $h; # swap w/l for width is in Y
  if ($c->{div} == inX()) { $coord[0] -= $l/2; $ofs = 3; }
  if ($c->{div} == inY()) { $coord[1] -= $w/2; $ofs = 4; }
  if ($c->{div} == inZ()) { $coord[2] -= $h/2; $ofs = 5; }
  # walk list of subcells and sum up all sizes
  # we actually could merge this and the next loop to one go...
  # but this would look ugly
  if (!defined $c->{cells})
    {
    print "Error: $c->{name} should be divided but has no sub cells!\n"; return;
    }
  $j = scalar @{$c->{cells}}; $factor = 0; 
  for ($i = 0; $i < $j; $i++) { $factor += $c->{cells}->[$i]->{size}; }
  # store entire wanted size of cell
  my $cellsize = $coord[$ofs];
  # walk list of subcells and find out ones with fixed size
  $j = scalar @{$c->{cells}}; 
  for ($i = 0; $i < $j; $i++)
    {
    $child = $c->{cells}->[$i];
    $size = 0; # dont care is default
    $s = $coord[$ofs]*$child->{size}; 
    $size = $child->{min} if (($child->{min} != 0) && ($s < $child->{min}));
    $size = $child->{max} if (($child->{max} != 0) && ($s > $child->{max}));
    ($size) = snapLength($c->{grid}, $size);
    if ($size != 0)
      {
      $coord[$ofs] -= $size;     # subtract this cells size
      $factor -= $child->{size}; # and adjust factor by cells wanted % value, 
                                 # this way other cells will keep their 
                                 # prop.to each other 
      }
#    print " fsize: $i => $size $child->{size}\n";
    $sizes[$i] = $size;
    }
  # now we have fixed any cell that needs a certain size, so just tackle the
  # leftover-dont-cares now 
  my $all = 0; # sum because snapping actually can shuffle things around
  for ($i = 0; $i < $j; $i++)
    {
    $child = $c->{cells}->[$i];
    $sizes[$i] = snapLength($c->{grid}, 
     ($coord[$ofs]*$child->{size}/$factor)) if ($sizes[$i] == 0);
    $all += $sizes[$i];
    }
  # last room acts as a buffer, and is adjusted, so that even with snapping we
  # have all rooms consume the entire cell, not more or less
#  print "sizeadjust: $all wanted, but need $cellsize\n" if ($all != $cellsize);
  $sizes[-1] += ($cellsize-$all);
  # recursion 
  my $th;
  for ($i = 0; $i < $j; $i++)
    {
    $child = copyHash($c->{cells}->[$i]); $coord[$ofs] = $sizes[$i]; 
    $coord[$ofs-3] += $coord[$ofs]/2; # pre-adjust
    # make copy so that we keep org.
    $parent = copyHash($c); $parent->{room} = $ro; 
    # copy things
    $child->{things} = [ @{$c->{cells}->[$i]->{things}} ];
    # add inherited things
    if (!$child->{noinherit})
      {
      foreach $th (@{$parent->{things}})
        {
        push (@{$child->{things}}, $th) if ($th->{inherit} == true());
        } 
      }
    cellsToBunch( @coord,$bunch,$things,$tp,$child,$parent,$level,$path);
    $coord[$ofs-3] += $coord[$ofs]/2; # post-adjust
    }
  }

sub placeThings
  {
  # place a thing into the room
  # put things, doors & windows into another bunch because they have to appear
  # later then _all_ the rooms (at least the non-fake door-windows)
  # terrain points are generated extra in TP since we need them for route.pm
  my ($x,$y,$z,$w,$l,$h, $ro, $c, $bu, $things, $tp, $level,$path) = @_;

  my $wt = ($ro->{wallthick} || 0.5)*2;
  my $flt = $ro->{floorthick} || $wt/2;
  my $clt = $ro->{ceilingthick} || $wt/2;
  my ($t,$ft,$p,$tw,$tl,$th,$ww,$wh,$wl,$pax,$pay,$paz,$pf,$bt,$thing,@p);
  my ($px,$py,$pz,$dx,$dy,$dz);
  # room center, can be different from x,y,z when wallthicks are not symmetrical
  my ($cx,$cy,$cz,$tz,$tx,$ty,$bw,$bl,$bh,$f); 
  my (@todo,@scratch,$done,@donethings,$found);
  # first put things that dont depend on others, then all the others until
  # none is left or none was done in a round (error) 
  @todo = @{$c->{things}};
  # while we have still some left
  $path =~ s/\-\>$//;
  while (@todo > 0)
    {
    @scratch = @todo; undef @todo; $done = 0;
    foreach $t (@scratch)
      {
      if ($t->{type} == aLink())
        {
        $f = $t->{flavour}; $f = $t->{gamfile}->flavour($f) if ($f =~ /[a-z]/); 
        $tp->{$t->{id}} = { x => 0, y => 0, z => 0, w => 0, l => 0, 
          from => $t->{from}, to => $t->{to}, flavour => $f, data => $t->{data},
          flags => $t->{flags}, h => 0, type => aLink(), level => $level, path => $path }; 
        $tp->{$t->{id}}->{from} =~ s/##path##/$path\-\>/;
        $tp->{$t->{id}}->{to} =~ s/##path##/$path\-\>/;
        $done++; next; # skip links
        }
      # skip inherited things for parent/empty cells
      if ((defined $t->{inherit}) && ($t->{inherit} == true()) 
       && ($c->{div} != none()))
        {
        $done++; next; # even if we didnt "do" this thing, count it as done
        }
      # skip things when their nogen matches 
      if ((exists $t->{conditional}))
        {
        @p = split /,/,$t->{conditional}; 
        if (exists $ro->{$p[0]})
          {
          if ( (($p[1] != 0) && ($ro->{$p[0]} eq ($p[2] || "0"))) 
            || (($p[1] == 0) && ($ro->{$p[0]} ne ($p[2] || "0"))) )
            {
            $done++; next; # even if we didnt "do" this thing, count it as done
            }
          }
        }
      if (exists $t->{relativeto})
        {
        my $r = $t->{relativeto} || "huh!?";  
        # check wether the relativto thing was yet created
        $found = 0;
        foreach (@donethings)
          {
          next if (!defined $_->{name});
          if ($_->{name} =~ /$r/)
            {
            # debug:
            #print "$t->{name} is relative to $t->{relativeto} (using: '$_->{name}').\n"; 
            $found = 1;
            # okay, base thing position on that, get directions first
            $dx = ($t->{dx} || 0)/2; $dy = ($t->{dy} || 0)/2; $dz = ($t->{dz} || 0)/2; 
            # XXX: should consider rotation too!
            $tw = $t->{width} || 0; $tl = $t->{length} || 0;
            ($tw,$tl) = ($tl,$tw) if ( ($t->{facing} == aWest()) || ($t->{facing} == aEast()));
            if ( ($_->{facing} == aWest()) || ($_->{facing} == aEast()))
              {
              $tw += ($_->{width} || 0); $tl += ($_->{length} || 0);
              }
            else 
              {
              $tl += $_->{width} || 0; $tw += $_->{length} || 0;
              }
            $t->{tx} = $_->{tx} + $tl*$dx + $t->{x};
            $t->{ty} = $_->{ty} + $tw*$dy + $t->{y};
            $t->{tz} = $_->{tz} + ($t->{height}+$_->{height})*$dz + $t->{z};
            }
          } 
        if ($found == 0)
          {
          #print "Warning: Room.pm: Thing $t->{name} is relative to '$t->{relativeto}' but $t->{relativeto} ",
          #      " not yet created.\n Defered creation.\n";
          push (@todo,$t); next;
          }
        }
      $done++; push @donethings,$t;
      # make local copy
      undef $p; $p = copyHash($t); $t->{parent} = $c; 
      $ft = $p->{framethick} || 0.5; 
      $p->{flood} = $ro->{flood}; $p->{name} = "" if (!defined $p->{name});
      $p->{name} =~ s/##num##/'_'.$count++/eg;
      $pax = $p->{ax} || 0; $pay = $p->{ay} || 0; $paz = $p->{az} || 0;
      # wall thick is default so doors/windows will come out right
      $bt = $ro->{bandthick} || 0;
      # honor relative sizes, calculate base sizes
      $bw = $w; $bl = $l; $bh = $h;
      $bw -= $wt if ($pay != aCell());
      $bl -= $wt if ($pax != aCell());
      $bh -= ($flt+$clt) if ($paz != aCell());
      # correct by wall spacings
      $bw -= $p->{sy}*2 if ($pay == atThing());
      $bl -= $p->{sx}*2 if ($pax == atThing());
      $bh -= $p->{sz}*2 if ($paz == atThing());
      # the following is not quite correct, it should consider the thingy rotated
      $pf = turnByFacingCcw($p->{facing} || aSouth(),0) + ($p->{rz} || 0);
      ($bw,$bl) = ($bl,$bw) if (($pf != 0) && ($pf != 180));
      $tw = rel2abs($p->{width} || 4,$bw,1);
      $tl = rel2abs($p->{length} || ($wt+$bt*2),$bl,1); 
      $th = rel2abs($p->{height} || 4,$bh,1);
      $ww = $w; $ww -= $wt if ($pay == atWall());
      $wl = $l; $wl -= $wt if ($pax == atWall());
      $wh = $h; $cx = $x; $cy = $y; $cz = $z;
      if ($paz == atWall())
        {
        $wh -= ($flt+$clt); $cz = $cz + ($flt-$clt)/2;
        }
      # the following is not quite correct, it should consider the thingy rotated
      my $twa = $tw; my $tla = $tl; 
      ($twa,$tla) = ($tla,$twa) if (($pf != 0) && ($pf != 180));
      $ww -= ($twa+$wt) if ($pay == atThing());
      $wl -= ($tla+$wt) if ($pax == atThing());
      if ($paz == atThing())
        {
        $wh -= ($th+$flt+$clt); $cz = $cz + ($flt-$clt)/2;
        }
      # adjust placement cube by wall-spacing
      $ww -= ($p->{sy}*2) if (defined $p->{sy});
      $wl -= ($p->{sx}*2) if (defined $p->{sx});
      $wh -= ($p->{sz}*2) if (defined $p->{sz});
      if (($ww < 0) || ($wl < 0) || ($wh < 0))
        {
        print "Warning: $p->{name} wont fit in $c->{name} ($ww,$wl,$h)\n";
        $ww = 0 if ($ww < 0); $wl = 0 if ($wl < 0); $wh = 0 if ($wh < 0); 
        }
      # if any dimension is 0..-1 then make it based on actuall room size
      $px = $p->{x} || 0; $pz = $p->{z} || 0; $py = $p->{y} || 0;
      $tx = ($px * $wl + $cx); $ty = ($py * $ww + $cy); $tz = ($pz * $wh + $cz);
      ($tx,$ty,$tz) = snap2Grid ($ro->{gridsize}, $tx, $ty, $tz) if (!defined $p->{nogridsnap});
      $p->{terrainpoints} = $tp;
      $p->{tpname} = "$path\-\>$p->{name}"; $p->{path} = $path; 
      if (ref($things) eq "Cowgen::Bunch")
        {
        if (!defined $t->{relativeto})
          {
          # remember pos/size for relativeto
          $t->{tx} = $tx; $t->{ty} = $ty; $t->{tz} = $tz; 
          $t->{tw} = $tw; $t->{tl} = $tl; $t->{th} = $th; 
          }
        $thing = &{$p->{gen}}( $t->{tx}, $t->{ty}, $t->{tz}, $tw, $tl, $th, $p);
        $things->merge ( $thing ) if (defined $thing); 
        }
      # a tp or thing
      $tp->{$p->{id}} = { x => $tx, y => $ty, z => $tz, w => $tw, l => $tl, 
        h => $th, type => $p->{type}, level => $level, path => $p->{tpname} }; 
      } # end for all in this round
    if (($done == 0) && (@scratch > 0))
      {
      print "Warning: Room.pm: Some things depend on things that are not yet created.\n";
      print " (This means you have probably created a circular reference)\n";
      print " In cell '$c->{name}' the following things were left over:\n";
      foreach (@todo)
        {
        print "'$_->{name}' (should be relative to: '$_->{relativeto}')\n";
        }
      last;
      }
    } # end for all things
  return; 
  }

sub adjustFlood
  {
  # take a relative or absolute flood line value and adjust it
  my ($z,$h,$ro) = @_;
  my $f = $ro->{flood};
  return if (!defined $f);
  if ($f =~ /^([0-9\.]+)\%/)
    {
    ($f) = snap2Grid(0.25,$z - $h/2 + $h*$1/100); 
    }
  elsif ($f =~ /^\+([0-9\.]+)$/)
    {
    ($f) = snap2Grid(0.25,$z - $h/2 + $1); 
    }
  if ($f <= $z - $h/2)
    {
    undef $f; # waterline too low, disable
    }
  elsif ($f >= $z + $h/2) 
    {
    $f = $z + $h/2; # waterline too high, set to maximum
    }
  $ro->{flood} = $f;
  }

##############################################################################
# generators

sub tPoint
  {
  # generate a terrain point
  # add at pos x,y,z a terrain point, w,l,h are ignored
  # named parameters: name, terrainpoints 
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $tp = $p->{terrainpoints} || return; 
  my $name = $p->{name} || $p->{tpname} || "tpoint##num##";
  $name = s/##num##/"_".$tpcnt++/eg;
  $tp->{$p->{name}} = [ $x, $y, $z ];
  return;
  }

sub makeObject
  {
  # generate an object from hash
  # add at pos x,y,z the object, w,l,h are ignored
  # named parameters: name, hash, base, prop (properties), gamfile (!needed!), facing 
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  $p = {} if (!defined $p);
  my $name = $p->{name} || "object##num##";
  my $facing = $p->{facing} || aSouth();
  my $gf = $p->{gamfile};
  my $b = Cowgen::Bunch->create($name); 
  my $base = $p->{base} || 1;
  $base = $gf->obj($base) if ($base =~ /[a-z]/);
  my $t = { name => $name, base => $base, path => $p->{path} || "",  };
  my $o = $b->addObject ($x,$y,$z,$w,$l,$h,$t);
  &{$p->{adjust}}($b,$o,$p) if (ref($p->{adjust}) eq 'CODE');
  my ($prop,$prop1,@f);
  my $del = $p->{delimter} || ','; 
  foreach $prop (keys %{$p->{prop}})
    {
    $prop1 = $p->{prop}->{$prop}; $prop1 =~ s/\s*$del\s*/$del/g;
    @f = split($del, $prop1);
    # dont we love Perl? ("O_CLOSED, FALSE" will now work here)
    foreach (@f) { $_ = eval($_); } 
    $b->setProperty ($o, $prop, @f ); 
    }
  # fix for objects that dont face south with rz==0
  $b->rotate($p->{rx},$p->{ry},$p->{rz},$x,$y,$z);
  $b->rotateByFacing($x,$y,$z,$facing);
  return $b;
  }

1;
