#!/usr/bin/perl -w

# This contains the interface from CowEd to VWorld.

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

# 2000-01-14 v0.0.1 - from scratch
# 2000-01-16 v0.0.2 - fixed some more bugs, added xxxProject
# 2000-01-17 v0.0.3 - added byId
# 2000-01-18 v0.0.4 - completely rewritten
# 2000-01-19 v0.0.5 - renamed to Project, fixed new Cowgen::Project
#                     added: getProperty, setProperty, getProperties, 
#                            getRoomProperties
# 2000-01-20 v0.0.6 - added: unSel, getSize getName, 
#                     fixed: checks for nothing selected, how to splitCell
#                            splitCell names/sizes can contain spaces
# 2000-01-21 v0.0.7 - added: setWorldSize, getWorldSize
#                            getParameter setParameter
#                            setRoomProperties setRoomProperty
#                            done_draw should_redraw redraw
#                            time_spent 
#                     fixed: flag redraw/dirty when something is modified
#                            rem unSel
# 2000-01-24 v0.0.8 - fixed: type in setSelected, getCoords returns hashes
#                            should_redraw => needsRedraw
#                            parent/level
# 2000-01-26 v0.0.9 - fixed: bux in selXXX and getCoords
#                   - added: thinglist
# 2000-02-20 v0.1.0 - fixed: addCells moved part. to Room.pm

package Cowed::Project;
require Exporter;
@ISA     = qw(Exporter);
@EXPORT_OK  = qw( 
             delCell splitCell clearCell addCells 
             addThing delThing 
             getCoords
             generateMission loadProject saveProject new 
             getProperties getRoomProperties setRoomProperties
             getProperty setProperty setRoomProperty
             selPrev selNext selParentCell selFirstChild
             isClean getMother getType
             clearCells clearThings
             getSelected setSelected 
             getName getSize
             setWorldSite getWorldSize
             searchByName
             done_draw NeedsRedraw redraw new 
             );
@EXPORT = qw();

use Cowgen::VWorld::Room;
use Cowgen::VWorld::Room qw(cellsToBunch);
use Cowgen::Bunch;
use Cowgen::Dromed;
use Cowed::Things;
use Cowgen::Text;
use strict 'vars';

my $VERSION = "0.1.0";

##############################################################################
# cells
##############################################################################

sub delCell     
  {
  # delete the currently selected cell and all its subcells
  # return id of newly selected cell
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  return -1 if ($s->{sel}->{type} != aCell()); # thing, not cell
  if (!defined $s->{parent})
    {
    # you cant delete mother cell
    return -2;
    }
  else
    {
    splice (@{$s->{parent}->{cells}},$s->{index},1);
    }
  # now select its next noughbour as the newly selected cell
  my $count = scalar @{$s->{parents}->{cells}};
  if ($count == 0)
    {
    $s->setSelected ($s->{parent}->{id}); # has no childs
    }
  else
    {
    $s->{index} -- if ($s->{index} >= $count);
    # next cell or prev
    $s->setSelected ($s->{parent}->{cells}->[$s->{index}]->{id}); 
    }
  $s->redraw();
  }

sub splitCell
  {
  # split a cell into $count subcells, each $size big and with name $name
  # parameters: how (inY(); inX(); inZ()), count, sizestring, namestring
  my $s = shift;
  return -100 if (!defined $s->{sel}); # nothing selected?
  return -1 if (@{$s->{sel}->{cells}} > 0); # already split
  my $how = shift;
  $s->{sel}->{div} = $how;
  $s->addCells( @_ );
  $s->redraw();
  } 

sub addCells
  {
  # add cell(s) to current selected
  # parameters: count, sizestring, namestring
  my $s = shift;
  return -100 if (!defined $s->{sel}); # nothing selected?
  Cowgen::VWorld::Room::addCells ($s->{sel}, @_);
  $s->redraw();
  } 

##############################################################################
# things
##############################################################################

sub addThing
  {
  # Add a thing to cell.
  # parameters: thing hash
  my $s = shift; 
  return if (!defined $s->{sel}); # nothing selected?
  push (@{$s->{sel}->{things}}, shift || {} );
  $s->redraw();
  }

sub delThing
  {
  # delete currently selected thing from cell 
  # parameters: none
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  return -1 if ($s->{sel}->{type} != aThing()); # uops, no thing
  return -2 if (!defined $s->{parent}); # oups, shouldnt happen
  splice (@{$s->{parent}->{things}},$s->{index},1);
  # select next thing 
  my $count = scalar @{$s->{sel}->{things}};
  if ($count == 0)
    {
    $s->setSelected ($s->{parent}->{id}); # has no more things
    }
  else
    {
    $s->{index} -- if ($s->{index} >= $count);
    # next thing or prev
    $s->setSelected ($s->{parent}->{cells}->[$s->{index}]->{id}); 
    }
  $s->redraw();
  } 

