vr.pl 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  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' => [
  12. { 'channel' => 12, 'value' => 0, 'time' => 0 },
  13. { 'channel' => 25, 'value' => 0, 'time' => 0 },
  14. { 'channel' => 66, 'value' => 0, 'time' => 0 },
  15. ],
  16. 'ON' => [
  17. { 'channel' => 12, 'value' => 255, 'time' => 0 },
  18. { 'channel' => 25, 'value' => 255, 'time' => 0 },
  19. { 'channel' => 66, 'value' => 255, 'time' => 0 },
  20. ],
  21. );
  22. # App config
  23. my $DATA_DIR = DMX::dataDir();
  24. my $STATE_SOCK = 'VR';
  25. my $OUTPUT_FILE = $DATA_DIR . $STATE_SOCK;
  26. my $PUSH_TIMEOUT = 20;
  27. my $PULL_TIMEOUT = $PUSH_TIMEOUT * 3;
  28. my $DELAY = $PULL_TIMEOUT / 2;
  29. # Debug
  30. my $DEBUG = 0;
  31. if ($ENV{'DEBUG'}) {
  32. $DEBUG = 1;
  33. }
  34. # State
  35. my $state = 'OFF';
  36. my $stateLast = $state;
  37. my $masterState = 'OFF';
  38. my %exists = ();
  39. my %mtime = ();
  40. my $pushLast = 0;
  41. my $pullLast = time();
  42. my $update = 0;
  43. # Always force the heater into OFF at launch
  44. $state = 'OFF';
  45. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  46. # Sockets
  47. DMX::stateSocket($STATE_SOCK);
  48. DMX::stateSubscribe($STATE_SOCK);
  49. # Loop forever
  50. while (1) {
  51. # Wait for state updates
  52. my $cmdState = DMX::readState($DELAY, \%exists, \%mtime, undef());
  53. # Avoid repeated calls to time()
  54. my $now = time();
  55. # Record only valid states
  56. if (defined($cmdState)) {
  57. $masterState = $cmdState;
  58. $pullLast = $now;
  59. }
  60. # Die if we don't see regular updates
  61. if ($now - $pullLast > $PULL_TIMEOUT) {
  62. die( 'No update on state socket in past '
  63. . $PULL_TIMEOUT
  64. . " seconds. Exiting...\n");
  65. }
  66. # Calculate the new state
  67. $stateLast = $state;
  68. if ($exists{'GAME'}) {
  69. $state = 'ON';
  70. } else {
  71. $state = 'OFF';
  72. }
  73. # Force updates on a periodic basis
  74. if (!$update && $now - $pushLast > $PUSH_TIMEOUT) {
  75. if ($DEBUG) {
  76. print STDERR "Forcing periodic update\n";
  77. }
  78. $update = 1;
  79. }
  80. # Force updates on any state change
  81. if (!$update && $stateLast ne $state) {
  82. if ($DEBUG) {
  83. print STDERR 'State change: ' . $stateLast . ' => ' . $state . "\n";
  84. }
  85. $update = 1;
  86. }
  87. # Update the DMX chain
  88. if ($update) {
  89. # Update
  90. DMX::applyDataset($DIM{$state}, $state, $OUTPUT_FILE);
  91. # Update the push time
  92. $pushLast = $now;
  93. # Clear the update flag
  94. $update = 0;
  95. }
  96. }