File Coverage

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

Criterion	Covered	Total	%
statement	37	60	61.6
branch	3	18	16.6
condition	11	16	68.7
subroutine	7	12	58.3
pod	5	5	100.0
total	63	111	56.7

# Sensor - monitor conditions and trigger when they are met

package Games::3D::Sensor;

# (C) by Tels

use strict;

use Exporter;
use Games::3D::Signal qw/
  SIG_FLIP SIG_OFF SIG_DIE
  SIG_ACTIVATE SIG_DEACTIVATE
  /;
use Games::3D::Link;
use vars qw/@ISA @EXPORT_OK $VERSION/;
@ISA = qw/Exporter Games::3D::Link/;

$VERSION = '0.01';

sub COND_MET() { 1; }
sub COND_NOT_MET() { 2; }
sub COND_UNCOND() { 3; }

sub SENSOR_BELOW() { 0; }
sub SENSOR_OVER() { 1; }
sub SENSOR_BETWEEN() { 2; }
sub SENSOR_DIED() { 3; }
sub SENSOR_ACTIVE() { 4; }
sub SENSOR_INACTIVE() { 5; }

# periodic re-check required
sub SENSOR_PERIODIC() { 1000; }		# dont use this type, only for comp.

sub SENSOR_VISIBLE() { 1001; }
sub SENSOR_DISTANCE() { 1002; }

@EXPORT_OK = qw/
   COND_MET COND_NOT_MET COND_UNCOND
   SENSOR_BELOW
   SENSOR_BETWEEN
   SENSOR_OVER
   SENSOR_DIED
   SENSOR_ACTIVE
   SENSOR_INACTIVE
   SENSOR_VISIBLE
   SENSOR_DISTANCE
  /;

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

sub _init
  {
  my $self = shift;
  my $args = $_[0];

  $args = { @_ } if ref($_[0]) ne 'HASH';

  my $obj = $args->{obj};
  my $id = $obj->{id};
  $self->{watch} = {
	$id => [ $obj, $args->{what} ], # object(s) to watch for
	};

  $self->{A} = $args->{A} || 0;			# range A..B
  $self->{B} = $args->{B} || $args->{A} || 0;	# range A..B
  warn ("A=$self->{A} > B=$self->{B}\n") if
    $self->{A} > $self->{B};
  $self->{type} = $args->{type} || SENSOR_BELOW;# signal must be below A

  $self->{periodic} = 0;			# check only on change
  $self->{periodic} = 1
   if $self->{type} > SENSOR_PERIODIC;		# check periodically

  $self->{delay} = $args->{delay} || 0;		# immidiately
  $self->{repeat} = $args->{repeat} || 2000;	# 2 seconds if count != 1
  $self->{rand} = $args->{rand} || 0;		# exactly
  $self->{count} = $args->{count} || 1;		# one signal
  $self->{when} = $args->{when} || COND_UNCOND;	# in and outside of range
  $self->{fixed_output} = $args->{fixed_output};# ON and OFF are default

  $self;
  }

sub signal
  {
  my ($self,$input,$sig) = @_;

#  my $id = $input; $id = $input->{id} if ref($id);
#  print "# ",$self->name()," received signal $sig from $id\n";

  die ("Unregistered input $input tried to send signal to link $self->{id}")
   if !exists $self->{inputs}->{$input};

  # if the signal is DIE, DESTROY yourself
  if ($sig == SIG_DIE)
    {
    $self->kill();
    return;
    }
  # if the signal is ACTIVATE or DEACTIVATE, (in)activate yourself
  if ($sig == SIG_ACTIVATE)
    {
    $self->activate();
    return;				# don't relay this signal
    }
  elsif ($sig == SIG_DEACTIVATE)
    {
    $self->deactivate();
    return;				# don't relay this signal
    }

  # ignore all other signals
  return;				# don't relay this signal
  }

BEGIN
  {
  # inherit these from Thingy instead from Link:
  *link = \&Games::3D::Thingy::link;
  *unlink = \&Games::3D::Thingy::unlink;
  *add_input = \&Games::3D::Thingy::add_input;
  }

sub and_gate
  {
  my $self = shift;

  warn ("Sensors cannot act as AND gates.\n");
  }

sub watch
  {
  # bind an additional target to the sensor
  my ($self,$dst,$what) = @_;

  my $id = $dst->{id};
  $self->{watch} = {
	$id => [ $dst, $what ], 	# object(s) to watch for
	};
  $self;
  }

sub when
  {
  my ($self) = shift;

  $self->{when} = shift if @_ > 0;
  $self->{when};
  }

sub type
  {
  my ($self) = shift;

  $self->{type} = shift if @_ > 0;
  $self->{type};
  }

1;

__END__