##############################################################################
# clear/delete
##############################################################################

sub clearCells
  {
  # remove all subcells from selected cell
  # does nothing if thing is selected
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  return -1 if ($s->{sel}->{type} != aCell()); 
  undef $s->{sel}->{cells}; # needed?
  $s->{sel}->{cells} = [];
  $s->redraw();
  }

sub clearThings
  {
  # remove all things from selected cell 
  # does nothing if thing is selected
  # parameters: none
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  return -1 if ($s->{sel}->{type} != aCell()); 
  undef $s->{sel}->{things}; # needed?
  $s->{sel}->{things} = [];
  $s->redraw();
  }

##############################################################################
# thing templates
##############################################################################

sub getTemplates
  {
  # return list of templates
  # as $returned->{id}->{descripton} = "blah"
  my $s = shift;
  return $s->{templates}->getThingList();
  }

sub loadTemplates
  {
  # load list of templates from dirs
  my $s = shift;
  $s->{templates}->loadThings(@_);
  }

sub getTemplate
  {
  # return a templates hash based on id
  my $s = shift;
  $s->{templates}->getThing(shift);
  }

##############################################################################
# selection
##############################################################################

sub getSelected
  {
  # return ID of selected cell/thing
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  $s->{sel}->{id};
  }

sub selMother
  {
  # set selected to mother
  my $s = shift;
  $s->{sel} = $s->{mother}; undef $s->{parent}; $s->{index} = 0; 
  $s->{sel}->{id};
  }

sub setSelected
  {
  # update internal state to newly selected cell
  # needed if user clicks a cell as well as by some internal functions
  # parameters: cellid/thingid of newly selected.
  # returns: 0 for success, != 0 for error
  my $s = shift; 
  my $id = shift;
  if (!defined $id)
    {
    undef $s->{sel}; 
    }
  else  
    {
    my @p = $s->byId( $id );
    return -1 if (!defined @p); # error
    ($s->{sel},$s->{parent},$s->{index}) = @p;
    }
  return $id; 
  }

sub searchByName
  {
  # return a list of IDs of cells/things with that name
  # currently it returns only first cell with that name, later it should
  # give a list to be displayed for user selection
  # case sensitive, nonsubstrings, "contained in" and search only cell/thing 
  # are not implemented yet
  # parameters: "name"
  my $s = shift;
  my $c = cellbyName ($s->{mother}, shift || "unnamed");
  return ( $c->{name} ) if (defined $c);
  }

sub selNext
  {
  # select next cell/thing
  # parameters: none
  my $s = shift;
  my $id = $s->{sel}->{id};
  return $id if (!defined $s->{sel}); # nothing selected?
  my $count;
  if ($s->{sel}->{type} == aCell())
    {
    return $id if ($s->{sel} == $s->{mother}); # we are mother?
    return $id if (!defined $s->{parent}); # we are mother?
    $count = scalar @{$s->{parent}->{cells}};
    return $id if ($count == 0); # shouldnt happen
    $s->{index}++; $s->{index} = 0 if ($s->{index} >= $count);
    $s->{sel} = $s->{parent}->{cells}->[$s->{index}];
    }
  else
    { 
    # things
    $count = scalar @{$s->{sel}->{things}};
    return if ($count == 0); # shouldnt happen
    $s->{index}++; $s->{index} = 0 if ($s->{index} >= $count);
    $s->{sel} = $s->{sel}->{things}->[$s->{index}];
    }
  #print "sel: $s->{sel}->{id}\n";
  return $s->{sel}->{id};
  }

sub selPrev
  {
  # select prev cell/thing
  # parameters: none
  my $s = shift;
  my $id = $s->{sel}->{id};
  return $id if (!defined $s->{sel}); # nothing selected?
  if ($s->{sel}->{type} == aCell())
    {
    return $id if ($s->{sel} == $s->{mother}); # we are mother?
    return $id if (!defined $s->{parent}); # we are mother?
    my $count = scalar @{$s->{parent}->{cells}};
    return $id if ($count == 0); # shouldnt happen
    $s->{index}--; $s->{index} = $count-1 if ($s->{index} < 0);
    $s->{sel} = $s->{parent}->{cells}->[$s->{index}];
    }
  else
    { 
    # things
    my $count = scalar @{$s->{sel}->{things}};
    return $id if ($count == 0); # shouldnt happen
    $s->{index}++; $s->{index} = 0 if ($s->{index} <0);
    $s->{sel} = $s->{sel}->{things}->[$s->{index}];
    }
  return $s->{sel}->{id};
  }

