#!/usr/bin/perl

package App::TerminalColours;

use v5.26;
use warnings;
no warnings qw(experimental::signatures);
use feature qw(signatures);

use Digest::MD5;
use Getopt::Long;
use Sys::Hostname qw(hostname);

use version; our $VERSION = version->declare('0.7.0');

my %opt = (
    'background' => !!1,
    'palette' => !!1,
);
my $theme = 'tango';
my %colours = (
    'tango' => [
        [0x2e2e, 0x3434, 0x3636],
        [0xcccc, 0x0000, 0x0000],
        [0x4e4e, 0x9a9a, 0x0606],
        [0xc4c4, 0xa0a0, 0x0000],
        [0x3434, 0x6565, 0xa4a4],
        [0x7575, 0x5050, 0x7b7b],
        [0x0606, 0x9898, 0x9a9a],
        [0xd3d3, 0xd7d7, 0xcfcf],
        [0x5555, 0x5757, 0x5353],
        [0xefef, 0x2929, 0x2929],
        [0x8a8a, 0xe2e2, 0x3434],
        [0xfcfc, 0xe9e9, 0x4f4f],
        [0x7272, 0x9f9f, 0xcfcf],
        [0xadad, 0x7f7f, 0xa8a8],
        [0x3434, 0xe2e2, 0xe2e2],
        [0xeeee, 0xeeee, 0xecec],
    ],
);
my $osc = "\e]";
my $st = "\e\\";

unless ( caller() ) {
    run(@ARGV);
    exit;
}


sub run (@argv) {
    Getopt::Long::Configure('bundling');
    Getopt::Long::GetOptionsFromArray(
        \@argv,
        'B' => sub { $opt{'background'} = !!0 },
        'P' => sub { $opt{'palette'} = !!0 },
        'background|bg|b!' => \$opt{'background'},
        'dry-run|n' => \$opt{'dry_run'},
        'help|h' => \$opt{'help'},
        'is-dark|D' => \$opt{'is_dark'},
        'is-light|L' => \$opt{'is_light'},
        'man' => \$opt{'man'},
        'osc!' => sub { $opt{'xrdb'} = not $_[1] },
        'palette|p!' => \$opt{'palette'},
        'verbose|v' => \$opt{'verbose'},
        'xrdb|x!' => \$opt{'xrdb'},
    ) or return pod2usage(-verbose => 0);
    return pod2usage(-verbose => 1) if $opt{'help'};
    return pod2usage(-verbose => 2) if $opt{'man'};
    return pod2usage(-verbose => 0) if $opt{'is_dark'} and $opt{'is_light'};
    return pod2usage(-verbose => 0)
        if ($opt{'is_dark'} or $opt{'is_light'}) and @argv > 1;

    if ( $opt{'xrdb'} ) {
        return pod2usage( -verbose => 0 ) unless @argv;
        override_xterm_resources(@argv);
    }
    else {
        return pod2usage( -verbose => 0 ) if @argv > 1;
        send_control_sequences(@argv);
    }
}

sub send_control_sequences ($host = undef) {
    $host = hostname() unless defined($host);

    my ($is_dark, $bg) = colour_hash($host);
    my $fg = fg($is_dark);

    unless ( $opt{'dry_run'} ) {
        if ( $opt{'palette'} ) {
            if ( $is_dark ) {
                # Colours for a dark background and a light foreground:
                for my $i ( 0..15 ) {
                    print osc_ansi_string($i, $colours{$theme}->[$i]);
                }
            }
            else {
                # Colours for a light background and a dark foreground:
                for my $i ( 0..7 ) {
                    print osc_ansi_string($i, $colours{$theme}->[$i + 8]);
                    print osc_ansi_string($i + 8, $colours{$theme}->[$i]);
                }
            }
        }

        if ( $opt{'background'} ) {
            print osc_fg_string($fg);
            print osc_bg_string($bg);
        }
    }

    warn 'Background: ', ($is_dark ? 'dark' : 'light'), "\n" if $opt{'verbose'};

    exit 1 if $opt{'is_dark'} and not $is_dark;
    exit 1 if $opt{'is_light'} and $is_dark;
}

sub osc_fg_string ($values) {
    if ( is_putty() ) {
        return osc_ansi_string(16, $values).
            osc_ansi_string(17, $values).
            osc_ansi_string(20, $values).
            osc_ansi_string(21, $values);
    }
    elsif ( is_linux() ) {
        return osc_ansi_string(7, $values),
            osc_ansi_string(15, $values);
    }
    else {
        return $osc. '10;'. rgb_string($values). $st.
            $osc. '12;'. rgb_string($values). $st;
    }
}

sub osc_bg_string ($values) {
    if ( is_putty() ) {
        return osc_ansi_string(18, $values).
            osc_ansi_string(19, $values);
    }
    elsif ( is_linux() ) {
        return osc_ansi_string(0, $values),
            osc_ansi_string(8, $values);
    }
    else {
        return $osc. '11;'. rgb_string($values). $st;
    }
}

