garage_leds.pl 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use POSIX;
  5. use Math::Random;
  6. # Local modules
  7. use Cwd qw(abs_path);
  8. use File::Basename qw(dirname);
  9. use lib dirname(abs_path($0));
  10. use DMX;
  11. # User config
  12. my $COLOR_TIMEOUT = 10;
  13. my $COLOR_TIME_MIN = int($COLOR_TIMEOUT / 2);
  14. my %COLOR_VAR = (
  15. 'PREMOTION' => 0.75,
  16. 'MOTION' => 0.35,
  17. 'POSTMOTION' => 0.75,
  18. );
  19. my $MOTION_TIMEOUT = 30;
  20. my $POSTMOTION_TIMEOUT = 60;
  21. my %DIM = (
  22. 'OFF' => [
  23. { 'channel' => 21, 'value' => 0, 'time' => 60000 },
  24. { 'channel' => 22, 'value' => 0, 'time' => 60000 },
  25. { 'channel' => 23, 'value' => 0, 'time' => 60000 },
  26. ],
  27. 'PREMOTION' => [
  28. { 'channel' => 21, 'value' => 5, 'time' => 2500 },
  29. { 'channel' => 22, 'value' => 5, 'time' => 2500 },
  30. { 'channel' => 23, 'value' => 5, 'time' => 2500 },
  31. ],
  32. 'MOTION' => [
  33. { 'channel' => 21, 'value' => 128, 'time' => 750 },
  34. { 'channel' => 22, 'value' => 128, 'time' => 750 },
  35. { 'channel' => 23, 'value' => 128, 'time' => 750 },
  36. ],
  37. 'POSTMOTION' => [
  38. { 'channel' => 21, 'value' => 8, 'time' => $POSTMOTION_TIMEOUT * 1000 },
  39. { 'channel' => 22, 'value' => 8, 'time' => $POSTMOTION_TIMEOUT * 1000 },
  40. { 'channel' => 23, 'value' => 8, 'time' => $POSTMOTION_TIMEOUT * 1000 },
  41. ],
  42. 'BRIGHT' => [
  43. { 'channel' => 21, 'value' => 255, 'time' => 1000 },
  44. { 'channel' => 22, 'value' => 255, 'time' => 1000 },
  45. { 'channel' => 23, 'value' => 255, 'time' => 1000 },
  46. ],
  47. 'ERROR' => [
  48. { 'channel' => 21, 'value' => 112, 'time' => 100 },
  49. { 'channel' => 22, 'value' => 255, 'time' => 100 },
  50. { 'channel' => 23, 'value' => 112, 'time' => 100 },
  51. ],
  52. );
  53. # App config
  54. my $DATA_DIR = DMX::dataDir();
  55. my $STATE_SOCK = 'GARAGE_LEDS';
  56. my $OUTPUT_FILE = $DATA_DIR . $STATE_SOCK;
  57. my $PUSH_TIMEOUT = 20;
  58. my $PULL_TIMEOUT = $PUSH_TIMEOUT * 3;
  59. my $DELAY = $PULL_TIMEOUT / 2;
  60. # Debug
  61. my $DEBUG = 0;
  62. if ($ENV{'DEBUG'}) {
  63. $DEBUG = 1;
  64. }
  65. # Reset the timeouts if the color delay demands it
  66. if ($PUSH_TIMEOUT < $COLOR_TIMEOUT) {
  67. $PUSH_TIMEOUT = $COLOR_TIMEOUT / 2;
  68. }
  69. if ($DELAY > $COLOR_TIMEOUT / 2) {
  70. $DELAY = $COLOR_TIMEOUT / 2;
  71. }
  72. # State
  73. my $state = 'OFF';
  74. my $stateLast = $state;
  75. my $masterState = 'OFF';
  76. my %exists = ();
  77. my %mtime = ();
  78. my $pushLast = 0;
  79. my $pullLast = time();
  80. my $update = 0;
  81. my $lastMotion = 0;
  82. my @COLOR = ();
  83. my $colorChange = 0;
  84. # Always force lights into ERROR at launch
  85. $state = 'ERROR';
  86. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  87. # Sockets
  88. DMX::stateSocket($STATE_SOCK);
  89. DMX::stateSubscribe($STATE_SOCK);
  90. # Loop forever
  91. while (1) {
  92. # Wait for state updates
  93. my $cmdState = DMX::readState($DELAY, \%exists, \%mtime, undef());
  94. # Avoid repeated calls to time()
  95. my $now = time();
  96. # Record only valid states
  97. if (defined($cmdState)) {
  98. $masterState = $cmdState;
  99. $pullLast = $now;
  100. }
  101. # Die if we don't see regular updates
  102. if ($now - $pullLast > $PULL_TIMEOUT) {
  103. die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
  104. }
  105. # Calculate the new state
  106. $stateLast = $state;
  107. if ($exists{'BRIGHT'}) {
  108. $state = 'BRIGHT';
  109. } elsif ($mtime{'MOTION_GARAGE'} > $now - $MOTION_TIMEOUT) {
  110. $state = 'MOTION';
  111. $lastMotion = $now;
  112. } elsif ($masterState eq 'PLAY' || $masterState eq 'PAUSE' || $masterState eq 'MOTION') {
  113. if ($now > $lastMotion + $POSTMOTION_TIMEOUT) {
  114. $state = 'PREMOTION';
  115. } else {
  116. $state = 'POSTMOTION';
  117. }
  118. } else {
  119. $state = 'OFF';
  120. }
  121. # Color changes
  122. if ($COLOR_VAR{$state} && $now - $colorChange > $COLOR_TIMEOUT) {
  123. @COLOR = ();
  124. # Grab the default (white) data
  125. my $lums = 0;
  126. foreach my $data (@{ $DIM{$state} }) {
  127. $lums += $data->{'value'};
  128. }
  129. my $numChans = scalar(@{ $DIM{$state} });
  130. my $max = $lums / $numChans;
  131. # Pick the change interval
  132. my $time = int((rand($COLOR_TIMEOUT - $COLOR_TIME_MIN) + $COLOR_TIME_MIN) * 1000);
  133. # Assign each channel
  134. my @vals = random_normal($numChans, $max, $max * $COLOR_VAR{$state});
  135. foreach my $data (@{ $DIM{$state} }) {
  136. my $color = pop(@vals);
  137. push(@COLOR, { 'channel' => $data->{'channel'}, 'value' => $color, 'time' => $time });
  138. }
  139. # Update
  140. $update = 1;
  141. $colorChange = $now;
  142. if ($DEBUG) {
  143. print STDERR "New color\n";
  144. }
  145. }
  146. # Force updates on a periodic basis
  147. if (!$update && $now - $pushLast > $PUSH_TIMEOUT) {
  148. if ($DEBUG) {
  149. print STDERR "Forcing periodic update\n";
  150. }
  151. $update = 1;
  152. }
  153. # Force updates on any state change
  154. if (!$update && $stateLast ne $state) {
  155. if ($DEBUG) {
  156. print STDERR 'State change: ' . $stateLast . ' => ' . $state . "\n";
  157. }
  158. $update = 1;
  159. }
  160. # Update the lighting
  161. if ($update) {
  162. # Reset the color change sequence on any state change, so we always spend 1 cycle at white
  163. if ($stateLast ne $state) {
  164. if ($DEBUG) {
  165. print STDERR "Reset color sequence\n";
  166. }
  167. @COLOR = ();
  168. $colorChange = $now + $COLOR_TIME_MIN;
  169. }
  170. # Select a data set (color or standard)
  171. my @data_set = ();
  172. my $local_state = $state;
  173. if (scalar(@COLOR)) {
  174. @data_set = @COLOR;
  175. $local_state .= ' (Color)';
  176. } else {
  177. @data_set = @{ $DIM{$state} };
  178. }
  179. # Update
  180. DMX::applyDataset(\@data_set, $local_state, $OUTPUT_FILE);
  181. # Update the push time
  182. $pushLast = $now;
  183. # Clear the update flag
  184. $update = 0;
  185. }
  186. }