#!/usr/bin/perl -w

# This is the package RoomGen. It contains some room generattors for the vworld
# stuff.

# usage: see Vxxx.pl scripts

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

# 2000-03-28 v0.0.1 - parts form Basics/Architecture
# 2000-04-01 v0.0.2 - pyramids

package Cowgen::VWorld::RoomGen;
require Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw( 
            basicRoom atticRoom 
            );
@EXPORT_OK = qw( hollowTriangle  );

use Cowgen::Bunch;
use Cowgen::Dromed;
use Cowgen::Architecture::Basics;
use strict 'vars';

###############################################################################
# Room generator functions
###############################################################################

sub basicRoom
  {
  # create a basic room from air cube, put a running band texture around the bottom.
  # Can make the floor a raised ramp from one side to another.
  # For using in VWorld. It honours nowall. Will create "unoptimal" terrain for
  # most nowall combinations, but Bunch::optimize() will take care of that
  # named parameters: texture, bandtexture (defaults to texture), bandheight 
  # (defaults to 0; 0 is disable), floortexture (defaults to texture), 
  # ceilingtexture (defaults to texture), rampheight (defaults to 0), facing,
  # bandthick, nowall (aSouth();aNorth();aBottom() or aSouthEast or NOEDGE etc; 
  # lave off wall at this side/edge), wallthick, sidetexture (texture sides different than 
  # front/back)
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $t = $p->{texture} || -1;
  my $st = $p->{sidetexture} || $t;
  my $ft = $p->{floortexture} || $t;
  my $ct = $p->{ceilingtexture} || $t;
  my $bt = $p->{bandtexture} || $t;
  my $bh = $p->{bandheight} || 0; $bh = $h if ($bh > $h); $bh = abs($bh);
  my $rh = $p->{rampheight} || 0;
  my $nw = $p->{nowall} || 0;
  my $cw = $p->{clobberwall} || 0;
  my $wt = $p->{wallthick}; $wt = 0 if (!defined $wt);
  my $flt = $p->{floorthick}; $flt = $wt if (!defined $flt);
  my $clt = $p->{ceilingthick}; $flt = $wt if (!defined $clt);
  my $facing = $p->{facing} || aSouth();
  my $bat = $p->{bandthick} || 0;
  my $b = Cowgen::Bunch->create("basicRoom##num##");
  
  #print "$wt $x $y $z $w $l $h $nw $flt $clt\n";
  $w = $w - $wt*2; $l = $l - $wt*2; $h = $h - ($flt+$clt); $z += ($flt-$clt)/2;
  if (($nw & aBottom()) != 0)
    {
    $h += $flt; $z -= $flt/2; $nw -= aBottom();
    }
  if (($nw & aTop()) != 0)
    {
    $h += $clt; $z += $clt/2; $nw -= aTop();
    }
  #print "$wt $x $y $z $w $l $h $nw\n";
  # lay center part
  my $br = layBrush($b,$x,$y,$z,$w,$l,$h,$facing,$t,$st,$ct,$ft);
  my ($wt2);
  if ($wt > 0)
    {
    $wt2 = $wt/2;
    layBrush($b,$x+$l/2+$wt2,$y,$z,$w,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aSouth()) != 0);
    layBrush($b,$x-$l/2-$wt2,$y,$z,$w,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aNorth()) != 0);
    layBrush($b,$x,$y-$wt2-$w/2,$z,$wt,$l,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aWest()) != 0);
    layBrush($b,$x,$y+$wt2+$w/2,$z,$wt,$l,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aEast()) != 0);
    layBrush($b,$x-$l/2-$wt2,$y-$w/2-$wt2,$z,$wt,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aNorthWest()) != 0);
    layBrush($b,$x-$l/2-$wt2,$y+$w/2+$wt2,$z,$wt,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aNorthEast()) != 0);
    layBrush($b,$x+$l/2+$wt2,$y-$wt2-$w/2,$z,$wt,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aSouthWest()) != 0);
    layBrush($b,$x+$l/2+$wt2,$y+$wt2+$w/2,$z,$wt,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($nw & aSouthEast()) != 0);
    # clobber up neighbour walls
    $wt2 = 3*$wt2;
    layBrush($b,$x+$l/2+$wt2,$y,$z,$w,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aSouth()) != 0);
    layBrush($b,$x-$l/2-$wt2,$y,$z,$w,$wt,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aNorth()) != 0);
    layBrush($b,$x,$y-$wt2-$w/2,$z,$wt,$l,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aWest()) != 0);
    layBrush($b,$x,$y+$wt2+$w/2,$z,$wt,$l,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aEast()) != 0);
    $wt2 = $wt;
    layBrush($b,$x-$l/2-$wt2,$y-$w/2-$wt2,$z,$wt*2,$wt*2,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aNorthWest()) != 0);
    layBrush($b,$x-$l/2-$wt2,$y+$w/2+$wt2,$z,$wt*2,$wt*2,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aNorthEast()) != 0);
    layBrush($b,$x+$l/2+$wt2,$y-$wt2-$w/2,$z,$wt*2,$wt*2,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aSouthWest()) != 0);
    layBrush($b,$x+$l/2+$wt2,$y+$wt2+$w/2,$z,$wt*2,$wt*2,$h,$facing,$t,$st,$ct,$ft)
     if (($cw & aSouthEast()) != 0);
    } # endif wt > 0
  floodBrush($x,$y,$z,$w,$l,$h,$p->{flood},$b,$t,$ft);
  return $b;
  # band around bottom
  if ($bh > 0)
    {
    $br = $b->addBrush (solid(),cube(),$x,$y,$z-$h/2+$bh/2,$w,$l,$bh,$bt);
    my $w1 = $w-$bat*2; my $l1 = $l - $bat*2; my $x1 = $x; my $y1 = $y;
    if (($nw & aSouth()) != 0) { $l1 += $bat; $x1 += $bat/2; }
    if (($nw & aNorth()) != 0) { $l1 += $bat; $x1 -= $bat/2; }
    if (($nw & aEast()) != 0)  { $w1 += $bat; $y1 += $bat/2; }
    if (($nw & aWest()) != 0)  { $w1 += $bat; $y1 -= $bat/2; }
    $br = $b->addBrush (air()+MNOROOM,cube(),$x1,$y1,$z-$h/2+$bh/2,$w1,$l1,$bh,$bt);
    $b->setTexture ($br, bottom(),$ft) if ($ft != $bt); # floor
    }
  # wedge rising to south
  if ($rh > 0)
    {
    $b->addBrush (solid(),wedge(),$x,$y,$z-$h/2+$rh/2,$w,$l,$rh,$ft);
    }
  }

