Skip to content

Instantly share code, notes, and snippets.

@merrilymeredith
Last active December 29, 2022 03:55
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save merrilymeredith/749804c7bec32249f502f56377b3bede to your computer and use it in GitHub Desktop.
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
#!/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