detect-bg.pl

use v5.20.0;

use Term::ReadKey ();

sub terminal_bg_info {
  syswrite *STDOUT, "\e]11;?\007";

  # Example response:
  # ^[]11;rgb:00/00/00^G^[]11;rgb:00/00/00^G
  #
  # Remember, we can get more than one response back, so our strategy will be…
  #
  # Expect \e
  # Expect ]n; where n is the OSC Ps we sent (11 for bg)
  # Expect rgb:../../..
  # Expect \a
  #
  # …then either we get another \e and GOTO 10 or we are done and we ungetc!

  Term::ReadKey::ReadMode('raw');

  my $light;
  my $dark;
  my %saw_rgb;

  CHAR: while (1) {
    last CHAR unless sysread(*STDIN, my $esc, 1);
    unless ($esc eq "\e") { STDIN->ungetc($esc); last CHAR; }

    last CHAR unless sysread(*STDIN, my $brack, 1);
    unless ($brack eq "]") { STDIN->ungetc($brack); last CHAR; }

    last CHAR unless sysread(*STDIN, my $rgb, 15);

    my ($r, $g, $b) = map { hex } ($rgb =~ m{\A11;rgb:(..)/(..)/(..)});

    $dark  = 1 if $r < 100 && $g < 100 && $b < 100;
    $light = 1 if $r > 200 && $g > 200 && $b > 200;

    $saw_rgb{ sprintf '#%02x%02x%02x', $r, $g, $b } = 1;

    last CHAR unless sysread(*STDIN, my $bel, 1);
    unless ($bel eq "\a") { STDIN->ungetc($bel); last CHAR; }

    my $next = Term::ReadKey::ReadKey(-1);
    STDIN->ungetc($next);
    last unless $next eq "\e";
  }

  Term::ReadKey::ReadMode('normal');

  my $tint = (  $dark && ! $light)  ? 'dark'
           : (! $dark &&   $light)  ? 'light'
           : (  $dark &&   $light)  ? 'ambiguous'
           :                          'unknown';

  return {
    tint => $tint,
    backgrounds => [ sort keys %saw_rgb ],
  };
}

my $bg_info = terminal_bg_info();

say "Terminal background: " . $bg_info->{tint};
say "Terminal background color(s): " . join q{ }, $bg_info->{backgrounds}->@*;