sub layBrush 
  {
  my ($b,$x,$y,$z,$w,$l,$h,$facing,$t,$st,$ct,$ft) = @_;
  return if (($w <= 0) || ($l <= 0) || ($h <= 0));
  my $br = $b->addBrush (air()+MROOM,cube(),$x,$y,$z,$w,$l,$h,$t); 
  $b->setTexture ($br, top(),$ct) if ($ct != $t);
  $b->setTexture ($br, bottom(),$ft) if ($ft != $t);
  if ($st != $t)
    {
    if (($facing == aSouth()) ||($facing == aNorth()))
      {
      $b->setTexture ($br, east(),$st); $b->setTexture ($br, west(),$st);
      }
    else
      {
      $b->setTexture ($br, south(),$st); $b->setTexture ($br, north(),$st);
      }
    }
  return $br;
  }

sub tunnelRoom
  { 
  # not ready yet
  }

sub atticRoom
  {
  # create an attic by "adding" together some basicals. the list of "basics"
  # contains hashes, listing center (x,y,z relative), dimension (w,l,h,
  # relative or absolute), rotation (rx,ry,rz), type (cube, cylinder, pyramid, 
  # apexpyramid, wedge, prisma (for double wedge), faces, texture, textureinner, 
  # wallthick, wallthickinner, ceilingthick, floorthick) if texture, wallthick 
  # etc are not defined, they will be taken from general hash params.
  my ($x,$y,$z,$w,$l,$h,$p) = @_; 
  my $facing = $p->{facing} || aSouth();
  my $txt = $p->{texture} || -1;
  my $skytxt = $p->{skytexture} || $txt;
  my $itxt = $p->{innertexture} || $txt;
  my $rtxt = $p->{rooftexture} || $txt;
  my $wto = $p->{wallthick} || 0.25; # never 0!
  my $wti = $p->{innerwallthick}; $wti = 0 if (!defined $wti);
  my $flt = $p->{floorthick}; $flt = 0 if (!defined $flt);
  my $clt = $p->{ceilingthick}; $clt = 0 if (!defined $clt);
  my $basics = $p->{basics} || [];
  my $b = Cowgen::Bunch->create("atticRoom##num##");
  my ($first);
  if ($p->{outside})
    {
    # water to protect from movetoend of air's
    $first = $b->addBrush ( water(), cube(), $x,$y,$z,$w,$l,$h,$skytxt); 
    }
  my ($wtoo_l,$hd,$wb,$type,$ct,$ft,$wth,$rx,$ry,$rz,$cx,$cy,$cz,$dw,$dl,$dh,$wtoo,$wtii,$e);
  my $faces = $b->{faces} || 6;
  foreach my $bs (@$basics) 
    {
    #printHash ($bs);
    $type = $bs->{type} || cube();
    #print "adding $type\n";
    $cx = rel2abs($bs->{x},$w)+$x-$w/2; 
    $cy = rel2abs($bs->{y},$l)+$y-$l/2; 
    $cz = rel2abs($bs->{z},$h)+$z-$h/2;
    $dw = rel2abs($bs->{w},$w); $dl = rel2abs($bs->{l},$l); $dh = rel2abs($bs->{h},$h);
    $rx = $bs->{rx} || 0; $ry = $bs->{ry} || 0; $rz= $bs->{rz} || 0; 
    # ugh, should consider turned, not just a hack
    ($dw,$dl) = ($dl,$dw) if (($rz == 90) || ($rz == 270));
    $e = copyHash($bs); 
    foreach (keys %$p)
      {
      $e->{$_} = $p->{$_} if (!defined $e->{$_});
      }
    if ($type == prisma())
      { 
      $wb = hollowWedge($cx,$cy-$dw/4,$cz,$dw/2,$dl,$dh,$e);  
      $wb->rotate (0,0,180,$cx,$cy-$dw/4,$cz);
      $wb->merge ( hollowWedge($cx,$cy+$dw/4,$cz,$dw/2,$dl,$dh,$e) );  
      }
    elsif ($type == wedge())
      {
      $wb = hollowWedge($cx,$cy,$cz,$dw,$dl,$dh,$e);  
      }
    elsif (($type == pyramid()) || ($type == apexpyramid()))
      {
      # not ready yet.
      # calc inner height by using one wallthick, then calc other wallthick by
      # this new height diff, to make both walls parallel.
      $wtoo = $b->{wallthick} || $wto; # never 0
      $wtii = $b->{innerwallthick}; $wtii = $wti if (!defined $wtii);
      $wb = Cowgen::Bunch->create(type2Name($type)."##num##");
      $wb->setFaces($faces);
      $hd = $wtoo*$h/$w; # diff at one side for quadratic ones, for rectangular
      $wtoo_l = $hd/$h*$l; # for rectangular
      $wb->addBrush (solid(), $type, $cx,$cy,$cz,$dw,$dl,$dh,$rtxt);
      $wb->addBrush (air()+mnoroom(), $type, $cx,$cy,$cz,$dw-$wtoo,$dl-$wtoo_l,$dh-$hd,$itxt);
      }
    else
      {
      # cylinder or cube
      $ct = $b->{ceilingthick}; $ct = $clt if (!defined $ct);
      $ft = $b->{floorthick}; $ft = $flt if (!defined $ft);
      $wth = $ct+$ft; 
      $wb = Cowgen::Bunch->create(type2Name($type)."##num##");
      $wb->setFaces($faces);
      $wb->addBrush (solid(), $type, $cx,$cy,$cz,$dw,$dl,$dh,$txt);
      $wb->addBrush (air()+mnoroom(), $type, $cx,$cy,$cz-$ct/2+$ft/2,$dw-$wto,$dl-$wto,$dh-$wth/2,$itxt);
      }
    $b->merge ( $wb->rotate ($rx,$ry,$rz,$x,$y,$z) );
    }
  # now sort all air brushes to the time end
  # to end needs brush time, not ref to it, so we must use a wrapper sub
  # which we define the for shortness sake inline
  $b->iterate ( over => "blist", match => { type => air(), }, 
    call => sub { my ($b,$e) = @_; $b->toEnd($e->{time}); }, 
    );
  # put protected brush to air
  $b->brushType($first, air()+mroom()) if (defined $first);
  #$b->applyTextures($p);
  $b->rotateByFacing($facing);
  #floodBrush($x,$y,$z,$w,$l,$h,$p->{flood},$b,$txt,$ft);
  return $b;
  }

