#!/usr/bin/perl -w

# This contains some cell templates to generate quickly houses, as well as some
# room generators that create some typical rooms

# usage: see vroom.pl

# ANNOTATIONS: see doc/notes.txt

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

# 1999-11-20 v0.0.1 - from scratch
# 1999-11-21 v0.0.2 - added: carpetedRoom atticRoom hallwayRoom smallHouseattic
# 1999-11-27 v0.0.3 - added: noWall for house(), windows, lights
# 1999-12-01 v0.0.4 - added: atThing/atWall/atCell etc, thing
#                     moved: thing, door etc to VRoom.pm
# 1999-12-26 v0.0.5 - added: verySmallHouse
#                     fixed: rewrote everything to only generate hashes, not 
#                            Bunches
# 2000-01-05 v0.0.6 - added: splitCube, splitCross

# Although it seemed cool at first to have different room generators for 
# different types of rooms, it is really shorter to code basicroom, 
# atticroom and tunnelroom and then add the different stuff like carpets, 
# kitchentable etc as "things".

package Cowgen::VWorld::House;
require Exporter;
@ISA     = qw(Exporter);
@EXPORT  = qw(
             smallHouseStorey smallHouseCellar smallHouseAttic
             smallHouse verySmallHouse
             addCarpet
             kitchenRoom sittingRoom hallwayRoom 
             splitCube splitCross
             );

#@EXPORT_OK = qw();

use Cowgen::Bunch;
use Cowgen::VWorld::Room;
use Cowgen::Dromed;
use Cowgen::Architecture::Basics;
use Cowgen::Architecture::Inside;
use strict 'vars';

my $version = "0.0.6";
my $count = "000";

sub smallHouse
  {
  # create a small house with s storeys and attic
  # parameters: name, storeycount, cellarstoreys, room, door, window
  my $name = shift || "smallHouse##num##";
  $name =~ s/##num##/ $count++; /eg;
  my $storeys = shift || 1; $storeys = abs($storeys);
  my $cellars = shift || 0;
  my $r = shift || {}; my $door = shift || {}; my $window = shift || {};
  my $house = cell( { name => $name, div => inZ(), size => 1 } ); 
  my ($i,$storey);
  for ( $i = 0; $i < $cellars; $i++)
    {
    $storey  = smallHouseCellar("cellar##num##",$door,$window); $storey->{size} = 0.8;
    pushCell ($house, $storey);
    }
  # for first storey put front and back door 
  $storey  = smallHouseStorey("storey##num##",$door,$window); $storey->{size} = 1;
  my $hallway = cellByName($storey,"hallway");
  push (@{$hallway->{things}}, 
    ( openDoor (aSouth(), $door), fakeDoor (aNorth(), $door)) );
  pushCell ($house, $storey);
  for ( $i = 1; $i < $storeys; $i++)
    {
    $storey  = smallHouseStorey("storey##num##",$door,$window); $storey->{size} = 1;
    pushCell ($house, $storey);
    }
  $storey  = smallHouseAttic("attic##num##",$door,$window); $storey->{size} = 1.2;
  pushCell ($house, $storey);
  $house->{room} = $r; 
  return $house; # yep, its that easy!
  }

sub smallHouseStorey
  {
  # create a small house storey description based on cells
  # the door, window hash are used as templates for the actual windows/doors
  # parameters: name, doorhash, windowhash
  my $name = shift || "storey##num##";
  my $door = shift || openDoor();
  my $window = shift || openWindow();
  $name =~ s/##num##/ $count++; /eg;
  my $left = cell( 
     { name => "leftside", div => inX(), size => 0.4,
     cells =>
     [ cell ( { name => "sleeps", div => none(), size => 0.4, 
                things => [ openDoor (aSouth(), $door), 
                omniLight(0,0,0, { light => 32, } ) ],
              } ),
       cell ( { name => "sitting", div => none(), size => 0.6, 
                things => [ litWindow(aSouth(),$window), openDoor (aEast(), $door),
                omniLight(0,0,0, { light => 32, } ) ]
              } ),
     ]
   } ); 

  my $right = cell( 
     { name => "rightside", div => inX(), size => 0.4, min => 12, max => 16,
     cells =>
     [ cell ( { name => "stairs", div => none(), size => 0.4, min => 12, max => 16,
                nowall => aBottom()+aTop(),
                things => [ openDoor (aWest(), $door) ],
            } ),
       cell ( { name => "kitchen", div => none(), size => 0.6, 
                things => [ openDoor (aWest(), $door), litWindow (aSouth(), $window), ],
              } ),
     ]
   } ); 

  my $storey = cell( 
     { name => $name, div => inY(), size => 1, 
     cells =>
     [ $left, 
       cell ( { name => "hallway", div => none(), size => 0.2, min => 6, max => 10,
              things => [ omniLight(0,0,0,32), ],
              gen => \&basicRoom, } ),
       $right,
     ]
   } ); 
  return $storey; # house
  }