sub selParentCell
  {
  # select parent cell if not mother
  # parameters: none
  my $s = shift;
  my $id = $s->{sel}->{id};
  if (!defined $s->{sel}) # nothing selected?
    {
    $s->{sel} = $s->{mother}; undef $s->{parent}; $s->{index} = 0;
    return $s->{sel}->{id}; 
    }
  return $id if ($s->{sel} == $s->{mother}); # we are mother?
  return $id if (!defined $s->{parent}); # we are mother?
  $s->setSelected ($s->{parent}->{id}); 
  return $s->{sel}->{id};
  }

sub selFirstChild
  {
  # select first child cell
  # parameters: none
  my $s = shift;
  my $id = $s->{sel}->{id};
  return $id if (!defined $s->{sel}); # nothing selected?
  return $id if ($s->{sel}->{type} != aCell());
  return $id if (@{$s->{sel}->{cells}} == 0); # no childs
  $s->{parent} = $s->{sel};
  $s->{sel} = $s->{sel}->{cells}->[0]; $s->{index} = 0;
  return $s->{sel}->{id};
  }

##############################################################################
# draw
##############################################################################

sub getCoords
  {
  # return a hash of {id} = { x => $x, y => $y, etc}
  # type: 1 (cell), 2 (thing), 4 (tp)
  # parameters: none
  my $s = shift || return;
  my $r = {}; my $t = [];
#  $s->{mother}->{debug} = 1;
  cellsToBunch( @{$s->{worldsize}},$t,$t,$r,$s->{mother});  
  #cellsToBunch( 0,0,0, 1000,1000,1000,$t,$t,$r,$s->{mother});  
  return $r;
  }

sub getWorldSize
  {
  # return ref to ( $x,$y,$z, $w,$l,$h) ( center/size of world (mother cell))
  # parameters: none
  my $s = shift || return;
  return @{$s->{worldsize}};
  }

sub setWorldSize
  {
  # set worldsize as ( $x,$y,$z, $w,$l,$h) ( center/size of world/mother cell))
  # parameters: $x,$y,$z,$w,$l,$h
  my $s = shift || return;
  my $x = shift || 0; my $y = shift || 0; my $z = shift || 0;
  my $w = abs(shift || 32); my $l = abs(shift || 32); my $h = abs(shift || 32);
  $s->{worldsize} = [ $x,$y,$z,$w,$l,$h ];
  $s->redraw();
  }

##############################################################################
# projects
##############################################################################

sub generateMission
  {
  # generate bunch from project data and store as mis file
  # parameters: templatemission, gamefile, outputfile
  my $s = shift;
  my ($template,$gamfile,$output) = @_;
  my ($x,$y,$z,$w,$l,$h) = @{$s->{worldsize}};
  $template = "houses.mis" if (!defined $template);
  $gamfile = "Dark.gam" if (!defined $gamfile);  
  $output = "data/unnamed.mis" if (!defined $output);  
  my $vbr = Cowgen::Vbr->create($template);
  my $gf = Cowgen::Gamfile->create($gamfile);
  my $bunch = worldAsBunch( $x,$y,$z,$w,$l,$h,$s->{mother});
  $bunch->debug();
  optimizeSky($bunch);
  $bunch->autoRoom(); $bunch->autoFlow();
  $bunch->stuff2vbr($vbr,$gf);
  $vbr->writeFile($output);
  }

sub generatePerl
  {
  # generate perl code from the project
  # parameters: templatemission, gamefile, outputfile
  my $s = shift;
  my ($template,$gamfile,$output) = @_;
  my ($x,$y,$z,$w,$l,$h) = @{$s->{worldsize}};
  return;
  }

sub loadProject
  {
  # create new Project from file
  # used as: $prj =  Cowed::Project::new(); $prj->loadProject("file");
  # parameters: projectfilename
  # not ready yet
  my $s = shift;
  
  $s->{time_start} = time;
  # $s->clean();
  }

sub newProject
  {
  return Cowed::Project->new(); 
  }
 
sub new
  {
  # create new Editor Project from scratch
  # parameters: project name
  my $c = shift; 
  my $s = {}; bless $s, $c; $s->init(@_);
  return $s;                            
  }