sub hollowWedge
  {
  # take a solid wedge and "hollow" it out by using another wedge and
  # maybe a block. The outer void is assumed to be solid, if
  # outside is set it is assumed to be air and a solid wedge will 
  # explicitely shape it. 
  # named parameters: wallthick, wallthickinner (defaults to wallthick),
  # outside (on/off), skytexture
  my ($x,$y,$z,$w,$l,$h,$p) = @_;
  my $facing = $p->{facing} || aSouth();
  
  $b = Cowgen::Bunch->create($p->{name} || "hollowwedge##num##");
  
  my $wto = $p->{wallthick} || 0.25; # never 0!
  my $wti = $p->{innerwallthick}; $wti = $wto if (!defined $wti);
  my $ft = $p->{floorthick}; $ft = $wto if (!defined $ft);
  my $ct = $p->{ceilingthick}; $ct = $wto if (!defined $ct);
  my $g = $p->{gridsize} || 0.25;
  my $txt = $p->{texture} || -1;
  my $sky = $p->{skytexture} || $txt;
  my $itxt = $p->{innertexture} || $txt;
  my $rtxt = $p->{rooftexture} || $txt;
  my $ftxt = $p->{floortexture} || $txt;
  my $ctxt = $p->{ceilingtexture} || $txt;
  my $br;
  if ($p->{outside})
    {
    $br = $b->addBrush (solid(),wedge(), $x,$y,$z,$w,$l,$h,$txt);
    $b->setTexture ($br,side1(),$rtxt) if ($rtxt != $txt);
    }
  my @p = hollowTriangle($y,$z,$w,$h,$wto,$wti,$ft,$ct,$g);
  # now add wedge and block
  $br = $b->addBrush (air()+mroom(),wedge(), $x,$p[0],$p[1],$p[2],$l-$wto*2,$p[3],$itxt);
  if ($p[6] != 0)
    {
    $br = $b->addBrush (air()+mroom(),cube(), $x,$p[4],$p[5],$p[6],$l-$wto*2,$p[7],$itxt);
    $b->setTexture ($br,bottom(),$ftxt) if ($ftxt != $txt);
    $b->setTexture ($br,top(),$ctxt) if ($ctxt != $txt);
    }
  #$b->applyTextures($p);
  return $b;
  }

