File Coverage

blib/lib/Games/3D/World.pm

Criterion	Covered	Total	%
statement	58	98	59.1
branch	6	20	30.0
condition	1	3	33.3
subroutine	14	22	63.6
pod	17	18	94.4
total	96	161	59.6

# World - contains everything in the game world

package Games::3D::World;

# (C) by Tels

use strict;
use vars qw/$VERSION/;
use Games::3D::Template;

$VERSION = '0.07';

##############################################################################
# protected vars

  {
  my $id = 1;
  sub ID { return $id++;}
  sub _reset_ID { $id = 1; }
  }

##############################################################################
# methods

sub new
  {
  # create a new world
  my $class = shift;

  my $self = bless {}, $class;

  $self->{things} = { };
  $self->{render} = { };
  $self->{thinks} = { };
  $self->{templates} = {};
  _reset_ID();

  if (@_ == 2)
    {
    $self->load_templates($_[0]);
    $self->load_from_file($_[1]);
    }

  $self->{time} = 0;

  $self;
  }

sub load_from_file
  {
  my ($self,$file) = @_;

  $self->{file} = $file;
  $self->{things} = { };
  _reset_ID();

  $self;
  }

sub load_templates
  {
  my ($self,$file) = @_;

  if (!ref($file))
    {
    # got filename, so read in data
    open FILE, "$file" or die ("Cant read $file: $!");
    local $/ = undef;				# slurp mode
    my $doc = ;
    $file = \$doc;
    close FILE;
    }

  $self->{templates} = {};
  my @objects = Games::3D::Template::from_string($$file);

  if (@objects == 1 && !ref($objects[0]))
    {
    die($objects[0]);
    }
  foreach my $o (@objects)
    {
    if (exists $self->{templates}->{$o->{class}})
      {
      warn ("Template for class $o->{class} already seen");
      }
    $self->{templates}->{$o->{class}} = $o;
    $o->{_world} = $self;
    }

  $self;
  }

sub templates
  {
  my $self = shift;
  scalar keys %{$self->{templates}};
  }

sub save_templates
  {
  my ($self,$file) = @_;

  $self;
  }

sub save_to_file
  {
  my ($self,$file) = @_;

  $self->{file} = $file;
  $self;
  }

sub reload
  {
  my $self = shift;

  $self->load_from_file($self->{file});
  }

sub register
  {
  # register an object with yourself
  my ($self,$obj) = @_;

  $obj->{id} = ID();				# get it a new ID
  $self->{things}->{$obj->{id}} = $obj;   	# store it
  $self->{things}->{_world} = $self;		# give thing access to us
  if ($obj->{visible})
    {
    $self->{render}->{$obj->{id}} = $obj;   	# store it
    }
  if ($obj->{think_time} != 0)
    {
    $self->{think}->{$obj->{id}} = $obj;   	# store it
    }

  $self;
  }

sub unregister
  {
  # should ONLY be called via $thing->{_world}->unregister($thing) !
  my ($self,$thing) = @_;

  my $id = $thing->{id};
  delete $self->{render}->{$id};
  delete $self->{things}->{$id};
  # tricky, what happens if called inside update()?
  delete $self->{think}->{$id};

  $self;
  }

sub things
  {
  # get count of things
  my ($self) = @_;

  scalar keys %{$self->{things}};
  }

sub thinkers
  {
  # get count of thinking things
  my ($self) = @_;

  scalar keys %{$self->{think}};
  }

sub update
  {
  my ($self,$now) = @_;

  $self->{time} = $now;				# cache time
  foreach my $id (keys %{$self->{think}})
    {
    my $thing = $self->{think}->{$id};
    if ($thing->{next_think} >= $now)
      {
      $thing->think($now);
      }
    # if the thing is in transition between states, let it update itself
    $thing->update($now) if $thing->{state_endtime} != 0;

    # XXX TODO: does not handle things that no longer want to think()
    }
  $self;
  }

sub time
  {
  my $self = shift;

  $self->{time};
  }

sub render
  {
  my ($self,$now,$callback) = @_;

  foreach my $id (keys %{$self->{render}})
    {
    &$callback ( $now, $self->{render}->{$id} );
    }
  $self;
  }

sub create
  {
  # create an object based on a template (class name)
  my ($self,$class) = @_;

  return undef if !exists $self->{templates}->{$class};
  $self->{templates}->{$class}->create_thing();
  }

sub find_template
  {
  # given a class name, return the template object for it
  my ($self,$class) = @_;

  $self->{templates}->{$class};
  }

sub id { 0; }

1;

__END__