#!/usr/athena/bin/perl
# Show various `ANSI' color character sequences.  For details, see
#     http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM

use warnings;
use strict;

use constant CSI => "\e[";

our @SEQ = qw(
    reset bold faint italic underline blink fastblink reverse hide crossout
    nofont font1 font2 font3 font4 font5 font6 font7 font8 font9
    fraktur dblunderline nocolor noitalic nounderline noblink RSVD26
        noreverse nohide nocrossout
    fg0 fg1 fg2 fg3 fg4 fg5 fg6 fg7 RSVD38 fgdefault
    bg0 bg1 bg2 bg3 bg4 bg5 bg6 bg7 RSVD48 bgdefault
    RSVD50 frame circle overline noframe nooverline
);
our %SEQCODE = map +($SEQ[$_], $_), 0..$#SEQ;

our @COLOR = qw( black red green yellow blue magenta cyan white );
our %COLORCODE = map +($COLOR[$_], $_), 0..$#COLOR;
our $COLOR_RE = join('|', @COLOR);

sub name2code ($) {
  my $name = lc $_[0];
  $name =~ s/[_\.]//g;
  $name =~ s/colour/color/g;
  $name =~ s/^(foreground|color)/fg/;
  $name =~ s/^background/bg/;

  return $SEQCODE{$name}   if exists $SEQCODE{$name};

  $name =~ s/^([fb]g)?(${COLOR_RE})$/$SEQCODE{($1 || 'fg').$COLORCODE{$2}}/e
    or die "Bad sequence name `$_[0]' ($name)";
  $name;
}

sub addseq (@) {
  my (@keys) = @_;
  @keys = split /\s+/, $keys[0] if @keys == 1;
  CSI . join(';', map name2code $_, grep length, @keys) . 'm';
}

sub seq (@) { @_ > 1 ? addseq('reset',@_) : addseq("reset @_"); }

our @tSEQ = grep !/^RSVD/, @SEQ;

for my $color (@COLOR) {
  printf "%-40s (and also %s %s, %s %s, %s %s, %s %s)\n",
    seq("bg$color").$color.seq()." missi".seq($color)."ssi".seq()."pi",
    seq("bold bg$color").'bold'.seq(),
    seq("bold $color").'bold'.seq(),
    seq("blink bg$color").'blink'.seq(),
    seq("blink $color").'blink'.seq(),
    seq("underline bg$color").'ul'.seq(),
    seq("underline $color").'ul'.seq(),
    seq("reverse bg$color").'rv'.seq(),
    seq("reverse $color").'rv'.seq();
}

print "\n";

for my $color (@COLOR) {
  printf "%-20s %s, %s, %s, %s...\n",
    $color.' on '.$color.':',
    seq("fg$color","bg$color").'normal'.seq(),
    seq("fg$color","bg$color",'bold').'bold'.seq(),
    seq("fg$color","bg$color",'blink').'blink'.seq(),
    seq("fg$color","bg$color",'bold','blink').'both'.seq();
}

print "\n";

sub testing (@) {
  print "testing ";
  my $pos = 8;
  for my $seq (@_) {
    (my $name = $seq) =~ s/\s+/+/g;
    ($pos += length($name) + 2) > 80
      and print("\r\n  "), $pos = length($name) + 4;
    print seq($seq), $name, seq(), ", ";
  }
  print "done!\n";
}

sub adding (@) {
  print "adding ";
  my $pos = 7;
  for my $seq (@_) {
    ($pos += length($seq) + 2) > 80
      and print("\r\n  "), $pos = length($seq) + 4;
    print addseq($seq), $seq, ", ";
  }
  print seq(), "done!\n";
}

print "\n";

testing @tSEQ;

print "\n\n";

adding @tSEQ;
print("\n"),
  adding sort { rand(2) < 1 ? -1 : 1 } @tSEQ
  for 1..0;

my($i);
print("\n"),
  testing map(($i=$_ and map("$tSEQ[$i] $tSEQ[$_]", ($i+1)..$#tSEQ)),
              1..($#tSEQ-1))
  if 1;
