Games-3D

 view release on metacpan or  search on metacpan

lib/Games/3D/Thingy.pm  view on Meta::CPAN

sub del_input
  {
  my ($self,$src) = @_;
  
  delete $self->{inputs}->{$src->{id}};
  }

sub del_output
  {
  my ($self,$dst) = @_;

  delete $self->{outputs}->{$dst->{id}};
  }

sub unlink
  {
  # unlink all inputs and outputs from ourself
  my $self = shift;

  foreach my $out (keys %{$self->{outputs}})
    {
    $self->{outputs}->{$out}->del_input($self)
     if ref($self->{outputs}->{$out});
    }
  foreach my $in (keys %{$self->{inputs}})
    {
    $self->{inputs}->{$in}->del_output($self)
     if ref($self->{inputs}->{$in});
    }
  $self->{inputs} = {};
  $self->{outputs} = {};
  $self;
  }

sub output
  {
  # send a signal to all the outputs
  my ($self,$source,$sig) = @_;

  $source = $source->{id} if ref($source);
  my $out = $self->{outputs};
  foreach my $id (keys %{$self->{outputs}})
    {
    $out->{$id}->signal($source,$sig);			# sender id, signal	
    }
  }

sub link
  {
  # link us to another one by creating intermidiate link object and return
  # link object
  my ($self,$dst,$link) = @_;

  $self->{outputs}->{$link->{id}} = $link;
  $link->add_output($dst);			# from link to $dst
  $dst->add_input($link);
  $link->add_input($self);			# from us to link
  $link;
  }

sub update
  {
  # if thing is going from state A to state B, interpolate values based upon
  # current time tick. If reached state B, disable interpolation, and send a 
  # signal. Return 1 if while still in transit, 0 if target state reached

  my ($self, $tick) = @_;

  # if the thingy is in between two state changes, interpolate between them
  return if $self->{state_endtime} == 0;	# no change neccessary
  
  # for all fields in the target state, interpolate them
  my $s = "state_$self->{state_target}";
  if (!exists $self->{$s})
    {
    $self->{$s} = [1];
    }
  my @states = @{$self->{$s}};

  if ($tick >= $self->{state_endtime})		# overdue
    {
    # simple set the fields, and disable the state change
    print "# update($tick) caused change ",$self->name(),
     " $self->{state} => $self->{state_target}\n" if DEBUG;

    $self->{state_endtime} = 0;			# no further change
    $self->{state} = $self->{state_target};	# reached target state
    # send signal that state change is complete
    print "# Sending signal ", signal_name(signal_from_state($self->{state})),
     "\n" if DEBUG;
    $self->output($self, signal_from_state($self->{state}));

    while (@states > 0)
      {
      # set a => 1 (f.i.)
      $self->{$states[0]} = $states[1];
      splice @states,0,2;			# throw away first two entries
      }
    return 0;					# no more changes
    }
  
  my $time = shift @states;			# field 0 is the time it takes
 
  # get the values from the current state 
  my @cur_states = @{$self->{"states_$self->{state}"}};
  shift @cur_states;				# dont need field 0

  # factor: endtime - time = starttime		# 200 - 100 = 100
  #         tick - starttime = elapsedtime	# 180 - 100 = 80
  #         time / elapsedtime = factor		# 100 / 80 = 0.8 (80%)

  my $factor = $time / ($tick - ($self->{state_endtime} - $time));

  # interpolate linaer to the target values  
  while (@states > 0)
    {
    # 20 .. 80 => 60 * 0.8 (factor, 80%) = 48 + 20 => 68 as current value
    $self->{$states[0]} =
     ($states[1] - $cur_states[1]) * $factor + $cur_states[1];

    splice @states,0,2;				# throw away first two entries



( run in 3.194 seconds using v1.01-cache-2.11-cpan-75ffa21a3d4 )