bias.pl 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104
  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 $OUTPUT_FILE = $DATA_DIR . 'BIAS';
  19. my $STATE_SOCK = $OUTPUT_FILE . '.socket';
  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. # Sockets
  34. DMX::stateSocket($STATE_SOCK);
  35. DMX::stateSubscribe($STATE_SOCK);
  36. # State
  37. my $state = 'OFF';
  38. my $stateLast = $state;
  39. my %exists = ();
  40. my $pushLast = 0;
  41. my $pullLast = time();
  42. my $update = 0;
  43. # Always force lights out at launch
  44. DMX::dim({ 'channel' => 12, 'value' => 0, 'time' => 0 });
  45. # Loop forever
  46. while (1) {
  47. # State is calculated; use newState to gather data
  48. my $newState = $state;
  49. # Wait for state updates
  50. my $cmdState = DMX::readState($DELAY, \%exists, undef(), \%VALID);
  51. if (defined($cmdState)) {
  52. $newState = $cmdState;
  53. $pullLast = time();
  54. }
  55. # Die if we don't see regular updates
  56. if (time() - $pullLast > $PULL_TIMEOUT) {
  57. die('No update on state socket in past ' . $PULL_TIMEOUT . " seconds. Exiting...\n");
  58. }
  59. # Accept the new state directly
  60. $stateLast = $state;
  61. $state = $newState;
  62. # Force updates on a periodic basis
  63. if (!$update && time() - $pushLast > $PUSH_TIMEOUT) {
  64. if ($DEBUG) {
  65. print STDERR "Forcing periodic update\n";
  66. }
  67. $update = 1;
  68. }
  69. # Force updates on any state change
  70. if (!$update && $stateLast ne $state) {
  71. if ($DEBUG) {
  72. print STDERR 'State change: ' . $stateLast . ' => ' . $state . "\n";
  73. }
  74. $update = 1;
  75. }
  76. # Update the lighting
  77. if ($update) {
  78. # Update
  79. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  80. # Update the push time
  81. $pushLast = time();
  82. # Clear the update flag
  83. $update = 0;
  84. }
  85. }