Zachary Kotlarek 13 лет назад
Родитель
Сommit
e83d5d12a8
6 измененных файлов с 69 добавлено и 134 удалено
  1. 44 12
      dmx/DMX.pm
  2. 2 20
      dmx/bias.pl
  3. 2 20
      dmx/fan.pl
  4. 17 42
      dmx/leds.pl
  5. 2 20
      dmx/overhead.pl
  6. 2 20
      dmx/rope.pl

+ 44 - 12
dmx/DMX.pm

@@ -21,14 +21,19 @@ my $DATA_DIR     = $TEMP_DIR . 'plexMonitor/';
 my $DMX_SOCK     = $DATA_DIR . 'DMX.socket';
 my $SUB_SOCK     = $DATA_DIR . 'STATE.socket';
 
+# State
+my $DMX_FH = undef();
+
 # DMX socket init
 sub dmxSock() {
-	my $dmx_fh = IO::Socket::UNIX->new(
-	        'Peer'    => $DMX_SOCK,
-	        'Type'    => IO::Socket::UNIX::SOCK_DGRAM,
-	        'Timeout' => $SOCK_TIMEOUT
-	) or die('Unable to open socket: ' . $DMX_SOCK . ": ${@}\n");
-	return $dmx_fh;
+	if (!defined($DMX_FH)) {
+		$DMX_FH = IO::Socket::UNIX->new(
+			'Peer'    => $DMX_SOCK,
+			'Type'    => IO::Socket::UNIX::SOCK_DGRAM,
+			'Timeout' => $SOCK_TIMEOUT
+		) or die('Unable to open DMX socket: ' . $DMX_SOCK . ": ${@}\n");
+	}
+	return $DMX_FH;
 }
 
 # Subscribe to state updates