sub smallHouseAttic
  {
  # create a small house attic description based on cells
  # parameters: name
  my $name = shift || "attic##num##";
  $name =~ s/##num##/ $count++; /eg;
  my $door = shift || openDoor();
  my $window = shift || openWindow();
  my $attic = cell( 
     { name => $name, div => none(), size => 1, gen => \&atticRoom, } ); 
  return $attic; # attic
  }

sub smallHouseCellar
  {
  # create a small house cellar description based on cells
  # parameters: name
  my $name = shift || "cellar##num##";
  $name =~ s/##num##/ $count++; /eg;
  my $door = shift || openDoor();
  my $window = shift || openWindow();
  my $room = { bandheight => 0, }; # only overwrite bandheight
  my $storage = cell ( { name => "storage##num##", div => none(), size => 1, 
                things => [ openDoor (aNorth(), $door), ],
            } );
  my $left = cell( 
     { name => "leftside", div => inX(), size => 0.4,
     cells =>
     [ cell ( { name => "room", div => none(), size => 0.2, min => 8, max => 14,
                things => [ openDoor (aEast(), $door), ],
              } ),
       cell ( { name => "room", div => inY(), size => 0.8, 
                cells => [ $storage, $storage, $storage ],
            } ),
     ]
   } ); 

  my $right = cell( 
     { name => "rightside", div => inX(), size => 0.4, min => 12, max =>16,
     cells =>
     [ cell ( { name => "stairs", div => none(), size => 0.4, min => 12, max => 16,
                nowall => aBottom()+aTop(),
                things => [ openDoor (aWest(), $door), ] } ),
       cell ( { name => "room", div => none(), size => 0.6,
            } ),
     ]
   } ); 

  my $cellar = cell( 
     { name => $name, div => inY(), size => 1, room => $room,
     cells =>
     [ $left, 
       cell ( { name => "way", div => none(), size => 0.2, min => 6, max => 10,
                things => [ omniLight(0,0,0,32), ],
             } ),
       $right,
     ]
   } ); 
  return $cellar; # cellar
  }

sub verySmallHouse
  {
  # create a very small, single room, creaky wood house with attic
  # you need to give some description hashes of the things to place,
  # the rest goes automatic. Parameters without {} are possible.
  # namedparameters: name, seed (ommit for truly random), door, 
  # window, table, fireplace, roomheight, atticheight (defaults to roomheight)
  # nospace (which sides should not be present; aSouth()+aNorth() etc), space
  # (size of spacce surrounding house), width, length
  my $name = shift || "verySmallHouse##num##";
  $name =~ s/##num##/ $count++; /eg;
  my $p = $_[0];
  if (!defined $p)
    {
    print "VHouse.pm: Error: Need description hash for verySmallHouse\n"; return;
    }
  $p = { @_ } if (ref($p) ne 'HASH');
  my $rh = $p->{roomheight} || 1; my $ah = $p->{atticheight} || $rh;
  my $r = $p->{room};
  my $door = $p->{door} || openDoor();
  my $window = $p->{window} || openWindow();
  my $fire = $p->{fire} || fireplace();
  my $table = $p->{table} || table();
  my $attic = cell( { name => "$p->{name_attic}", size => $ah, gen => \&atticRoom } ); 
  my $room = cell( { name => "$p->{name_room}", size => $rh, gen => \&basicRoom } ); 
  # now place some things inside room
  
  my $verysmallhouse = cell( { name => $name, div => inZ(), size => 1, room => $r,
    cells => [ $attic, $room ] } ); 
#  $outer = splitCube( width => );
  # named parameters: width, length, size (size of the enclosing cell),
  # sizenorth, sizesouth, sizewest, sizeeast, room (room description hash),
  # gridsize, outerroom (room hash for outer cells; defaults to room)
  return $verysmallhouse; # yep, its that easy!
  }

sub kitchenRoom
  {
  # create a typical kitchen desciption hash (generates just empty room now)
  # parameters: room description hash
  my $room = shift;
  my $kitchen = cell( { name => "kitchen##num##", gen => \&basicRoom } ); 
  $kitchen->{room} = $room if (defined $room);
  return $kitchen;
  }

