leds.pl 5.5 KB

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