sub asText
  {
  # put meself as text
  my $s = shift;

  my $map = { things => "Thing", cells => "Cell", };
  my $dontput = { time_start => 1, sel => 1, index => 1, parent => 1, 
                  clean => 1, templates => 1, redraw => 1, id => 1,
                  type => 1,
                };
  return Cowgen::Text::asText ($s, "CowEd_Project", 1, $dontput, $map );
  }

sub saveProject
  {
  # save editor project to file
  my $s = shift;
  my $file = shift || "$s->{config}->{projectpath}$s->{config}->{name}".".prj";
  $s->{time_spent} = $s->{time_spent} + time - $s->{time_start}; 
  $s->{time_start} = time;
 
  open FILE, ">$file" or die "Cant write $file: $!\n";
  print FILE $s->asText();
  close FILE;
  $s->clean();
  }

sub getParameter
  {
  # get a parameter of the project by name
  # parameter: name
  my $s = shift;
  my $name = lc(shift) || "name";
  return $s->{config}->{$name};
  }

sub setParameter
  {
  # set a parameter of the project by name
  # parameter: name, value
  my $s = shift;
  my $name = lc(shift) || "name";
  my $val = shift || 0;
  $s->dirty();
  $s->{config}->{$name} = $val;
  }

##############################################################################
# get info
##############################################################################

sub getProperties
  {
  # this is used to return all the properties of selected thing/cell
  # parameters: none
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  my $p = {};
  foreach (keys %{$s->{sel}})
    {
    $p->{$_} = $s->{sel}->{$_} 
     if ((ref($_) ne "ARRAY") && (ref($_) ne "HASH"));
    }
  return $p;
  }

sub getProperty
  {
  # get a property of cell
  # parameters: propertyname
  my $s = shift; 
  return if (!defined $s->{sel}); # nothing selected?
  my $name = lc(shift) || 'size';
  return $s->{sel}->{$name}; 
  }

sub getSize
  {
  # get size of selected cell (nothing for things)
  # parameters: none
  my $s = shift; 
  return if (!defined $s->{sel}); # nothing selected?
  return $s->{sel}->{size} if ($s->{sel}->{type} == aCell());
  return;
  }

sub getName
  {
  # get name of selected
  # parameters: none
  my $s = shift; 
  return if (!defined $s->{sel}); # nothing selected?
  return $s->{sel}->{name}; 
  }

sub setSize
  {
  # Set a proportion of cell. Use getCoord to get new screen coords. 
  # parameters: newsize, newmin, newmax
  my $s = shift; 
  return -1 if (!defined $s->{sel}); # nothing selected?
  return -2 if ($s->{sel} != aCell()); # no cell?
  my $size = abs(shift || 1);
  my $min = shift; $min = abs($min) if (defined $min);
  my $max = shift; $max = abs($max) if (defined $max);
  $s->{sel}->{size} = $size;
  $s->{sel}->{min} = $min if (defined $min);
  $s->{sel}->{max} = $max if (defined $max);
  $s->redraw();
  }

sub setProperty
  {
  # set a property of cell. Inhibited for the following names:
  # room, things, cells, id, type, size, min, max div
  # to change size or div, use setSize() (and later: setDiv())
  # parameters: propertyname, new value
  my $s = shift; 
  return if (!defined $s->{sel}); # nothing selected?
  my $name = lc(shift) || 'size';
  my $value = shift || 0;
  return -1 
   if ($name =~ /^(room|things|cells|id|type|min|max|size|div|level|parent)$/);
  $s->{sel}->{$name} = $value;
  $s->redraw();
  }

sub getRoomProperties
  {
  # this is used to return all the room properties of a cell 
  # Since a cell "inherits" room properties from its parent, we really need this
  # not ready yet, does just return room from cell directly
  # parameters: none
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  my $p = {};
  foreach (keys %{$s->{sel}->{room}})
    {
    $p->{$_} = $s->{sel}->{room}->{$_};
    }
  return $p;
  }

sub setRoomProperties
  {
  print "Not implemented\n";
  }

sub setRoomProperty
  {
  print "Not implemented\n";
  }

sub getThings
  {
  # this is used to return all the things of a cell 
  # Since a cell can "inherit" things from its parent, we really need this
  # thing inheritance is not implemented yet, so we dont use that the way we 
  # should, instead return list of things directly
  # parameters: none
  my $s = shift;
  return if (!defined $s->{sel}); # nothing selected?
  return $s->{sel}->{things};
  }

sub isClean 
  { 
  # Return if projet is dirty/clean. A dirty project was not saved after a 
  # modification. newly loaded/created projects are "clean". 
  # Thats for asking user "want to save before quit?" etc.
  my $s = shift;
  $s->{clean};
  }

