|
|
@@ -0,0 +1,264 @@
|
|
|
+#!/usr/bin/perl
|
|
|
+use strict;
|
|
|
+use warnings;
|
|
|
+use POSIX;
|
|
|
+use Math::Random;
|
|
|
+
|
|
|
+# Local modules
|
|
|
+use Cwd qw(abs_path);
|
|
|
+use File::Basename qw(dirname);
|
|
|
+use lib dirname(abs_path($0));
|
|
|
+use DMX;
|
|
|
+
|
|
|
+# User config
|
|
|
+my $COLOR_TIMEOUT = 30;
|
|
|
+my $COLOR_TIME_MIN = int($COLOR_TIMEOUT / 2);
|
|
|
+my %COLOR_VAR = (
|
|
|
+ 'PLAY' => 0.55,
|
|
|
+ 'PLAY_HIGH' => 0.40,
|
|
|
+ 'PAUSE' => 0.50,
|
|
|
+ 'MOTION' => 0.15,
|
|
|
+);
|
|
|
+my $OIL_CHANNEL = 31;
|
|
|
+my $OIL_BRIGHTNESS = 0.10;
|
|
|
+my %DIM = (
|
|
|
+ 'OFF' => [
|
|
|
+ { 'channel' => 29, 'value' => 0, 'time' => 60000 },
|
|
|
+ { 'channel' => 30, 'value' => 0, 'time' => 60000 },
|
|
|
+ { 'channel' => 31, 'value' => 0, 'time' => 60000 },
|
|
|
+ ],
|
|
|
+ 'PLAY' => [
|
|
|
+ { 'channel' => 29, 'value' => 8, 'time' => 750 },
|
|
|
+ { 'channel' => 30, 'value' => 8, 'time' => 750 },
|
|
|
+ { 'channel' => 31, 'value' => 10, 'time' => 750 },
|
|
|
+ ],
|
|
|
+ 'PLAY_HIGH' => [
|
|
|
+ { 'channel' => 29, 'value' => 48, 'time' => 750 },
|
|
|
+ { 'channel' => 30, 'value' => 48, 'time' => 750 },
|
|
|
+ { 'channel' => 31, 'value' => 48, 'time' => 750 },
|
|
|
+ ],
|
|
|
+ 'PAUSE' => [
|
|
|
+ { 'channel' => 29, 'value' => 64, 'time' => 750 },
|
|
|
+ { 'channel' => 30, 'value' => 64, 'time' => 750 },
|
|
|
+ { 'channel' => 31, 'value' => 64, 'time' => 750 },
|
|
|
+ ],
|
|
|
+ 'MOTION' => [
|
|
|
+ { 'channel' => 29, 'value' => 96, 'time' => 750 },
|
|
|
+ { 'channel' => 30, 'value' => 96, 'time' => 750 },
|
|
|
+ { 'channel' => 31, 'value' => 96, 'time' => 750 },
|
|
|
+ ],
|
|
|
+ 'BRIGHT' => [
|
|
|
+ { 'channel' => 29, 'value' => 255, 'time' => 750 },
|
|
|
+ { 'channel' => 30, 'value' => 255, 'time' => 750 },
|
|
|
+ { 'channel' => 31, 'value' => 255, 'time' => 750 },
|
|
|
+ ],
|
|
|
+ 'ERROR' => [
|
|
|
+ { 'channel' => 29, 'value' => 144, 'time' => 100 },
|
|
|
+ { 'channel' => 30, 'value' => 255, 'time' => 100 },
|
|
|
+ { 'channel' => 31, 'value' => 144, 'time' => 100 },
|
|
|
+ ],
|
|
|
+);
|
|
|
+
|
|
|
+# App config
|
|
|
+my $DATA_DIR = DMX::dataDir();
|
|
|
+my $STATE_SOCK = 'SHELF_HIGH';
|
|
|
+my $OUTPUT_FILE = $DATA_DIR . $STATE_SOCK;
|
|
|
+my $PUSH_TIMEOUT = 20;
|
|
|
+my $PULL_TIMEOUT = $PUSH_TIMEOUT * 3;
|
|
|
+my $DELAY = $PULL_TIMEOUT / 2;
|
|
|
+
|
|
|
+# Debug
|
|
|
+my $DEBUG = 0;
|
|
|
+if ($ENV{'DEBUG'}) {
|
|
|
+ $DEBUG = 1;
|
|
|
+}
|
|
|
+
|
|
|
+# Reset the timeouts if the color delay demands it
|
|
|
+if ($PUSH_TIMEOUT < $COLOR_TIMEOUT) {
|
|
|
+ $PUSH_TIMEOUT = $COLOR_TIMEOUT / 2;
|
|
|
+}
|
|
|
+if ($DELAY > $COLOR_TIMEOUT / 2) {
|
|
|
+ $DELAY = $COLOR_TIMEOUT / 2;
|
|
|
+}
|
|
|
+
|
|
|
+# Construct a list of valid states
|
|
|
+my %VALID = ();
|
|
|
+foreach my $key (keys(%DIM)) {
|
|
|
+ $VALID{$key} = 1;
|
|
|
+}
|
|
|
+
|
|
|
+# State
|
|
|
+my $state = 'OFF';
|
|
|
+my $stateLast = $state;
|
|
|
+my %exists = ();
|
|
|
+my $pushLast = 0;
|
|
|
+my $pullLast = time();
|
|
|
+my $update = 0;
|
|
|
+my @COLOR = ();
|
|
|
+my $colorChange = 0;
|
|
|
+my $enabled = 0;
|
|
|
+my $enabledLast = $enabled;
|
|
|
+
|
|
|
+# Always force lights into ERROR at launch
|
|
|
+$state = 'ERROR';
|
|
|
+DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
|
|
|
+
|
|
|
+# Sockets
|
|
|
+DMX::stateSocket($STATE_SOCK);
|
|
|
+DMX::stateSubscribe($STATE_SOCK);
|
|
|
+
|
|
|
+# Loop forever
|
|
|
+while (1) {
|
|
|
+
|
|
|
+ # State is calculated; use newState to gather data
|
|
|
+ my $newState = $state;
|
|
|
+
|
|
|
+ # Wait for state updates
|
|
|
+ my $cmdState = DMX::readState($DELAY, \%exists, undef(), \%VALID);
|
|
|
+
|
|
|
+ # Avoid repeated calls to time()
|
|
|
+ my $now = time();
|
|
|
+
|
|
|
+ # Record only valid states
|
|
|
+ if (defined($cmdState)) {
|
|
|
+ $newState = $cmdState;
|
|
|
+ $pullLast = $now;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Die if we don't see regular updates
|
|
|
+ if ($now - $pullLast > $PULL_TIMEOUT) {
|
|
|
+ die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
|
|
|
+ }
|
|
|
+
|
|
|
+ # Skip processing when in RAVE or EFFECT mode
|
|
|
+ if ($exists{'RAVE'} || $exists{'EFFECT'}) {
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR "Suspending normal operation while in RAVE mode\n";
|
|
|
+ }
|
|
|
+ $update = 1;
|
|
|
+ next;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Determine if OIL is enabled
|
|
|
+ $enabledLast = $enabled;
|
|
|
+ $enabled = 0;
|
|
|
+ if ($exists{'OIL'} =~ /\(Enabled\)/) {
|
|
|
+ $enabled = 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Calculate the new state
|
|
|
+ $stateLast = $state;
|
|
|
+ if ($exists{'BRIGHT'}) {
|
|
|
+ $newState = 'BRIGHT';
|
|
|
+ } elsif ($exists{'LIGHTS'}) {
|
|
|
+ if ($newState eq 'PLAY') {
|
|
|
+ $newState = 'PLAY_HIGH';
|
|
|
+ } else {
|
|
|
+ $newState = 'MOTION';
|
|
|
+ }
|
|
|
+ }
|
|
|
+ $state = $newState;
|
|
|
+
|
|
|
+ # Color changes
|
|
|
+ if ($COLOR_VAR{$state} && $now - $colorChange > $COLOR_TIMEOUT) {
|
|
|
+ @COLOR = ();
|
|
|
+
|
|
|
+ # Grab the default (white) data
|
|
|
+ my $lums = 0;
|
|
|
+ foreach my $data (@{ $DIM{$state} }) {
|
|
|
+ $lums += $data->{'value'};
|
|
|
+ }
|
|
|
+ my $numChans = scalar(@{ $DIM{$state} });
|
|
|
+ my $max = $lums / $numChans;
|
|
|
+
|
|
|
+ # Assign each channel
|
|
|
+ my @vals = random_normal($numChans, $max, $max * $COLOR_VAR{$state});
|
|
|
+ foreach my $data (@{ $DIM{$state} }) {
|
|
|
+ my $color = pop(@vals);
|
|
|
+ push(@COLOR, { 'channel' => $data->{'channel'}, 'value' => $color, 'time' => 750 });
|
|
|
+ }
|
|
|
+
|
|
|
+ # Update
|
|
|
+ $update = 1;
|
|
|
+ $colorChange = $now;
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR "New color\n";
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # Force updates on a periodic basis
|
|
|
+ if (!$update && $now - $pushLast > $PUSH_TIMEOUT) {
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR "Forcing periodic update\n";
|
|
|
+ }
|
|
|
+ $update = 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Force updates on any state change
|
|
|
+ if (!$update && $stateLast ne $state) {
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR 'State change: ' . $stateLast . ' => ' . $state . "\n";
|
|
|
+ }
|
|
|
+ $update = 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Force updates on any OIL enabled change
|
|
|
+ if (!$update && $enabledLast != $enabled) {
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR 'Enabled change: ' . $enabledLast . ' => ' . $enabled . "\n";
|
|
|
+ }
|
|
|
+ $update = 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Update the lighting
|
|
|
+ if ($update) {
|
|
|
+
|
|
|
+ # Reset the color change sequence on any state change, so we always spend 1 cycle at white
|
|
|
+ if ($stateLast ne $state) {
|
|
|
+ if ($DEBUG) {
|
|
|
+ print STDERR "Reset color sequence\n";
|
|
|
+ }
|
|
|
+ @COLOR = ();
|
|
|
+ $colorChange = $now + $COLOR_TIME_MIN;
|
|
|
+ }
|
|
|
+
|
|
|
+ # Select a data set (color or standard)
|
|
|
+ my $data = $DIM{$state};
|
|
|
+ my $local_state = $state;
|
|
|
+ if (scalar(@COLOR)) {
|
|
|
+ $data = \@COLOR;
|
|
|
+ $local_state .= ' (Color)';
|
|
|
+ }
|
|
|
+
|
|
|
+ # Ensure it's safe to overwrite the data
|
|
|
+ my @data_set = ();
|
|
|
+ foreach my $set (@{ $data }) {
|
|
|
+ my %tmp = %{ $set };
|
|
|
+ push(@data_set, \%tmp);
|
|
|
+ }
|
|
|
+
|
|
|
+ # Override for $enabled -- similar brightness but only one channel
|
|
|
+ if ($enabled) {
|
|
|
+ my $sum = 0;
|
|
|
+ my $ref = undef();
|
|
|
+ foreach my $set (@data_set) {
|
|
|
+ $sum += $set->{'value'};
|
|
|
+ $set->{'value'} = 0;
|
|
|
+ if ($set->{'channel'} == $OIL_CHANNEL) {
|
|
|
+ $ref = $set;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ $ref->{'value'} = $sum * $OIL_BRIGHTNESS;
|
|
|
+ $local_state .= ' [Oil]';
|
|
|
+ }
|
|
|
+
|
|
|
+ # Update
|
|
|
+ DMX::applyDataset(\@data_set, $local_state, $OUTPUT_FILE);
|
|
|
+
|
|
|
+ # Update the push time
|
|
|
+ $pushLast = $now;
|
|
|
+
|
|
|
+ # Clear the update flag
|
|
|
+ $update = 0;
|
|
|
+ }
|
|
|
+}
|
Zachary Kotlarek