Last active
December 29, 2022 03:55
-
-
Save merrilymeredith/749804c7bec32249f502f56377b3bede to your computer and use it in GitHub Desktop.
auto-brightness.pl - adjust windows desktop pc brightness based on rtsp traffic cam
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/strawberry/perl/bin/wperl.exe | |
=head1 NAME | |
auto-brightness.pl - adjust display brightness based on a nearby traffic cam | |
=head1 DESCRIPTION | |
ClickMonitorDDC is a really handy tool for desktop PCs, as you can set hotkeys | |
to adjust display brightness as conditions change. It gets a bit repetitive | |
through the day though, so in absence of a light sensor or local webcam, I used | |
a nearby traffic cam (thanks VDOT!) to get light samples and adjust | |
accordingly. | |
This script is set to run via wperl.exe in my task manager, every 30 minutes | |
through the day. It quietly tells ClickMonitorDDC to tweak display brightness | |
as needed. | |
=head1 ISSUES | |
My displays don't listen to DDC commands when asleep, which is fair, so | |
ClickMonitorDDC shows an incorrect number compared to the real backlight when | |
the displays wake up. Windows doesn't have an easy "no longer idle" hook and | |
I haven't moved on any of the wacky solutions to that you can find out there. | |
You can set up another task that triggers at unlock though, to run this script | |
with the extra arg 'refresh', to reassert the last brightness the script tried | |
to set. | |
=head2 HOTKEYS | |
Previously, I set Alt-Shift-Up/Down as hotkeys for brightness control in | |
ClickMonitorDDC itself, but then this script's sense of the current brightness | |
would be off -- my monitors don't respond to queries. I made shortcuts in my | |
Start menu that execute this script with up/down args and set my hotkeys on | |
those shortcuts. | |
The only annoyance with that is that this hotkey system is meant for launching | |
stuff so my current window loses focus if I use hotkeys, but it's way easier | |
than registering global hotkeys myself. | |
=head1 DEPENDENCIES | |
Strawberry Perl 5.24, ffmpeg, ClickMonitorDDC | |
=cut | |
use 5.024; | |
use warnings; | |
use strict; | |
use autodie ':all'; | |
use feature 'signatures'; | |
no warnings 'experimental::signatures'; | |
use GD; | |
use IPC::Cmd qw(can_run); | |
use List::Util qw(sum min max); | |
use Path::Tiny; | |
use Time::HiRes; | |
use Win32::Process; | |
# my $stream_url = 'rtsp://8.15.251.53:1935/rtplive/FairfaxVideo0530'; #I95 NB near pkwy | |
# my $stream_url = 'rtsp://8.15.251.53:1935/rtplive/FairfaxVideo0540'; #I95 NB near old keene mill | |
my $stream_url = 'rtsp://8.15.251.53:1935/rtplive/FairfaxVideo0520'; #I95 NB near newington | |
my $sample_low = 70; # min brightness here (of 255) | |
my $sample_high = 135; # max brightness here (of 255) | |
my $hk_step = 10; #hotkey step | |
GD::Image->trueColor(1); | |
my $tmp = Path::Tiny->tempdir; | |
my $DDC = path($ENV{USERPROFILE})->child('bin/ClickMonitorDDC.EXE'); | |
my $state = path("$0.state"); | |
sub main ($cmd = '') { | |
my $current = $state->touch->slurp // 20; | |
for ($cmd) { | |
/refresh/ and system "$DDC b$current", return; | |
/up/ and adjust($current, $current + $hk_step, 1), return; | |
/down/ and adjust($current, $current - $hk_step, 1), return; | |
} | |
adjust($current, backlight_value(get_sample_from(camera_capture()))); | |
} | |
# gradually change brightness | |
sub adjust ($from, $to, $immediate = 0) { | |
$to = clamp($to); | |
$from = $to if $immediate; | |
for my $step ($from <= $to ? ($from .. $to) : reverse($to .. $from)) { | |
system "$DDC b$step"; | |
} | |
continue { sleep 0.25 } | |
$state->spew($to); | |
} | |
sub clamp ($n, $min = 0, $max = 100) { | |
max(min($n, $max), $min); | |
} | |
# Get 5 frames, one per sec, return | |
sub camera_capture { | |
my $path = $tmp->child("sample-%d.png"); | |
run_hidden("ffmpeg -i $stream_url -rtsp_transport tcp -vframes 5 -vf fps=1 -loglevel fatal $path"); | |
$tmp->children(qr/^sample-\d+\.png$/); | |
} | |
# for all files, resample (a chunk from the top w/o the banner) down to 1px, | |
# get luminance, average out | |
sub get_sample_from (@files) { | |
sum( | |
map { | |
my $sample = GD::Image->new(1, 1); | |
$sample->copyResampled( | |
GD::Image->newFromPng("$_"), | |
0, 0, 5, 42, | |
1, 1, 311, 70, | |
); | |
my @rgb = $sample->rgb($sample->getPixel(0, 0)); | |
(min(@rgb) + max(@rgb)) / 2; | |
} @files | |
) / scalar(@files); | |
} | |
# Linear scale | |
sub backlight_value ($lum) { | |
# say sprintf 'luminance: %d / 255, %d%%', $lum, ($lum / 255 * 100); | |
int(($lum - $sample_low) / ($sample_high - $sample_low) * 100) | |
} | |
# Keep ffmpeg from popping a console window when we're running via wperl as | |
# a scheduled task. | |
sub run_hidden ($cmdline) { | |
my ($prog) = split /\s+/, $cmdline; | |
my $fullpath = can_run($prog) | |
or die "Can't find $prog in path"; | |
my ($proc, $code); | |
Win32::Process::Create($proc, $fullpath, $cmdline, 0, CREATE_NO_WINDOW, '.') | |
|| die "Failed to execute $cmdline"; | |
$proc->Wait(INFINITE); | |
$proc->GetExitCode($code); | |
$code == 0 | |
or die "$prog exited with failure $code"; | |
} | |
main(@ARGV); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment