Gecko [ ikeda-bankin-syuuri.click ]

Name	Size	Permission
ActiveHome.pm	8.8 KB	-rw-r--r--
Controller.pm	6.84 KB	-rw-r--r--
Device.pm	1.04 KB	-rw-r--r--
Event.pm	2.89 KB	-rw-r--r--
EventList.pm	1.06 KB	-rw-r--r--
FireCracker.pm	4.16 KB	-rw-r--r--
Macro.pm	1 KB	-rw-r--r--
MacroProc.pm	2.25 KB	-rw-r--r--
Network.pm	2.11 KB	-rw-r--r--
SchedEvent.pm	3.62 KB	-rw-r--r--
Scheduler.pm	2.1 KB	-rw-r--r--
Server.pm	3.75 KB	-rw-r--r--
TwoWay.pm	2.96 KB	-rw-r--r--

Code Editor : FireCracker.pm

package X10::FireCracker;

# Perl module for communicating with an X10 FireCracker controller

use FileHandle;
use Device::SerialPort;

use strict;

use X10::Controller;

use vars qw(
	@ISA
	$cmd_prefix
	%house_codes
	%house_commands
	%unit_codes
	%unit_commands
	$cmd_suffix
	);

@ISA = qw( X10::Controller );

$cmd_prefix = 0xd5aa;

# commands will be assembled as either:
	# house_code | house_command
	# OR
	# house_code | unit_code | unit_command

%house_codes = (
	'A' => 0x6000, 'B' => 0x7000, 'C' => 0x4000, 'D' => 0x5000,
	'E' => 0x8000, 'F' => 0x9000, 'G' => 0xa000, 'H' => 0xb000,
	'I' => 0xe000, 'J' => 0xf000, 'K' => 0xc000, 'L' => 0xd000,
	'M' => 0x0000, 'N' => 0x1000, 'O' => 0x2000, 'P' => 0x3000,
	);
%house_commands = (
	'ALL OFF'    => 0x0080,
	'ALL ON'     => 0x0091,
	'LIGHTS OFF' => 0x0084,
	'LIGHTS ON'  => 0x0094,
	'DIM'        => 0x0098,
	'BRIGHT'     => 0x0088,
	);
%unit_codes = (
	1  => 0x0000, 2  => 0x0010, 3  => 0x0008, 4  => 0x0018,
	5  => 0x0040, 6  => 0x0050, 7  => 0x0048, 8  => 0x0058,
	9  => 0x0400, 10 => 0x0410, 11 => 0x0408, 12 => 0x0418,
	13 => 0x0440, 14 => 0x0450, 15 => 0x0448, 16 => 0x0458,
	);
%unit_commands = (
	'OFF'    => 0x0020,
	'ON'     => 0x0000,
	);
$cmd_suffix = 0xad;

### constructors

sub new
{
   my $type = shift;

my $self = new X10::Controller( @_ );
   bless $self, $type;

$self->{serial_port} = new Device::SerialPort($self->{port})
	|| die "Couldn't connect to FireCracker port ", $self->{port},
		": ", $!, "\n";

die "Need IOCTL constants for DTR/RTS manipulation -- see docs for Device::SerialPort"
	unless $self->{serial_port}->can_ioctl;

$self->{serial_port}->dtr_active(0);
   $self->{serial_port}->rts_active(0);

&usleep(100000);

return $self;
}

### public methods (most overriding parent class)

sub send
{
   my $self = shift;
   foreach (@_)
   {
      $self->send_one($_);
   }
}

sub send_one
{
   my $self = shift;
   my $event = shift;

my $hc = $event->house_code;
   my $uc = $event->unit_code;
   my $fn = $event->func;

# my $house = '[a-p]';
   # my $unit = '0?\d|1[01-6]';

if ($fn eq 'ON' || $fn eq 'OFF')
   {
      $self->send_fcword(
	$house_codes{$hc}
	| $unit_codes{$uc}
	| $unit_commands{$fn}
	);

$self->got_event($event);
   }
   elsif ($fn eq 'DIM' || $fn eq 'BRIGHT')
   {
      $self->send_fcword(
	$house_codes{$hc}
	| $unit_codes{$uc}
	| $unit_commands{'ON'}
	);
      $self->send_fcword(
	$house_codes{$hc}
	| $house_commands{$fn}
	);

$self->got_event($event);
   }
   elsif ( ($uc eq 'ALL' && $fn eq 'OFF')
	|| ( $uc eq 'LIGHTS' && $fn eq 'ON' ) )
   {
      $self->send_fcword(
	$house_codes{$hc}
	| $house_commands{"$uc $fn"}
	);

$self->got_event($event);
   }
   else
   {
      warn "Unrecognized event: ", $event->as_string, "\n";
      return 0;
   }

}

### private methods -- don't call these from ouside!

sub send_fcword
{
   my $self = shift;
   my $fcword = shift;

$self->{serial_port}->dtr_active(1);
   $self->{serial_port}->rts_active(1);
   &usleep(200000);

$self->send_bits($cmd_prefix, 16);
   $self->send_bits($fcword, 16);
   $self->send_bits($cmd_suffix, 8);

# again, should end up this way, but...
   $self->{serial_port}->dtr_active(1);
   $self->{serial_port}->rts_active(1);
   &usleep(200000);

$self->{serial_port}->dtr_active(0);
   $self->{serial_port}->rts_active(0);
   &usleep(100000);
}

sub send_bits
{
   my $self = shift;

my $word = shift;

my $length = shift || 16;

for (my $i = 1 << ($length-1); $i; $i = $i >> 1)
   {
      $self->send_bit($i & $word);
   }
}

sub send_bit
{
   my $self = shift;

return 0 unless exists $self->{serial_port};

my $boolean = shift;

if ($boolean)
   {
      # send a 'one' bit
      $self->{serial_port}->pulse_dtr_off(2);	# milliseconds
      &usleep(1400);
   }
   else
   {
      # send a 'zero' bit
      $self->{serial_port}->pulse_rts_off(2);	# milliseconds
      &usleep(1400);
   }

# 'clock'
   &usleep(2000);

}

### utility functions -- not called as methods

sub usleep
{
   my $usecs = shift;
   select(undef, undef, undef, $usecs / 1000000);
}

${this.title}

Code Editor : FireCracker.pm