# do you need the following infos anyway?

sub getType
  {
  # return type of selected cell/thing
  my $s = shift;
  $s->{sel}->{type};
  }

sub getMother
  {
  # return ID of mother cell
  my $s = shift;
  $s->{mother}->{id};
  }

##############################################################################
# internal stuff
##############################################################################

# mother     # mother of all cells
# sel        # selected cell/thing
# parent     # parent of $cell
# index      # index of cell inside parent->{cells}
# clean      # projet modified since last sve/load/new?
# redraw     # should screen be redrawn?
# time_spent # time user spent in project
# debug      # some debug stuff

sub dumpSelected
  { 
  my $s = shift || return;
  print "Debug printing Project:\n";
  # for debug only
  if (!defined $s->{sel}) # nothing selected?
    {
    print "Nothing selected!\n"; return;
    }
  foreach (keys %$s)
    {
    print " $_ => $s->{$_}\n";
    }
  print " Selected:\n";
  foreach (keys %{$s->{sel}})
    {
    print "  $_ => $s->{sel}->{$_}\n";
    }
  print " All:\n";
  do_recurse ($s->{mother},\&printem,0); 
  }

sub printem
  {
  my ($c,$level) = @_;
  print " "," " x $level,"$c->{name}:\n";
  foreach (keys %{$c})
    {
    if ($_ ne "name")
      {
      print "  "," " x $level,"$_ => $c->{$_}";
      if (ref($c->{$_}) eq "ARRAY")
        {
        print " (size: ",scalar @{$c->{$_}},")";
        } 
      print "\n";
      }
    }
  }

sub do_recurse
  {
  # start cell, func to call
  my ($cell,$func,$level) = @_;
  my $c; $level++;
  &$func($cell,$level); 
  foreach $c (@{$cell->{cells}})
    {
    do_recurse ($c,$func,$level);
    }
  }

sub init
  {
  my $s = shift;
  my $name = shift || "Unnamed";
  $s->{mother} = cell ( name => $name, size => 1, room => {} );
  undef $s->{parent};
  $s->{sel} = $s->{mother};
  $s->{index} = 0;
  $s->{time_spent} = 0;
  $s->{time_start} = time;
  $s->clean();
  $s->setWorldSize ( 32,0,0, 32,32,32 );
  $s->done_draw();
  $s->{config} = {};
  $s->{config}->{name} = $name;
  $s->{config}->{base} = "data/houses.mis";
  $s->{config}->{gamfile} = "data/Dark.gam";
  $s->{config}->{outputpath} = "data";
  $s->{config}->{projectpath} = "data/projects";
  $s->{templates} = Cowed::Things->new ("data/things");
  }

sub DESTROY
  {
  print "Editor project destroyed.\n";
  }

sub clean
  {
  my $s = shift;
  $s->{clean} = 0;
  }

sub dirty
  {
  my $s = shift;
  $s->{clean} = 1;
  }

sub done_draw
  {
  # GUI can flag that it got coords and redraw is complete
  my $s = shift;
  $s->{redraw} = 0;
  }

sub redraw
  {
  # to flag that GUI has to reget the coords and do redraw
  my $s = shift;
  $s->{redraw} = 1; $s->dirty();
  }

sub needsRedraw
  {
  # return flag wether GUI has to reget the coords and do redraw
  my $s = shift;
  return $s->{redraw};
  }

sub byId
  {
  # return a cell/things ref from its id, and if not mother cell, its parent
  # and its index into {cells} or {things}
  # parameters: cell_or_thing_id
  my $s = shift;
  my $id = shift || return ();
  return ($s->{mother}) if ($s->{mother}->{id} == $id);
  return recurse ($s->{mother},$id);
  }

sub recurse
  {
  # return a cell/things ref from its id, and if not mother cell, its parent
  # and its index into {cells} or {things}
  # parameters: cell, cellid
  my ($cell,$id) = @_;
  # first look if one or our childs/things is it
  my ($c,@p); my $i = 0;
  foreach $c (@{$cell->{cells}})
    {
    return ($c,$cell,$i) if ($c->{id} == $id);
    $i++;
    }
  $i = 0;
  foreach $c (@{$cell->{things}})
    {
    return ($c,$cell,$i) if ($c->{id} == $id);
    $i++;
    }
  # no, go one level deeper
  foreach $c (@{$cell->{cells}})
    {
    @p = recurse ($c,$id);
    return @p if (defined $p[0]);
    }
  return ();
  }

1;