@@ -36,9 +41,9 @@ sub stateSubscribe($) {
 	my ($STATE_SOCK) = @_;
 
 	my $sub_fh = IO::Socket::UNIX->new(
-	        'Peer'    => $SUB_SOCK,
-	        'Type'    => IO::Socket::UNIX::SOCK_DGRAM,
-	        'Timeout' => $SOCK_TIMEOUT
+		'Peer'    => $SUB_SOCK,
+		'Type'    => IO::Socket::UNIX::SOCK_DGRAM,
+		'Timeout' => $SOCK_TIMEOUT
 	) or die('Unable to open state subscription socket: ' . $SUB_SOCK . ": ${@}\n");
 	$sub_fh->send($STATE_SOCK)
 	  or die('Unable to subscribe: ' . $! . "\n");
@@ -51,11 +56,11 @@ sub stateSocket($) {
 	my ($STATE_SOCK) = @_;
 
 	if (-e $STATE_SOCK) {
-	        unlink($STATE_SOCK);
+		unlink($STATE_SOCK);
 	}
 	my $state_fh = IO::Socket::UNIX->new(
-	        'Local' => $STATE_SOCK,
-	        'Type'  => IO::Socket::UNIX::SOCK_DGRAM
+		'Local' => $STATE_SOCK,
+		'Type'  => IO::Socket::UNIX::SOCK_DGRAM
 	) or die('Unable to open state client socket: ' . $STATE_SOCK . ": ${@}\n");
 
 	my $select = IO::Select->new($state_fh)
@@ -107,5 +112,32 @@ sub parseState($$) {
 	return $cmdState;
 }
 
+sub dim($) {
+	my ($args) = @_;
+	if (!defined($args->{'delay'})) {
+		$args->{'delay'} = 0;
+	}
+	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
+		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
+	}
+
+	# Keep us in-range
+	my $value = int($args->{'value'});
+	if ($value > 255) {
+		$value = 255;
+	} elsif ($value < 0) {
+		$value = 0;
+	}
+
+	my $time  = int($args->{'time'});
+	my $delay = int($args->{'delay'});
+
+	my $cmd = join(':', $args->{'channel'}, $time, $value, $delay);
+
+	dmxSock();
+	$DMX_FH->send($cmd)
+	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
+}
+
 # Always return true
 1;

+ 2 - 20
dmx/bias.pl

@@ -10,9 +10,6 @@ use File::Basename qw(dirname);
 use lib dirname(abs_path($0));
 use DMX;
 
-# Prototypes
-sub dim($);
-
 # User config
 my %DIM = (
 	'OFF'    => [
@@ -67,7 +64,7 @@ my $pushLast  = 0;
 my $pullLast  = time();
 
 # Always force lights out at launch
-dim({ 'channel' => 12, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 12, 'value' => 0, 'time' => 0 });
 
 # Loop forever
 while (1) {
@@ -125,7 +122,7 @@ while (1) {
 		# Send the dim command
 		my @values = ();
 		foreach my $data (@{ $DIM{$state} }) {
-			dim($data);
+			DMX::dim($data);
 			push(@values, $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'});
 		}
 
@@ -139,18 +136,3 @@ while (1) {
 		$pushLast = time();
 	}
 }
-
-# Send the command
-sub dim($) {
-	my ($args) = @_;
-	if (!defined($args->{'delay'})) {
-		$args->{'delay'} = 0;
-	}
-	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
-		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
-	}
-
-	my $cmd = join(':', $args->{'channel'}, $args->{'time'}, $args->{'value'}, $args->{'delay'});
-	$dmx_fh->send($cmd)
-	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
-}

+ 2 - 20
dmx/fan.pl

@@ -10,9 +10,6 @@ use File::Basename qw(dirname);
 use lib dirname(abs_path($0));
 use DMX;
 
-# Prototypes
-sub dim($);
-
 # User config
 my %DIM = (
 	'OFF'    => [
@@ -61,7 +58,7 @@ my $pushLast  = 0;
 my $pullLast  = time();
 
 # Always force lights out at launch
-dim({ 'channel' => 11, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 11, 'value' => 0, 'time' => 0 });
 
 # Loop forever
 while (1) {
@@ -120,7 +117,7 @@ while (1) {
 		# Send the dim command
 		my @values = ();
 		foreach my $data (@{ $DIM{$state} }) {
-			dim($data);
+			DMX::dim($data);
 			push(@values, $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'});
 		}
 
@@ -134,18 +131,3 @@ while (1) {
 		$pushLast = time();
 	}
 }
-
-# Send the command
-sub dim($) {
-	my ($args) = @_;
-	if (!defined($args->{'delay'})) {
-		$args->{'delay'} = 0;
-	}
-	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
-		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
-	}
-
-	my $cmd = join(':', $args->{'channel'}, $args->{'time'}, $args->{'value'}, $args->{'delay'});
-	$dmx_fh->send($cmd)
-	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
-}

+ 17 - 42
dmx/leds.pl

@@ -13,7 +13,6 @@ use lib dirname(abs_path($0));
 use DMX;
 
 # Prototypes
-sub dim($);
 sub red_alert();
 sub red_flash();
 
@@ -112,9 +111,9 @@ my @COLOR       = ();
 my $colorChange = time();
 
 # Always force lights out at launch
-dim({ 'channel' => 13, 'value' => 0, 'time' => 0 });
-dim({ 'channel' => 14, 'value' => 0, 'time' => 0 });
-dim({ 'channel' => 15, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 13, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 14, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 15, 'value' => 0, 'time' => 0 });
 
 # Loop forever
 while (1) {
@@ -260,7 +259,13 @@ while (1) {
 		# Send the dim command
 		my @values = ();
 		foreach my $data (@data_set) {
-			dim($data);
+
+			# Adjust the gamma curve (for channels where we have such data)
+			if ($CHANNEL_ADJ{$data->{'channel'}}) {
+				$data->{'value'} *= $CHANNEL_ADJ{$data->{'channel'}};
+			}
+
+			DMX::dim($data);
 			push(@values, $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'});
 		}
 
@@ -275,36 +280,6 @@ while (1) {
 	}
 }
 
-# Send the command
-sub dim($) {
-	my ($args) = @_;
-	if (!defined($args->{'delay'})) {
-		$args->{'delay'} = 0;
-	}
-	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
-		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
-	}
-
-	# Adjust the gamma curve (for channels where we have such data)
-	my $value = $args->{'value'};
-	if ($CHANNEL_ADJ{$args->{'channel'}}) {
-		$value *= $CHANNEL_ADJ{$args->{'channel'}};
-	}
-
-	# Keep us in-range
-	$value = int($value);
-	if ($value > 255) {
-		$value = 255;
-	} elsif ($value < 0) {
-		$value = 0;
-	}
-
-	# Send the command
-	my $cmd = join(':', $args->{'channel'}, int($args->{'time'}), $value, int($args->{'delay'}));
-	$dmx_fh->send($cmd)
-	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
-}
-
 # ======================================
 # Effects routines
 # These are blocking, so be careful
@@ -318,26 +293,26 @@ sub red_alert() {
 	push(@other, { 'channel' => 13, 'value' => 0, 'time' => 0 });
 	push(@other, { 'channel' => 15, 'value' => 0, 'time' => 0 });
 	foreach my $data (@other) {
-		dim($data);
+		DMX::dim($data);
 	}
 
 	my %high = ('channel' => 14, 'value' => 255, 'time' => $ramp);
 	my %low = %high;
 	$low{'value'} = 64;
 
-	dim(\%high);
+	DMX::dim(\%high);
 	system(@sound);
-	dim(\%low);
+	DMX::dim(\%low);
 	usleep($sleep * 1000);
 
-	dim(\%high);
+	DMX::dim(\%high);
 	system(@sound);
-	dim(\%low);
+	DMX::dim(\%low);
 	usleep($sleep * 1000);
 
-	dim(\%high);
+	DMX::dim(\%high);
 	system(@sound);
-	dim(\%low);
+	DMX::dim(\%low);
 	usleep($sleep * 1000);
 }
 

+ 2 - 20
dmx/overhead.pl

@@ -10,9 +10,6 @@ use File::Basename qw(dirname);
 use lib dirname(abs_path($0));
 use DMX;
 
-# Prototypes
-sub dim($);
-
 # User config
 my %DIM = (
 	'OFF'      => [
@@ -70,7 +67,7 @@ my $pushLast  = 0;
 my $pullLast  = time();
 
 # Always force lights out at launch
-dim({ 'channel' => 4, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 4, 'value' => 0, 'time' => 0 });
 
 # Loop forever
 while (1) {
@@ -137,7 +134,7 @@ while (1) {
 		# Send the dim command
 		my @values = ();
 		foreach my $data (@{ $DIM{$state} }) {
-			dim($data);
+			DMX::dim($data);
 			push(@values, $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'});
 		}
 
@@ -151,18 +148,3 @@ while (1) {
 		$pushLast = time();
 	}
 }
-
-# Send the command
-sub dim($) {
-	my ($args) = @_;
-	if (!defined($args->{'delay'})) {
-		$args->{'delay'} = 0;
-	}
-	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
-		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
-	}
-
-	my $cmd = join(':', $args->{'channel'}, $args->{'time'}, $args->{'value'}, $args->{'delay'});
-	$dmx_fh->send($cmd)
-	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
-}

+ 2 - 20
dmx/rope.pl

@@ -10,9 +10,6 @@ use File::Basename qw(dirname);
 use lib dirname(abs_path($0));
 use DMX;
 
-# Prototypes
-sub dim($);
-
 # User config
 my %DIM = (
 	'OFF'    => [
@@ -98,7 +95,7 @@ my $pushLast  = 0;
 my $pullLast  = time();
 
 # Always force lights out at launch
-dim({ 'channel' => 0, 'value' => 0, 'time' => 0 });
+DMX::dim({ 'channel' => 0, 'value' => 0, 'time' => 0 });
 
 # Loop forever
 while (1) {
@@ -166,7 +163,7 @@ while (1) {
 		# Send the dim command
 		my @values = ();
 		foreach my $data (@{ $DIM{$state} }) {
-			dim($data);
+			DMX::dim($data);
 			push(@values, $data->{'channel'} . ' => ' . $data->{'value'} . ' @ ' . $data->{'time'});
 		}
 
@@ -180,18 +177,3 @@ while (1) {
 		$pushLast = time();
 	}
 }
-
-# Send the command
-sub dim($) {
-	my ($args) = @_;
-	if (!defined($args->{'delay'})) {
-		$args->{'delay'} = 0;
-	}
-	if (!defined($args->{'channel'}) || !defined($args->{'time'}) || !defined($args->{'value'})) {
-		die('Invalid command for socket: ' . join(', ', keys(%{$args})) . ': ' . join(', ', values(%{$args})) . "\n");
-	}
-
-	my $cmd = join(':', $args->{'channel'}, $args->{'time'}, $args->{'value'}, $args->{'delay'});
-	$dmx_fh->send($cmd)
-	  or die('Unable to write command to DMX socket: ' . $cmd . ": ${!}\n");
-}