sub osc_ansi_string ($index, $values) {
    if ( is_putty() or is_linux() ) {
        my $short_values = [ map { $_ >> 8 } @$values ];
        if ( $index < 16 ) {
            return sprintf '%sP%1x%02x%02x%02x', $osc, $index, @$short_values;
        }
        else {
            return sprintf '%sP%1s%02x%02x%02x', $osc, chr(55 + $index),
                @$short_values;
        }
    }
    else {
        return sprintf '%s4;%d;%s%s', $osc, $index, rgb_string($values),
            $st
    }
}

sub rgb_string ($values) {
    return sprintf "rgb:%04x/%04x/%04x", @$values;
}

sub is_putty () {
    return scalar($ENV{'TERM'} =~ m/\bputty\b/);
}

sub is_linux () {
    return scalar($ENV{'TERM'} =~ m/\blinux\b/);
}

sub override_xterm_resources (@hosts) {
    my $is_dark;

    open my $xrdb, '|-', qw(xrdb -override)
        or die "Couldn't open xrdb: $!";

    foreach my $host ( @hosts ) {
        my $bg;
        ($is_dark, $bg) = colour_hash($host);
        my $fg = fg($is_dark);

        unless ( $opt{'dry_run'} ) {
            print $xrdb "\n";
            if ( $opt{'background'} ) {
                print $xrdb
                    "xterm-$host*vt100*background:\t", rgb_string($bg), "\n",
                    "xterm-$host*vt100*foreground:\t", rgb_string($fg), "\n",
                    "xterm-$host*vt100*cursorColor:\t", rgb_string($fg), "\n";
            }

            if ( $opt{'palette'} ) {
                if ( $is_dark ) {
                    # Colours for a dark background and a light foreground:
                    for my $i ( 0..7 ) {
                        say $xrdb 'xterm-'. $host. '*vt100*color'. $i.
                            ":\t". rgb_string($colours{$theme}->[$i]);
                        say $xrdb 'xterm-'. $host. '*vt100*color'. ($i + 8).
                            ":\t". rgb_string($colours{$theme}->[$i + 8]);
                        say $xrdb 'xterm-'. $host. '*vt100*textColor'. $i.
                            ":\t". rgb_string($colours{$theme}->[$i + 8]);
                    }
                }
                else {
                    # Colours for a light background and a dark foreground:
                    for my $i ( 0..7 ) {
                        say $xrdb 'xterm-'. $host. '*vt100*color'. ($i + 8).
                            ":\t". rgb_string($colours{$theme}->[$i]);
                        say $xrdb 'xterm-'. $host. '*vt100*color'. $i.
                            ":\t". rgb_string($colours{$theme}->[$i + 8]);
                        say $xrdb 'xterm-'. $host. '*vt100*textColor'. $i.
                            ":\t". rgb_string($colours{$theme}->[$i]);
                    }
                }
            }
        }
    }

    close $xrdb or die "Error on closing xrdb: $!";

    exit 1 if $opt{'is_dark'} and not $is_dark;
    exit 1 if $opt{'is_light'} and $is_dark;

    return 1;
}

sub colour_hash ($host) {
    my $digest = Digest::MD5->new;
    $digest->add( $host );
    my $hex = $digest->hexdigest;
    
    $hex =~ m/
                 ^
                 ([[:xdigit:]]{4})
                 ([[:xdigit:]]{4})
                 ([[:xdigit:]]{4})
                 ([[:xdigit:]])
             /x;
    my $is_dark = (hex($4) > 16 * 0.33); # 1/3 light, 2/3 dark.
    my $r = ($is_dark ? 0x1fff : 0xc000 ) + ( hex($1) >> 2 );
    my $g = ($is_dark ? 0x1fff : 0xc000 ) + ( hex($2) >> 2 );
    my $b = ($is_dark ? 0x1fff : 0xc000 ) + ( hex($3) >> 2 );
    
    return ($is_dark, [$r, $g, $b]);
}

sub fg ($is_dark) {
    return($is_dark ? [0xeeee, 0xeeee, 0xecec] : [0, 0, 0]);
}

sub pod2usage {
    require Pod::Usage;
    return Pod::Usage::pod2usage( @_ );
}


__END__

=head1 NAME

B<termcolours> - Automatically set unique terminal colour schemes

=head1 SYNOPSIS

termcolours [B<--osc>] [B<-P>|B<-p>] [B<-B>|B<-b>] [B<-D>|B<-L>] [B<-n>] [B<-v>] [I<hostname>]

termcolours B<--xrdb> [B<-P>|B<-p>] [B<-B>|B<-b>] [B<-D>|B<-L>] [B<-n>] [B<-v>] I<hostname> ...;
alias xterm="xterm -name xterm-`hostname`"

=head1 DESCRIPTION

Give terminals a persistent unique background colour, generated from the hostname (or some other string of your choosing).  Set the sixteen ANSI colours to contrast with the background, using shades from the Tango palette.

