#!/usr/bin/perl -w

# Contains routines to create startingpoint patrolroutes etc

# usage: 

# use Report;

# $report = Cowgen::Report::checkRooms($bunch);

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

# 2000-04-23 v0.0.1 - from Bunch.pm

package Cowgen::Report;
require Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw( );
@EXPORT_OK = qw( checkRooms checkObjects checkBrushes);

#doc:

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

sub checkRooms
  {
  my ($bunch,$fix,$grid,$e,$rep) = @_;
  $$rep .= "\nChecking rooms...\n";
  $$rep .= "Done.\n";
  }

sub checkObjects
  {
  my ($bunch,$fix,$grid,$e,$rep) = @_;
  $$rep .= "\nChecking for double objects...\n";
  my $list = $bunch->{olist}->{objects}; 
  my (%matches,$deleted,$o1,$o2);
  foreach my $o1k (keys %$list)
    { 
    $o1 = $list->{$o1k};
    next if (defined $o1->{deleted});
    foreach my $o2k (keys %$list) 
      {
      $o2 = $list->{$o2k};
      next if (defined $o2->{deleted});
      next if ($o1 == $o2); 
      next if ($o1->{base} != $o2->{base}); 
      if ((!exists $matches{$o1}) && (!exists $matches{$o2}))
        {
        if ((abs($o1->{x} - $o2->{x}) < $e) && (abs($o1->{y} - $o2->{y}) < $e) && 
         (abs($o1->{z} - $o2->{z}) < $e))
          { 
          $matches{$o1} = 1; $matches{$o2} = 1;
          $$rep .= " $o1->{id} ($o1->{base})  $o2->{id} ($o2->{base})\n";
          $deleted ++;
          $o1->{deleted} = 1 if ($fix != 0);
          # $o1->{x},$o1->{y},$o1->{z} $o2->{x},$o2->{y},$o2->{z}\n";
          }
        }
      }
    }
  $$rep .= " None.\n" if (keys %matches == 0);
  if (keys %matches > 0)  
    {
    $$rep .= scalar keys %matches;
    $$rep .= " problematic objects found";
    $$rep .= " and deleted $deleted of them." if ($fix != 0);
    $$rep .= ".\n"
    }
  $$rep .= "Done.\n";
  }

sub checkBrushes
  {
  my ($bunch,$fix,$grid,$e,$rep) = @_;
  # this takes O(n*n) while we could get away with O(n!) (brute) or
  # O(n*log n) (sort first then linear check). Recode if too slow.
  $$rep .= "\nChecking for brushes occuping the same space:\n";
  my (%matches,$deleted);
  my $brlist = $bunch->{blist}; 
  foreach my $b (@$brlist)
    {
    next if (defined $b->{deleted});
    foreach my $a (@$brlist)
      {
      next if (defined $a->{deleted});
      if (($b != $a) && (!exists $matches{$a}) && (!exists $matches{$b}))
        {
        if ( ($a->{x} == $b->{x}) && ($a->{y} == $b->{y}) && ($a->{z} == $b->{z}) &&
             ($a->{w} == $b->{w}) && ($a->{l} == $b->{l}) && ($a->{h} == $b->{h}) )
          {
          $matches{$b} = 1; $matches{$a} = 1; # remember both
          $$rep .= " $b->{time} $a->{time}\n";
          $deleted ++;
          $a->{deleted} = 1 if ($fix != 0);
          }
        }
      }
    }
  $$rep .= " None.\n" if (keys %matches == 0);
  if (keys %matches > 0)  
    {
    $$rep .= scalar keys %matches;
    $$rep .= " problematic brushes found";
    $$rep .= " and deleted $deleted of them" if ($fix != 0);
    $$rep .= ".\n";
    }
  }