sub addCarpet
  {
  # add a carpet to a cell
  # parameters: cell, hash
  # named parameters: texture, x,y (carpet rel pos), 
  # width (rel (<0 >=1 ) or absolut), length (rel (<0 >=1 ) or absolut),
  # sx,sy (space from wall (only for relative size), 
  my $cell = shift || return;
  my $p = shift || {};
  return if (!defined $cell);
  $cell->{things} = [] if (!defined $cell->{things});
  # sz = -0.25 will effectively embedd the carpet into the floor (hehe :-)
  my $w = $p->{width} || 1; my $l = $p->{length} || 1;
  my $f = $p->{facing} || aSouth();
  my $carpet =  { 
    texture => $p->{texture}, ax => atThing(), ay => atThing(), az => atWall(), 
    height => 0.5, width => $w, length => $l,
    sx => $p->{sx} || 0, sy => $p->{sy} || 0, sz => -0.25, gen => \&carpet,
    };
  push (@{$cell->{things}}, thing( $p->{x} || 0, $p->{y} || 0, -0.5, $f, $carpet) );
  return $cell;
  }

sub sittingRoom
  {
  # create a typical sitting room with table and carpet
  # (generates just empty room now)
  # parameters: roomdescriptionhash, carpetdescriptionhash
  my $room = shift;
  my $carpet = shift;
  my $sitting = cell( { name => "sitting##num##", gen => \&basicRoom } ); 
  $sitting->{room} = $room if (defined $room);
  addCarpet ($sitting, $carpet);
  return $sitting;
  }

sub hallwayRoom
  {
  # create a typical hallway with some interesting carpets
  # (generates just empty room now)
  # parameters: roomdescriptionhash, carpetdescriptionhash
  my $room = shift;
  my $carpet = shift;
  my $hallway = cell( { name => "hallway##num##", gen => \&basicRoom } ); 
  $hallway->{room} = $room if (defined $room);
#  addCarpet ($hallway, $carpet);
  return $hallway;
  }

sub splitCube
  {
  # split a cell into a inner rectangle and outer perimeter cells. size of
  # outer cells is given as sizenorth, sizesouth, etc. If asize is omitted
  # or 0, it will be left of. Size from 0 .. -1.0 is relative size of 
  # entire cell. Width and Length are needed to calculate size of inner cell 
  # and absolute perimeter size from relative sizes. cell "outer" contains 
  # "middle", "upper" and "lower", aso "northwest", "north", "northeast", 
  # "east" etc are cells of the perimeter and "center" as the inner cell
  # named parameters: width, length, size (size of the enclosing cell),
  # sizenorth, sizesouth, sizewest, sizeeast, room (room description hash),
  # gridsize, outerroom (room hash for outer cells; defaults to room)
  my $p = $_[0];
  if (!defined $p)
    {
    print "VHouse.pm: Error: Need description hash for splitCube\n"; return;
    }
  $p = { @_ } if (ref($p) ne 'HASH');
  my $w = $p->{width} || 16;
  my $l = $p->{length} || 16;
  my $h = $p->{height} || 16;
  my $cs = $p->{size} || 16;
  my $r = $p->{room};
  my $crn = $p->{outerroom} || $r;
  my $ns = rel2abs($p->{sizenorth},$l); 
  my $ss = rel2abs($p->{sizesouth},$l);
  my $es = rel2abs($p->{sizeeast},$w);
  my $ws = rel2abs($p->{sizewest},$w);
  my $iw = $w-$es-$ws;
  if ($iw <= 0)
    {
    print "VHouse::splitCube: Error: Inner size in X is < 0.\n"; return;
    }
  my $il = $l-$ss-$ns;
  if ($il <= 0)
    {
    print "VHouse::splitCube: Error: Inner size in Y is < 0.\n"; return;
    }
  my $outer = cell ( { div => inX(), size => $cs, } );
  $outer->{room} = $crn if (defined $crn);
  if ($ns > 0)
    {
    my $upper = cell ( { div => inY(), name => "upper", size => $ns, } );
    pushCell ($upper, cell ( { name => "northwest", size => $ws, } ) )
     if ($ws > 0);
    pushCell ($upper, cell ( { name => "north", size => $iw, } ));
    pushCell ($upper, cell ( { name => "northeast", size => $ws, } ) )
     if ($es > 0);
    pushCell ($outer,$upper);
    }
  my $middle = cell ( { div => inY(), size => $il, name => "middle", } );
  pushCell ($middle, cell ( { name => "west", size => $ws, } )) if ($ws > 0);
  my $center = cell ( { name => "center", size => $iw });
  $center->{room} = $crn if (defined $crn);
  pushCell ($middle, $center);
  pushCell ($middle, cell ( { name => "east", size => $es, } )) if ($es > 0);
  pushCell ($outer,$middle);
  if ($ss > 0)
    {
    my $lower = cell ( { div => inY(), name => "lower", size => $ss, } );
    pushCell ($lower, cell ( { name => "southwest", size => $ws, } ) ) 
     if ($ws > 0);
    pushCell ($lower, cell ( { name => "south", size => $iw, } ) );
    pushCell ($lower, cell ( { name => "southeast", size => $ws, } ) )
     if ($es > 0);
    pushCell ($outer,$lower);
    }
  $outer; # cell complex
  }