=head1 OPTIONS

=over 4

=item I<hostname>

The terminal background colour will be set based on a hash of the string I<hostname>, somewhere between 0x000000 (black) and 0x404040 (dark), or 0xc0c0c0 (light) and 0xffffff (white).  Foreground colours are selected to contrast with the background.

Defaults to the current system hostname, if not specified.

=item B<--dry-run>, B<-n>

Don't actually change the terminal colour.

=item B<--palette>, B<-p>

=item B<--no-palette>, B<-P>

Set (or don't set) the palette of 16 ANSI colours.  The default is to set them.

=item B<--background>, B<--bg>, B<-b>

=item B<--no-background>, B<--no-bg>, B<-B>

Set (or don't set) the background colour and contrasting foreground colour.  The default is to set them.

=item B<--is-dark>, B<-D>

Exit 1 if the terminal is set to having a light background.

=item B<--is-light>, B<-L>

Exit 1 if the terminal is set to having a dark background.

=item B<--osc>

Set the colour scheme for the current terminal, by sending it control sequences.

This is the default behaviour.

=item B<--xrdb>, B<-x>

Set the colour scheme for C<xterm>s started in the future, via X11 resources of the form C<XTerm-{argument}*vt100*foreground> and C<XTerm-{argument}*vt100*background>.

You must tell C<xterm> which resource to look at, with something like:

    xterm -name "xterm-$HOSTNAME"

=item B<--verbose>, B<-v>

Be more chatty.

=item B<--help>, B<-h>

Displays brief help.

=item B<--man>

Displays the full manual.

=back

=head1 EXAMPLES

=head2 Set the prompt colour depending on the terminal colour

Add something like the following to your F<~/.bash_profile>:

    if termcolours --is-dark; then
        prompt_colour='37;40'
    else
        prompt_colour='30;47'
    fi
    PS1="\[\033[0;${prompt_colour}m\]\h:\W\\$\[\033[0m\] "

For a list of potential colour codes you could use here, see the Wikipedia page L<ANSI escape code|https://en.wikipedia.org/wiki/ANSI_escape_code#3-bit_and_4-bit>.

=head2 Set the background colour for a container, without having to install C<termcolours> inside the container

Add the following to your F<~/.bashrc>:

    function docker {
        __termcolours_then_container "$FUNCNAME" "$@"
    }
    function podman {
        __termcolours_then_container "$FUNCNAME" "$@"
    }
    function __termcolours_then_container {
        declare -a args=("$@")

        if [[ "${args[1]}" == 'exec' || "${args[1]}" == 'run' ]]; then
            local arg
            local rc

            shift 2
            for arg in "$@"; do
                if [[ "$arg" != -* ]]; then
                   termcolours "$arg"
                   break
                fi
            done
        fi

        command "${args[@]}"
        rc=$?

        if [[ "${args[1]}" == 'exec' || "${args[1]}" == 'run' ]]; then
            termcolours
        fi

        return $rc
    }

=head1 COMPATIBILITY

The following terminal emulators are known to work.

=head2 Using OSC escape sequences

=head3 Full support

=over 4

=item

L<Ghostty|https://ghostty.org/>

=item

L<GNOME Console|https://apps.gnome.org/Console/>

=item

L<GNOME Terminal|https://gitlab.gnome.org/GNOME/gnome-terminal>

=item

L<Guake|https://guake.github.io/>

=item

L<kitty|https://sw.kovidgoyal.net/kitty/>

=item

L<PuTTY|https://www.chiark.greenend.org.uk/~sgtatham/putty/> (provided that environment variable C<TERM> is set to C<putty>)

=item

L<rxvt-unicode|http://software.schmorp.de/pkg/rxvt-unicode.html>

=item

L<st|https://st.suckless.org/>

=item

L<Termux|https://termux.dev/>

=item

L<Xfce Terminal|https://docs.xfce.org/apps/terminal/start>

=item

L<XTerm|https://invisible-island.net/xterm/> (except very old versions, of the kind you may get with a proprietary Unix)

=back

=head3 Partial support

=over 4

=item

The L<Linux console|https://en.wikipedia.org/wiki/Linux_console>

=back

=head2 Using X11 resources

=over 4

=item

XTerm (any version)

=back

=head1 SEE ALSO

=over 4

=item

L<https://www.mavit.org.uk/termcolours/>

=item

L<xrdb(1)>

=item

L<xterm(1)>

=item

L<X11 resources|https://www.x.org/releases/current/doc/man/man7/X.7.xhtml#heading14>

=back

=head1 AUTHOR

L<Peter Oliver|mailto:terminalcolours@mavit.org.uk>

=head1 LICENCE

Copyright 2008, 2017, 2024-2025 Peter Oliver.

This program is part of B<termcolours>.

B<termcolours> is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

B<termcolours> is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with termcolours. If not, see L<https://www.gnu.org/licenses/>.

=cut
