bias.pl 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. # Local modules
  5. use Cwd qw(abs_path);
  6. use File::Basename qw(dirname);
  7. use lib dirname(abs_path($0));
  8. use DMX;
  9. # User config
  10. my %DIM = (
  11. 'OFF' => [ { 'channel' => 12, 'value' => 0, 'time' => 60000 }, ],
  12. 'PLAY' => [ { 'channel' => 12, 'value' => 255, 'time' => 0 } ],
  13. 'PAUSE' => [ { 'channel' => 12, 'value' => 0, 'time' => 0, 'delay' => 10000 } ],
  14. 'MOTION' => [ { 'channel' => 12, 'value' => 0, 'time' => 0 } ],
  15. );
  16. # App config
  17. my $DATA_DIR = DMX::dataDir();
  18. my $STATE_SOCK = 'BIAS';
  19. my $OUTPUT_FILE = $DATA_DIR . $STATE_SOCK;
  20. my $PUSH_TIMEOUT = 20;
  21. my $PULL_TIMEOUT = $PUSH_TIMEOUT * 3;
  22. my $DELAY = $PULL_TIMEOUT / 2;
  23. # Debug
  24. my $DEBUG = 0;
  25. if ($ENV{'DEBUG'}) {
  26. $DEBUG = 1;
  27. }
  28. # Construct a list of valid states
  29. my %VALID = ();
  30. foreach my $key (keys(%DIM)) {
  31. $VALID{$key} = 1;
  32. }
  33. # State
  34. my $state = 'OFF';
  35. my $stateLast = $state;
  36. my %exists = ();
  37. my $pushLast = 0;
  38. my $pullLast = time();
  39. my $update = 0;
  40. # Always force lights into OFF at launch
  41. $state = 'OFF';
  42. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  43. # Sockets
  44. DMX::stateSocket($STATE_SOCK);
  45. DMX::stateSubscribe($STATE_SOCK);
  46. # Loop forever
  47. while (1) {
  48. # State is calculated; use newState to gather data
  49. my $newState = $state;
  50. # Wait for state updates
  51. my $cmdState = DMX::readState($DELAY, \%exists, undef(), \%VALID);
  52. if (defined($cmdState)) {
  53. $newState = $cmdState;
  54. $pullLast = time();
  55. }
  56. # Die if we don't see regular updates
  57. if (time() - $pullLast > $PULL_TIMEOUT) {
  58. die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
  59. }
  60. # Accept the new state directly
  61. $stateLast = $state;
  62. $state = $newState;
  63. # Force updates on a periodic basis
  64. if (!$update && time() - $pushLast > $PUSH_TIMEOUT) {
  65. if ($DEBUG) {
  66. print STDERR "Forcing periodic update\n";
  67. }
  68. $update = 1;
  69. }
  70. # Force updates on any state change
  71. if (!$update && $stateLast ne $state) {
  72. if ($DEBUG) {
  73. print STDERR 'State change: ' . $stateLast . ' => ' . $state . "\n";
  74. }
  75. $update = 1;
  76. }
  77. # Update the lighting
  78. if ($update) {
  79. # Update
  80. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  81. # Update the push time
  82. $pushLast = time();
  83. # Clear the update flag
  84. $update = 0;
  85. }
  86. }