sub splitCross
  {
  # split a cell into a inner cross and edge cells. size of left upper corner
  # is given as cornerwidth and cornerlength, and crosswidth, crosslength 
  # define the
  # cross, other corners are calculated from the overall size.
  # all sizes can be relative to overall width/length. If you want a 
  # symmetrical cross, try length/width = 3, crosswidth/crosslength = 1, and
  # cornerwidth/cornerlength = 1. If some sizes are 0, cross will degrade 
  # to some sort of halfcross.
  # cell "outer" contains "middle", "upper" and "lower", "upper and "lower" 
  # then contain "northeast", "north", "northwest" and 
  # "southeast", "south", "southwest" respectively. "middle" contains
  # "west", "center", and "east" if you set splitinner to on().
  # named parameters: width (absolute), length (absolute), 
  # crosswidth (rel or absolute), crosslength (rel or absolute), cornerwidth
  # (rel or absolute), cornerlength (rel or absolute),
  # room (room description hash for cross cells), 
  # outerroom (room hash for outer corners; defaults to room), gridsize, 
  # splitinner (on/off)
  my $p = $_[0];
  if (!defined $p)
    {
    print "VHouse.pm: Error: Need description hash for splitCross\n"; return;
    }
  $p = { @_ } if (ref($p) ne 'HASH');
  my $w = $p->{width} || 16;
  my $l = $p->{length} || 16;
  my $h = $p->{height} || 16;
  my $r = $p->{room};
  my $crn = $p->{outerroom} || $r;
  # left/upper size
  my $cw = rel2abs($p->{cornerwidth},$w); 
  my $cl = rel2abs($p->{cornerlength},$l);
  # inner size
  my $crw = rel2abs($p->{crosswidth},$w);
  my $crl = rel2abs($p->{crosslength},$l);
  # remaining sizes
  my $rw = $w-$cw-$crw; my $rl = $l-$cl-$crl;
  my $outer = cell ( { div => inX(), size => $l, } );
  $outer->{room} = $r if (defined $r);
  # if we have upper part
  if ($cl > 0)
    {
    my $upper = cell ( { div => inY(), name => "upper", size => $w, } );
    pushCell ($upper, cell ( { name => "northwest", size => $cw, room => $crn 
     } ) ) if ($cw > 0);
    pushCell ($upper, cell ( { name => "north", size => $crw, } ) ) 
     if ($crw > 0);
    pushCell ($upper, cell ( { name => "northeast", size => $rw, room => $crn 
     } ) ) if ($rw > 0);
    pushCell ($outer,$upper);
    }
  # if we have middle part
  if ($crl > 0)
    {
    my $middle = cell ( { div => inY(), size => $crl, name => "middle", } );
    pushCell ($middle, cell ( { name => "west", size => $cw, room => $crn 
     } ) ) if ($cw > 0);
    pushCell ($middle, cell ( { name => "center", size => $crw, } ) ) 
     if ($crw > 0);
    pushCell ($middle, cell ( { name => "east", size => $rw, room => $crn 
     } ) ) if ($rw > 0);
    pushCell ($outer,$middle);
    }
  # if we have lower part
  if ($rl > 0)
    {
    my $lower = cell ( { div => inY(), name => "lower", size => $rl, } );
    pushCell ($lower, cell ( { name => "southwest", size => $cw, room => $crn 
     } ) ) if ($cw > 0);
    pushCell ($lower, cell ( { name => "south", size => $crw, } ) )
     if ($crw > 0);
    pushCell ($lower, cell ( { name => "southeast", size => $rw, room => $crn 
     } ) ) if ($rw > 0);
    pushCell ($outer,$lower);
    }
  $outer; # cell complex
  }
  
1;
