File Coverage

blib/lib/Term/ExtendedColor/Xresources.pm

Criterion	Covered	Total	%
statement	24	94	25.5
branch	0	30	0.0
condition	0	3	0.0
subroutine	8	12	66.6
pod	4	4	100.0
total	36	143	25.1

#!/usr/bin/perl
package Term::ExtendedColor::Xresources;
use strict;
use warnings;

BEGIN {
  use Exporter;
  use vars qw($VERSION @ISA @EXPORT_OK);

  $VERSION = '0.080';
  @ISA     = qw(Exporter);
  @EXPORT_OK = qw(
    set_xterm_color
    get_xterm_color
    get_xterm_colors

    set_background_color
    set_foreground_color
  );
}

use Carp qw(croak);
use Term::ReadKey;

{
  no warnings;
  *get_xterm_color = *get_xterm_colors;
}

sub get_xterm_colors {
  my $arg = shift;

  my $index = (exists($arg->{index})) ? $arg->{index} :  [0 .. 255];

  my @indexes;

  if(ref($index) eq 'ARRAY') {
    push(@indexes, @{$index});
  }
  elsif(ref($index) eq '') {
    push(@indexes, $index);
  }

  if( grep { $_ < 0 } @indexes ) {
    croak("Index must be a value within 0 .. 255, inclusive\n");
  }

  open(my $tty, '<', '/dev/tty') or croak("Can not open /dev/tty: $!\n");

  my $colors;
  for my $i(@indexes) {
    next if not defined $i;

    ReadMode('raw', $tty);

    print "\e]4;$i;?\a"; # the '?' indicates a query

    my $response = '';
    my ($r, $g, $b);
    while(1) {
      if ($response =~ m[ rgb: (.{4}) / (.{4}) / (.{4}) ]x) {
        ($r, $g, $b) = map { substr $_, 0, 2 } ($1, $2, $3);
        last;
      }
      else {
        $response .= ReadKey(0, $tty);
      }
    }

    ReadMode('normal');

    $colors->{$i}->{raw} = $response;
    # Return in base 10 by default
    if($arg->{type} eq 'hex') {
      $colors->{$i}->{red}   = $r; # ff
      $colors->{$i}->{green} = $g;
      $colors->{$i}->{blue}  = $b;
      $colors->{$i}->{rgb}   = "$r$g$b";
    }
    else {
      ($r, $g, $b) = (hex($r), hex($g), hex($b));

      $colors->{$i}->{red}   = $r; # 255
      $colors->{$i}->{green} = $g;
      $colors->{$i}->{blue}  = $b;
      $colors->{$i}->{rgb}   = "$r/$g/$b"; # 255/255/0
    }

    $colors->{$i}{r} = $colors->{$i}{red};
    $colors->{$i}{g} = $colors->{$i}{green};
    $colors->{$i}{b} = $colors->{$i}{blue};
  }
  return $colors;
}

sub set_xterm_color {
  # color => index
  my $old_colors = shift;

  if(ref($old_colors) ne 'HASH') {
    croak("Hash reference expected");
  }

  my %new_colors;

  for my $index(keys(%{ $old_colors })) {
    if( ($index < 0) or ($index > 255) ) {
      next;
    }
    if($old_colors->{$index} !~ /^[A-Fa-f0-9]{6}$/) {
      next;
    }

    my($r, $g, $b) = $old_colors->{$index} =~ m/(..)/g;


    my $term = $ENV{TERM};

    # This is for GNU Screen and Tmux
    # Tmux identifies itself as GNU Screen
    # "\eP\e]4;198;rgb:50/20/40\a\e\\"

    # echo -e "\033]12;green\007" should change the cursor color, but inside of
    #  screen, you have to wrap all that with "\eP" and "\a\e\\"

    if($term =~ m/^screen/) {
      $new_colors{ $index } = "\eP\e]4;$index;rgb:$r/$g/$b\a\e\\";
    }
    else {
      $new_colors{ $index } = "\e]4;$index;rgb:$r/$g/$b\e\\"
    }
  }
  if(!defined( wantarray() )) {
    print for values %new_colors;
  }
  else {
    return \%new_colors;
  }
}

sub set_background_color {
  my $color = shift;
  $color =~ s/^#//g;

  my $esc = "\e]11;#$color\007";

  if(!defined( wantarray() )) {
    print $esc;
  }
  else {
    return $esc;
  }
}

sub set_foreground_color {
  my $color = shift;
  $color =~ s/^#//g;

  my $esc = "\e]10;#$color\007";

  if(!defined( wantarray() )) {
    print $esc;
  }
  else {
    return $esc;
  }
}

1;

__END__