sub hollowTriangle
  {
  # return center (x,y), dimensions (w,l) of an "inner" triangle, 
  # as well as center (x,y) and (w,l) of an inner block
  # defined by a outer/inner wall and floor/ceil thickness and outer 
  # triangle. Ceiling thickness will be adjusted so that outer "wall" 
  # will run paralell. if inner wallthick == 0, the width of resulting
  # innerblock will be 0. If you want sharp edge at top, set ceilthick 
  # = 0;
  # parameters: $x (center), $y, a (width), b (height), wto 
  # (wallthick outer), wti (wallthick inner side),
  # ft (floorthick), ct (ceilthick), g (grid)
  my ($x,$y,$a,$b,$wto,$wti,$ft,$ct,$g) = @_;

  return if (($a == 0) || ($b == 0));
  my $ab = $a/$b; my $ba = $b/$a; my $a2 = $a/2; my $b2 = $b/2; # speed up

  my $fw = $ft*$ab; 
  my $who = $wto*$ba;
  my $whi = $wti*$ba;
  my $cw = $ct*$ab;

  my $th = snap2Grid($g,$b-$ct-$who-$whi-$ft);
  my $tl = snap2Grid($g,$a-$wto-$wti-$cw-$fw);
  my $ty = $y-$b2+$ft+$th/2;
  my $tx = $x-$a2+$wti+$cw+$tl/2;
  my $bx = $x-$a2+$wti+$cw/2;
  my $by = $y-$b2+$ft+$th/2;
  #print "\$fw: $fw \$who: $who \$whi: $whi \$cw:$cw\n";
  #print "\$th: $th \$tl: $tl\n";
  #print "\$x:$x \$a2: $a2\n";
 
  return ($tx,$ty,$tl,$th,$bx,$by,$cw,$th);
  }

1;