sub genReport
  {
  # generate a report on problems, and correct things on the fly
  # parameters: e (difference for placement checks), gridsize, 
  # dofix (1 for fix; or 0)
  # not ready yet!
  my $self = shift;
  my $e = shift || 0.1;
  my $gridsize = shift || 0.25; 
  my $fix = shift || 0; # defaults to no fix
  my $ol = shift || {}; # defaults to none
  my $rep = "Report on Bunch ".$self->name();
  #$rep .= ".\nGenerated at ".scalar localtime()." by Bunch.pm $VERSION\n\n";
  #$rep .=  "$self->{name} contains:\n $self->{brushes} brushes,";
  #$rep .= " $self->{rooms} rooms,"; 
  #$rep .= " $self->{flows} flows,"; 
  #$rep .= " $self->{areas} areas,"; 
  #$rep .= " $self->{lights} lights"; 
  #$rep .= " and ".$self->numObjects()." objects in"; 
  #$rep .= " $self->{groups} groups.\n\n";

  # if we want to know the time values of rooms/flows/objects:
  # we had make a list out of the brush time values and sort it, then create lookup table
  # dromed assigns to some things the same time value, and later seems to "invent" the 
  # displayed time values on the fly. So we would have to mimik that behaviour to display
  # the correct time values, so that user could jump to the correct thing.

  #$rep .= " Notes: For objects the value listed is the object ID, it is displayed\n";
  #$rep .= "        by DromEd surrounded by () after the object name.\n";
  #$rep .= "        For brushes the time value is listed. This is displayed by DromEd\n";
  #$rep .= "        in the lower left corner right beside 'Time:'.\n";
  #$rep .= "        For faulty rooms all the non-existent base rooms are listed.\n";
  my ($b,$o,$o1,$o2,$list,$brlist,%matches,$matchcnt,$matches,$rlist,@deleted);

  $matchcnt = 0; my $defroom = 1; my $defname = "BaseRoom";
  foreach $o (keys %{$ol})
    {
#   print "at $o:\n";
    if ($ol->{$o}->{name} eq "Default Room")
      {
      $defroom = $o; $defname = "Default Room";
      }
#    foreach $k (keys %{$ol->{$o}})
#      {    
#     #print " $k => $ol->{$o}->{$k}\n";
#      if
#      } 
#    print "\n";
    }
  $rep .= "\nChecking for rooms based on unknown archetypes:\n";
  $list = $self->{rlist}; 
  foreach $b (@$list)
    {
    if (!defined $ol->{$b->{oid}})
      {
      $matches{$b->{oid}} = 1; $matchcnt ++; 
      $b->{oid} = $defroom if ($fix != 0);
      }
    }
  $rep .= " None.\n" if ($matchcnt == 0);
  if ($matchcnt > 0)  
    {
    foreach (sort keys %matches)
      {
      $rep .= " $_\n";
      }
    $rep .= $matchcnt;
    $rep .= " problematic rooms found. ";
    $rep .= "Set all of them to $defroom ($defname).\n" if ($fix != 0);
    }
  $rep .= "\nChecking for objects that live inside each other (not ready yet!):\n";

# $list = $self->{olist}; 
# foreach $o1 (@$list)
#   {
#   next if (defined $o1->{deleted});
#   next if ($o1->{time} == 0); # no sub objects ;)
#   foreach $o2 (@$list) 
#     {
#     next if (defined $o2->{deleted});
#     if (($o1 != $o2) && (!defined $matches{$o1}) && (!defined $matches{$o2}))
#       {
#       if ((abs($o1->{x} - $o2->{x}) < $e) || (abs($o1->{y} - $o2->{y}) < $e) || 
#        (abs($o1->{z} - $o2->{z}) < $e))
#         { 
#         $matches{$o1} = 1; $matches{$o2} = 1;
#         $rep .= " $o1->{oid} $o2->{oid}\n";
#         # $o1->{x},$o1->{y},$o1->{z} $o2->{x},$o2->{y},$o2->{z}\n";
#         }
#       }
#     }
#   }
# $rep .= " None.\n" if (keys %matches == 0);
# if (keys %matches > 0)  
#   {
#   $rep .= scalar keys %matches;
#   $rep .= " problematic objects found. None fixed.\n"
#   }

  $rep .= "\nChecking for brushes occuping the same space:\n";
  undef %matches;
  $brlist = $self->{blist}; 
  foreach $b (@$brlist)
    {
    next if (defined $b->{deleted});
    foreach $a (@$brlist)
      {
      next if (defined $a->{deleted});
      if (($b != $a))
        {
        if ( ($a->{x} == $b->{x}) && ($a->{y} == $b->{y}) && ($a->{z} == $b->{z}) &&
             ($a->{w} == $b->{w}) && ($a->{l} == $b->{l}) && ($a->{h} == $b->{h}) )
          {
          $matches{$b} = 1; $matches{$a} = 1; # remember both
          $rep .= " $b->{time} $a->{time}\n";
          push (@deleted, $a->{time});
          $a->{deleted} = 1 if ($fix != 0);
          }
        }
      }
    }
  $rep .= " None.\n" if (keys %matches == 0);
  if (keys %matches > 0)  
    {
    $rep .= scalar keys %matches;
    $rep .= " problematic brushes found";
    $rep .= " and deleted ". scalar @deleted ." of them." if ($fix != 0);
    $rep .= "\n";
    }

  $rep .= "\nChecking for air brushes not entirely covered in a room:\n";
  undef %matches;
  $brlist = $self->{blist}; 
  $rlist = $self->{rlist}; 
  my $covered; $matches = 0;
  my $r;
  foreach $b (@$brlist)
    {
    next if (defined $b->{deleted});
    next if ($b->{type} == solid());
    $covered = 0; # not yet
    foreach $r (@$rlist)
      {
      if ( ($b->{x} + $b->{l}/2 < $r->{x} + $r->{l}/2) &&
           ($b->{x} - $b->{l}/2 > $r->{x} - $r->{l}/2) &&
           ($b->{y} + $b->{w}/2 < $r->{y} + $r->{w}/2) &&
           ($b->{y} - $b->{w}/2 > $r->{y} - $r->{w}/2) &&
           ($b->{z} + $b->{h}/2 < $r->{z} + $r->{h}/2) &&
           ($b->{z} - $b->{h}/2 > $r->{z} - $r->{h}/2) )
        {
        $covered = 1; last;
        }
      }
    if ($covered == 0)
      {
      $rep .= " $b->{id}\n"; $matchcnt++; 
      }
    }
  $rep .= " None.\n" if ($matchcnt == 0);
  if ($matchcnt > 0)  
    {
    $rep .= " $matchcnt problematic brushes found.";
    if ($fix != 0)
      {
      $self->(1,$defroom); $rep .= " Fixing rooms."; 
      }
    $rep .= "\n";
    }
  $self->autoFlow(); $rep .= "Fixing flows.\n"; 
  $rep .=  "\n$self->{name} now contains:\n $self->{brushes} brushes,";
  $rep .= " $self->{rooms} rooms,"; 
  $rep .= " $self->{flows} flows,"; 
  $rep .= " $self->{areas} areas,"; 
  $rep .= " $self->{lights} lights"; 
  $rep .= " and ".$self->numObjects()." objects in"; 
  $rep .= " $self->{groups} groups.\n\n";
  $rep .= "\nDone report on ".scalar localtime()."\n";
  $rep;
  }

1;

