################################################################################
#
#  kPerl Core Library Group
#  Library for Graphics
#
#  copyright (c)
#    Karol Szafranski, 2004-2005
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 1998-1999, 2004
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @EXPORT
#
# - color definitions
#   %ColorLib
#   @ColorFlute
#   &ColorFormat
#
################################################################################

package MainLib::Graphics;

# includes
use strict; #use warnings;  # OK 20040810

# symbol export
use Exporter qw(import);
our @EXPORT = qw (
  %ColorLib @ColorFlute &ColorFormat
  );


################################################################################
# color definitions
################################################################################


# library of color definitions
#
our %ColorLib = (
  'white'     => [ 255, 255, 255 ],
  'black'     => [   0,   0,   0 ],
    'grey'       => [ 130, 130, 130 ],
    'grey90'     => [  20,  20,  20 ],
    'grey75'     => [  75,  75,  75 ],
    'grey50'     => [ 130, 130, 130 ],
    'grey25'     => [ 200, 200, 200 ],
    'grey10'     => [ 235, 235, 235 ],
  'red'       => [ 255,   0,   0 ],
  'orange'    => [ 230, 130,   0 ],
  'rose'      => [ 230, 150, 150 ],
  'yellow'    => [ 247, 174,   0 ],
  'green'     => [   0, 170,   0 ],
  'blue'      => [   0,   0, 255 ],
  'bluegreen' => [   0, 160, 125 ],
  'midblue'   => [  80,  80, 255 ],
  'lightblue' => [ 150, 150, 255 ],
  'violet'    => [ 130, 130, 255 ],
  'transparent'
              => [ 244, 244, 244 ],
  );


# useful flute of colors to use in parallel data display
#
# DESCRIPTION
# - The idea is to define an array of colors that are easily distinguishable
#   by eye.
#
our @ColorFlute = (
              ## first order rainbow
  '#404040',  # dark grey
  '#B00020',  # red
  '#A07000',  # dark yellow
  '#009030',  # green
  '#0060A0',  # blue
  '#9000A0',  # violet
              ## 2nd order rainbow
  '#B04000',  # orange
  # guess more !
  );


# return RGB code as reference to array of RGB ints
#
# INTERFACE
# - argument 1: color argument, which may itself be
#               - reference to array of RGB ints
#               - entry in color library
#               - hex code
#
# - options:
#   -debug      print debug report to STDERR
#   -format     output (and change) format
#               ArrayInt  array of RGB integers, either as an array directly or as
#                         a referenced array
#               hex       string of 24 bit RGB value in hexadecimal format
#
# - return val: either
#               - reference to rgb array
#               - wantarray: rgb array
#               - undef if an error occurred
#
sub ColorFormat {
  my ($ColorArg, %opt) = @_;
  my $debug = $opt{-debug};

  ####################################################################
  # convert color argument to reference on an array of RGB ints
  my ($pColor,$sColor);

  # we already have reference to array of RGB ints
  if (ref($ColorArg) eq 'ARRAY' and int(@$ColorArg)==3) {
    foreach (@$ColorArg) { if ($_<0 or $_>255) { return undef } }
    $pColor = $ColorArg;
  }

  # replace color name string by color array from dictionary
  elsif (exists ($ColorLib{$ColorArg})) { $pColor = $ColorLib{$ColorArg} }

  # parse hex encoded string
  elsif ($ColorArg =~ m/^#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/i) {
    $pColor = [ map{ hex } $1, $2, $3];
  }

  # unknown color argument
  else {
    die sprintf "%s. ERROR: unknown type of color argument '%s'\n", (caller(0))[3], $ColorArg;
  }

  # debug
  $debug and printf STDERR "%s. color argument %s => (%s)\n", (caller(0))[3],
    $ColorArg, join(',',@$pColor);

  ####################################################################
  # return requested data format

  # reformat
  if (0) { }
  elsif (!$opt{-format} or $opt{-format} eq 'ArrayInt') {
    if (wantarray) {
      return @$pColor;
    } else {
      return $pColor;
    }
  }
  elsif ($opt{-format} eq 'hex') {
    $sColor = sprintf ('#%02X%02X%02X', @$pColor);
    return $sColor;
  }
}


1;
# $Id: Graphics.pm,v 1.12 2018/06/05 18:02:56 szafrans Exp $
