# -*- CPERL -*-

# /=====================================================================\ #

# | xcolor.sty | #

# | Implementation for LaTeXML | #

# |=====================================================================| #

# | Part of LaTeXML: | #

# | Public domain software, produced as part of work done by the | #

# | United States Government & not subject to copyright in the US. | #

# |---------------------------------------------------------------------| #

# | Thanks to Silviu Vlad Oprea <s.oprea@jacobs-university.de> | #

# | of the arXMLiv group for initial implementation | #

# | http://arxmliv.kwarc.info/ | #

# | Released under the Gnu Public License | #

# | Released to the Public Domain | #

# |---------------------------------------------------------------------| #

# | Bruce Miller <bruce.miller@nist.gov> #_# | #

# | http://dlmf.nist.gov/LaTeXML/ (o o) | #

# \=========================================================ooo==U==ooo=/ #

package LaTeXML::Package::Pool;

use strict;

use warnings;

use LaTeXML::Package;

use List::Util qw(min max);

RequirePackage('color');

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Options & Initializations.

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Setting target color model (ignored for now)

foreach my $option (qw(natural rgb cmy cmyk hsb gray RGB HTML HSB Gray monochrome)) { #mono???

DeclareOption($option, sub { }); }

# Ignorable options

foreach my $option (qw(showerrors hideerrors fixpdftex prologue

kernelfbox xcdraw noxcdraw fixinclude

dviwindo oztex xdvi

usenames)) { # which does... what?

DeclareOption($option, sub { }); }

# Loading sets of names

DeclareOption('dvipsnames', sub { InputDefinitions('dvipsnam', type => 'def'); return; });

DeclareOption('dvipsnames*', sub { InputDefinitions('dvipsnam', type => 'def'); return; });

DeclareOption('svgnames', sub { InputDefinitions('svgnam', type => 'def'); return; });

DeclareOption('svgnames*', sub { InputDefinitions('svgnam', type => 'def'); return; });

DeclareOption('x11names', sub { InputDefinitions('x11nam', type => 'def'); return; });

DeclareOption('x11names*', sub { InputDefinitions('x11nam', type => 'def'); return; });

# Load colortbl package;

DeclareOption('table', sub { RequirePackage('colortbl'); return; });

# Does this load hyperref, or modify it? - TODO??

DeclareOption('hyperref', sub { });

DefMacro('\GetGinDriver', '');

DefMacro('\GinDriver', 'LaTeXML');

DefRegister('\tracingcolors' => Number(0));

DefMacro('\XC@tracing', '0');

DefConditional('\ifglobalcolors', undef);

DefConditional('\ifdefinecolors', undef);

DefConditional('\ifconvertcolorsD', undef);

DefConditional('\ifconvertcolorsU', undef);

DefConditional('\ifblendcolors', undef);

DefConditional('\ifmaskcolors', undef);

DefConditional('\ifxglobal@', undef);

RawTeX('\globalcolorsfalse\definecolorstrue');

# Start with "current color" (using the shorthand ".") to black

AssignValue('color_.' => Black());

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Extra Color Models

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

sub delta {

my ($v, $n) = @_;

return ($v <= ($n + 1) / 2 ? $v / ($n + 1) : ($v + 1) / ($n + 1)); }

#======================================================================

# RGB: red,green,blue integers in 0..L, L = 255 by default

DefMacroI('\rangeRGB', undef, '255');

DefColorModel('RGB', 'rgb',

sub { # RGB ==> rgb

my $L = ToString(Expand(T_CS '\rangeRGB'));

Color('rgb', map { delta($_, $L) } $_[0]->components); },

sub { # rgb ==> RGB

my $L = ToString(Expand(T_CS '\rangeRGB'));

Color('RGB', map { int($_ * $L + 0.5) } $_[0]->components); });

#======================================================================

# HTML = RRGGBB where RR,GG,BB are red,green,blue components in hex

DefColorModel('HTML', 'rgb',

sub { # HTML ==> rgb

if ($_[0][1] =~ m/(..)(..)(..)/) {

Color('rgb', map { delta(hex($_), 255) } $1, $2, $3); } },

sub {

my $hex = $_[0]->toHex; $hex =~ s/^#//;

Color('HTML', $hex); });

#======================================================================

# Hsb: h in 0..H, s,b in 0..1, H = 360 by default

DefMacroI('\rangeHsb', undef, '360');

DefColorModel('Hsb', 'hsb',

sub { # Hsb ==> hsb

my $H = ToString(Expand(T_CS '\rangeHsb'));

Color('hsb', $_[0][1] / $H, $_[0][2], $_[0][3]); },

sub { # hsb ==> Hsb

my $H = ToString(Expand(T_CS '\rangeHsb'));

Color('Hsb', $H * $_[0][1], $_[0][2], $_[0][3]); });

#======================================================================

# HSB: h,s,b in 0..M, M = 240 by default

DefMacroI('\rangeHSB', undef, '240');

DefColorModel('HSB', 'hsb',

sub { # HSB ==> hsb

my $M = ToString(Expand(T_CS '\rangeHSB'));

Color('hsb', delta($_[0][1], $M), delta($_[0][2], $M), delta($_[0][3], $M)); },

sub { # hsb ==> HSB

my $M = ToString(Expand(T_CS '\rangeHSB'));

Color('HSB', map { int(0.5 + $M * $_) } $_[0][1], $_[0][2], $_[0][3]); });

#======================================================================

# "tuned" or Piecewise continuous Hsb

# \rangetHsb is sequence of pairs x,y (; x,y)*

DefMacroI('\rangetHsb', undef, '60,30;120,60;180,120;210,180;240,240');

DefColorModel('tHsb', 'hsb',

sub { # tHsb ==> hsb

my ($model, $h, $s, $b) = @{ $_[0] };

my $H = ToString(Expand(T_CS '\rangeHsb'));

# my $rangetHsb = '0,0;'.ToString(Expand T_CS '\rangetHsb').';'.$H.','.$H;

my $rangetHsb = ToString(Expand T_CS '\rangetHsb') . ';' . $H . ',' . $H;

my ($xn, $yn, $xn_1, $yn_1) = (0, 0, 0, 0);

foreach (split(';', $rangetHsb)) {

($xn_1, $yn_1) = ($xn, $yn);

($xn, $yn) = split(',', $_);

last if $h <= $xn; }

Color('hsb', ($yn_1 + (($yn - $yn_1) / ($xn - $xn_1)) * ($h - $xn_1)) / $H, $s, $b); },

sub { # hsb ==> tHsb

my ($model, $h, $s, $b) = @{ $_[0] };

# First scale Hue.

my $H = ToString(Expand(T_CS '\rangeHsb'));

$h *= $H;

my $rangetHsb = ToString(Expand T_CS '\rangetHsb') . ';' . $H . ',' . $H;

my ($xn, $yn, $xn_1, $yn_1) = (0, 0, 0, 0);

foreach (split(';', $rangetHsb)) {

($xn_1, $yn_1) = ($xn, $yn);

($xn, $yn) = split(',', $_);

# last if $h >= $yn_1 && $h <= $yn; }

last if $h <= $yn; }

Color('tHsb', $xn_1 + (($xn - $xn_1) / ($yn - $yn_1)) * ($h - $yn_1), $s, $b); });

#======================================================================

DefMacroI('\rangeGray', undef, '15');

DefColorModel('Gray', 'gray',

sub { # Gray ==> gray

my $N = ToString(Expand(T_CS '\rangeGray'));

Color('gray', delta($_[0][1], $N)); },

sub { # gray ==> Gray

my $N = ToString(Expand(T_CS '\rangeGray'));

Color('Gray', int(0.5 + $N * $_[0][1])); });

#======================================================================

DefColorModel('wave', 'hsb',

sub { # wave ==> hsb

my ($model, $lambda) = @{ $_[0] };

my $g = 1; # fixed correction number; xcolor uses 1; pstricks uses others (e.g. 0.8).

# anyway, no significant difference can be notified.

local *eta = sub {

my ($x) = @_;

min(1, max(0, $x))**$g; };

my ($h, $bb);

if ($lambda < 440) { $h = 4 + eta(($lambda - 440) / (-60)); }

elsif ($lambda < 490) { $h = 4 - eta(($lambda - 440) / 50); }

elsif ($lambda < 510) { $h = 2 + eta(($lambda - 510) / (-20)); }

elsif ($lambda < 580) { $h = 2 - eta(($lambda - 510) / 70); }

elsif ($lambda < 645) { $h = eta(($lambda - 645) / (-65)); }

else { $h = 0; }

if ($lambda < 420) { $bb = eta(0.3 + 0.7 * ($lambda - 380) / 40); }

elsif ($lambda < 700) { $bb = 1; }

else { $bb = eta(0.3 + 0.7 * ($lambda - 780) / (-80)); }

Color('hsb', $h / 6, 1, $bb); },

sub {

Error(); });

#======================================================================

DefMacro('\adjustUCRBG', '1,1,1,1'); # ??

DefMacro('\paperquality', '1');

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Specifying colors

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Decoding colors etc.

# Several kinds of target forms of color.

# We COULD assume HTML model (the rest of latexml sorta does) "#RRGGBB"

# OR we could assume rgb, ('rgb',r,g,b)

# OR we could assume converted to any core model: (model,components,...)

###our $TARGET_COLOR_MODEL = 'rgb';

our $TARGET_COLOR_MODEL = '';

# ParseXColor(<model_list>,<spec_list_or_color_expr>, <tomodel>);

# If <model_list> is non-empty, then treat it as a list of models (separated by '/')

# choose the current target model, or the 1st model if none match the current one

# then find the corresponding spec in <spec_list> (also separated by '/')

# if<model_list> was prefixed with <model>:, convert result to that model.

# Otherwise,

# treat <spec_list_or_color_expr> as a color expression.

# evaluate it.

# if <tomodel> is non-null,

# convert the final result to that model

sub ParseXColor {

my ($models, $specs, $tomodel) = @_;

$models = ToString($models) if ref $models;

$specs = ToString($specs) if ref $specs;

$tomodel = ToString($tomodel) if ref $tomodel;

my $color;

if ($models) { # If models given, it's in form: (tomodel:)? model (,model)*

if ($models =~ s/^(.*?)://) {

$tomodel = $1 unless $tomodel; }

my @models = split(/\//, $models);

my @specs = split(/\//, $specs);

if (scalar(@models) != scalar(@specs)) {

Error('unexpected', $specs, $STATE->getStomach,

"Length of color model_list must be same as spec_list.",

"models is '$models'; specs is '$specs'");

return Black(); }

my ($model, $spec) = ($models[0], $specs[0]);

while (@models) {

if ($models[0] eq $TARGET_COLOR_MODEL) {

($model, $spec) = ($models[0], $specs[0]); last; }

shift(@models); shift(@specs); }

# Now, parse the spec relative to the chosen model

$spec =~ s/^\s+//; $spec =~ s/\s+$//;

if ($spec =~ /^\{\s*(.*?)\s*\}$/) { # Trim

$spec = $1; }

if ($model eq 'named') {

$color = LookupColor($spec); }

else {

$color = Color($model, ($spec =~ /,/ ? split(/\s*,\s*/, $spec) : split(/\s+/, $spec)))->toCore; } }

else {

$color = DecodeColor($specs); }

# And finally convert to the target model, if requested.

return ($tomodel ? $color->convert($tomodel) : $color); }

#======================================================================

# Given a <colorexpr>

# (<name>|<expression>|<extended_expression>) <functional_expression>*

# decode it into ($model,@spec) form

# NOTE: Clean up this code....

sub DecodeColor {

my ($expression) = @_;

$expression = ToString($expression);

my $prefix_re = qr/-/; #

# [ <name> = . ==> current color; <name> = '' ==> white]

my $name_re = qr/|[-]*\.|[-]*[a-zA-Z0-9@\*]+/;

my $ne_name_re = qr/[-]*\.|[-]*[a-zA-Z0-9@\*]+/;

my $pct_re = qr/(?:\d*\.?\d*|[+-]*\d+\.?\d*|[+-]*\d*\.?\d+)/;

my $pct_capture_re = qr/(\d*\.?\d*|[+-]*\d+\.?\d*|[+-]*\d*\.?\d+)/;

# <mix_expr> : !<pct1>!<name1>!...<pctn>!(<namen>)?

my $mix_expr_re = qr/!$pct_re(?:!$name_re!$pct_re)*(?:!$name_re)?/;

# <postfix> -> |!!<plus>|!![<num>]

my $postfix_re = qr/!!(?:\++|\[\d+\])/;

# <expr> : <prefix><ne_name><mix_expr><postfix>

my $expr_re = qr/($prefix_re*)($ne_name_re)

($mix_expr_re)?($postfix_re)?/x; # 4 inner groups

my $core_model_re = qr/rgb|cmy|cmyk|hsb|gray/;

# PGF flaw here; don't allow div to be empty

my $div_re = qr/[+-]*(?:\d*[1-9]+\d*(?:\.\d*)?|\d*\.\d*[1-9]+\d*)/;

my $div_capture_re = qr/[+-]*(\d*[1-9]+\d*(\.\d*)?|\d*\.\d*[1-9]+\d*)/;

my $dec_re = qr/[+-]*(?:\d*\.?\d*)/;

# <ext_expr> : <core_model>,<div>:<expr1><dec1>;...;<exprk><deck>

# | <core_model>:<expr1><dec1>;...;<exprk><deck>

my $ext_expr_re = qr/($core_model_re)(,($div_re))?:

(($expr_re|$name_re),$dec_re(?:;(?:$expr_re|$name_re),$dec_re)*)/x;

# <color_expr> : <name> | <expr> | <ext_expt>

my $color_expr_re = qr/$expr_re|$ext_expr_re/;

my $function_re = qr/wheel|twheel/;

my $arg_re = $div_re;

# <func_expr> : ><function>,<arg1>,...,<argj>

my $func_expr_re = qr/>$function_re,(?:$arg_re|$arg_re,$arg_re)/;

# <color> : <color_expr><func_expr1>...<func_expri>

my $color_re = qr/($color_expr_re)(($func_expr_re)*)/;

my $color;

if ($expression =~ /^$color_re$/) {

#DG: Dear reader, I present to you: maintenance hell:

my $prefix = $2 || $10;

my $name = $3 || $11;

my $mix_expr = $4 || $12;

my $postfix = $5 || $13;

my $core_model = $6;

my $div = $8;

my $exprs = $9;

my $func_expr = $19;

my @pallete = ();

if (defined $core_model) { # Extended color expression: combine colors as on a pallete

$color = Black->convert($core_model);

my $dectot = 0;

while ($exprs =~ s/($expr_re),($dec_re)//) {

my $dec = $6; $dec =~ s/--//g;

next if !$dec || $dec eq '.'; # the contribution is 0!

$dectot += $dec;

push(@pallete, [DecodeColor($1), $dec]); }

$div = $dectot unless $div;

foreach my $cp (@pallete) {

$color = $color->add($$cp[0]->scale($$cp[1] / $div)); } }

else { # Standard Color Expression: <prefix><name><mix_expr><postfix>

$color = ($postfix && ($postfix =~ /!!\[(\d+)\]/) # Note "out-of-order" effect!

? indexColorSeries($name, $1)

: LookupXColor($name));

if (my $blend = LookupValue('color_blend')) { # Combine any stored blend with the mix_expr.

$mix_expr .= $blend; }

if ($mix_expr) {

while ($mix_expr =~ s/^!([^!]*)(!([^!]*))?//x) {

my ($nm, $pct) = ($3 || 'white', $1);

$pct =~ s/--//g; $pct = ($pct eq '' ? 100 : ($pct eq '.' ? 0 : $pct));

$color = $color->mix(LookupXColor($nm), max(0, min(100, $pct)) / 100); } }

$color = $color->complement if $prefix && (length($prefix) % 2);

if ($postfix && ($postfix =~ /^!!(\++)$/)) {

stepColorSeries($name, length($1)); } } # Step the series, but no effect on color

# Now apply any function expressions to the result.

if ($func_expr) {

while ($func_expr =~ s/>(wheel|twheel),$pct_capture_re(,$div_capture_re)?//) {

my ($func, $angle, $full) = ($1, $2, $4);

my $model = ($func eq 'wheel' ? 'Hsb' : 'tHsb');

my ($h, $s, $b) = $color->convert($model)->components;

my $circle = ($full ? ToString(Expand(T_CS('\rangeHsb'))) / $full : 1);

$color = Color($model, $h + $angle * $circle, $s, $b); } }

}

else {

Error('misdefined', $expression, $STATE->getStomach,

"syntax error in <color> expression '$expression'"); }

return $color; }

sub LookupXColor {

my ($name) = @_;

if ($name =~ /^(-*)([^-].*)$/) {

return (length($1) % 2 ? LookupColor($2)->complement : LookupColor($2)); } }

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Selecting a Color Model.

# But I THINK we're going to end up using pure HTML color model as the TARGET model?

# Is it worth thinking about the "natural" model to store the intermediate colors?

# \selectcolormodel{model}

# Sets the target model to model

DefMacro('\selectcolormodel{}', '');

# \substitutecolormodel{sourcemodel}{targetmodellist}

# makes xcolor use (one of) target model whenever source model was specified

DefMacro('\substitutecolormodel{}{}', '');

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Defining colors

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DefMacroI('\xglobal@list', undef,

'\definecolor\definecolors\definecolorset\colorlet\providecolor'

. '\providecolors\providecolorset\blendcolors\maskcolors'); # \substitutecolormodel}

DefMacro('\xglobal Token', sub {

my ($gullet, $token) = @_;

if (grep { $token->equals($_) } LookupDefinition(T_CS('\xglobal@list'))->getExpansion->unlist) {

AssignValue('Boolean:xglobal@' => 1);

$token; }

else {

(T_CS('\global'), $token); } });

# Internal storage of color definition 5 elements:

# \\color@<name> => { \xcolor@ {<type>} {<driver_rep>} {<model>} {<spec>}

# [if <type> is 'named', <driver_rep> might be the name?

# Silviu says that the \\color@<name> expanding to some encoding is crucial for pgf->svg.

# He's using the form {\relax \relax {rgb r g b} {rgb} {r,g,b} }

# Which parts of that are crucial? the internal form?, the spec? all of it?

sub checkNoPostscript {

my ($type, $macro) = @_;

$type = ToString($type->isaBox ? $type : Expand($type)) if ref $type;

if ($type && ($type eq 'ps')) { # Warn? Ignore postscript

Warn('ignored', $macro, $STATE->getStomach, "Ignoring definition of postscript color in $macro");

return; }

return 1; }

# \definecolor[<type>]{<name>}{<model_list>}{<spec_list>}

DefMacro('\definecolor[]{}{}{}', '\XC@definecolor[#1]{#2}[\colornameprefix]{#3}{#4}');

# prepare, same but defered.... but we don't bother defering!

Let('\preparecolor', '\definecolor');

Let('\xdefinecolor', '\definecolor');

# \providecolor[<type>]{<name>}{<model_list>}{<spec_list>}

DefMacro('\providecolor[]{}{}{}', '\XC@providecolor[#1]{#2}[\colornameprefix]{#3}{#4}');

# \DefineNamedColor{<type>}{<name>}{<model_list>}{<spec_list>}

DefMacro('\DefineNamedColor{}{}{}{}', '\definecolor[#1]{#2}{#3}{#4}');

# What is $prefix (\colornameprefix, defaults to XC@ ??? ) used for?

DefMacroI('\colornameprefix', undef, 'XC@');

DefPrimitive('\XC@definecolor[]{}[]{}{}', sub {

my ($stomach, $type, $name, $prefix, $models, $specs) = @_;

return unless checkNoPostscript($type, '\XC@definecolor');

($type, $name, $prefix, $models, $specs)

= map { $_ && Expand($_) } $type, $name, $prefix, $models, $specs;

DefColor(ToString($name), ParseXColor($models, $specs),

(LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef));

AssignValue('Boolean:xglobal@' => 0);

# and return a box, so it can be recorded?

# but we don't want the \XC@ version, and we're not handling the prefix anyway...

Box(undef, undef, undef,

Invocation(T_CS('\definecolor'), ($type && $type->unlist ? $type : undef),

$name, $models, $specs)); });

DefPrimitive('\XC@providecolor[]{}[]{}{}', sub {

my ($stomach, $type, $name, $prefix, $models, $specs) = @_;

return unless checkNoPostscript($type, '\XC@providecolor');

($type, $name, $prefix, $models, $specs)

= map { $_ && Expand($_) } $type, $name, $prefix, $models, $specs;

my $sname = ToString($name);

return if LookupValue('color_' . $sname);

DefColor($sname, ParseXColor($models, $specs),

(LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef));

AssignValue('Boolean:xglobal@' => 0);

Box(undef, undef, undef,

# Invocation(T_CS('\XC@providecolor'),$type,$name,$prefix,$models,$specs)); });

Invocation(T_CS('\providecolor'), ($type && $type->unlist ? $type : undef),

$name, $models, $specs)); });

# \colorlet[<type>]{<name>}[<num_model>]{<color>}

DefPrimitive('\colorlet[]{}[]{}', sub {

my ($stomach, $type, $name, $tomodel, $colordesc) = @_;

return unless checkNoPostscript($type, '\colorlet');

($type, $name, $tomodel, $colordesc)

= map { $_ && Expand($_) } $type, $name, $tomodel, $colordesc;

DefColor(ToString($name), ParseXColor(undef, $colordesc, $tomodel),

(LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef));

AssignValue('Boolean:xglobal@' => 0);

Box(undef, undef, undef,

Invocation(T_CS('\colorlet'), $type, $name, $tomodel, $colordesc)); });

# \definecolorset[<type>]{<model_list>}{<head>}{<tail>}{<set_spec>}

DefPrimitive('\definecolorset[]{}{}{}{}', sub {

my ($stomach, $type, $models, $head, $tail, $specset) = @_;

return unless checkNoPostscript($type, '\definecolorset');

($type, $models, $head, $tail, $specset)

= map { $_ && Expand($_) } $type, $models, $head, $tail, $specset;

my $shead = ToString($head);

my $stail = ToString($tail);

my $scope = (LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef);

foreach my $spec (split(/;/, ToString($specset))) {

if ($spec =~ /^([^,]*),(.*)$/) {

my ($name, $specs) = ($1, $2);

DefColor($shead . $name . $stail, ParseXColor($models, $specs), $scope); } }

AssignValue('Boolean:xglobal@' => 0);

Box(undef, undef, undef,

Invocation(T_CS('\definecolorset'), $type, $models, $head, $tail, $specset)); });

Let('\preparecolorset', '\definecolorset');

# \providecolorset[<type>]{<model_list>}{<head>}{<tail>}{<set_spec>}

DefPrimitive('\providecolorset[]{}{}{}{}', sub {

my ($stomach, $type, $models, $head, $tail, $specset) = @_;

return unless checkNoPostscript($type, '\providecolorset');

($type, $models, $head, $tail, $specset)

= map { $_ && Expand($_) } $type, $models, $head, $tail, $specset;

my $shead = ToString($head);

my $stail = ToString($tail);

my $scope = (LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef);

foreach my $spec (split(/;/, ToString(Expand($specset)))) {

if ($spec =~ /^([^,]*),(.*)$/) {

my ($name, $specs) = ($1, $2);

my $defname = $shead . $name . $stail;

next if LookupValue('color_' . $defname);

DefColor($defname, ParseXColor($models, $specs), $scope); } }

AssignValue('Boolean:xglobal@' => 0);

Box(undef, undef, undef,

Invocation(T_CS('\providecolorset'), $type, $models, $head, $tail, $specset)); });

sub defineColors {

my ($stomach, $idpairs, $ifundef) = @_;

foreach my $pair (split(/,/, ToString($idpairs))) {

$pair =~ s/^\s*//; $pair =~ s/\s*$//;

my ($name, $from) = ($pair =~ /^([^=]*?)\s*=\s*(.*)$/ ? ($1, $2) : ($pair, $pair));

next if $ifundef && LookupValue('color_' . $name);

if (my $c = LookupValue('color_' . $from)) {

AssignValue('color_' . $name => $c);

DefMacroI('\\\\color@' . $name, undef, Expand(T_CS('\\\\color@' . $from))); } }

return; }

DefPrimitive('\definecolors{}', sub {

my $idpairs = Expand($_[1]);

defineColors($_[0], $idpairs, 0);

Box(undef, undef, undef, Invocation(T_CS('\definecolors'), $idpairs)); });

DefPrimitive('\providecolors{}', sub {

my $idpairs = Expand($_[1]);

defineColors($_[0], $idpairs, 1);

Box(undef, undef, undef, Invocation(T_CS('\providecolors'), $idpairs)); });

# Now, define the default colors.

RawTeX(<<'EOTeX');

\definecolorset{rgb/hsb/cmyk/gray}{}{}%

{red,1,0,0/0,1,1/0,1,1,0/.3;%

green,0,1,0/.33333,1,1/1,0,1,0/.59;%

blue,0,0,1/.66667,1,1/1,1,0,0/.11;%

brown,.75,.5,.25/.083333,.66667,.75/0,.25,.5,.25/.5475;%

lime,.75,1,0/.20833,1,1/.25,0,1,0/.815;%

orange,1,.5,0/.083333,1,1/0,.5,1,0/.595;%

pink,1,.75,.75/0,.25,1/0,.25,.25,0/.825;%

purple,.75,0,.25/.94444,1,.75/0,.75,.5,.25/.2525;%

teal,0,.5,.5/.5,1,.5/.5,0,0,.5/.35;%

violet,.5,0,.5/.83333,1,.5/0,.5,0,.5/.205}%

\definecolorset{cmyk/rgb/hsb/gray}{}{}%

{cyan,1,0,0,0/0,1,1/.5,1,1/.7;%

magenta,0,1,0,0/1,0,1/.83333,1,1/.41;%

yellow,0,0,1,0/1,1,0/.16667,1,1/.89;%

olive,0,0,1,.5/.5,.5,0/.16667,1,.5/.39}

\definecolorset{gray/rgb/hsb/cmyk}{}{}%

{black,0/0,0,0/0,0,0/0,0,0,1;%

darkgray,.25/.25,.25,.25/0,0,.25/0,0,0,.75;%

gray,.5/.5,.5,.5/0,0,.5/0,0,0,.5;%

lightgray,.75/.75,.75,.75/0,0,.75/0,0,0,.25;%

white,1/1,1,1/0,0,1/0,0,0,0}

EOTeX

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Using Colors

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DefPrimitive('\color[]{}', sub {

my ($stomach, $models, $colororspecs) = @_;

($models, $colororspecs) = map { $_ && Expand($_) } $models, $colororspecs;

my $color = ParseXColor($models, $colororspecs);

DefColor('.', $color);

AssignValue('preambleTextcolor', $color) if LookupValue('inPreamble');

MergeFont(color => $color);

(Box(undef, undef, undef, Invocation(T_CS('\color'), $models, $colororspecs)),

Digest(T_CS('\XC@mcolor'))); });

DefPrimitive('\set@color', sub {

my $color = LookupValue('color_.');

AssignValue('preambleTextcolor', $color) if LookupValue('inPreamble');

MergeFont(color => $color);

Box(undef, undef, undef, T_CS('\set@color')); });

DefPrimitive('\pagecolor[]{}', sub {

my ($stomach, $models, $colororspecs) = @_;

($models, $colororspecs) = map { $_ && Expand($_) } $models, $colororspecs;

my $color = ParseXColor($models, $colororspecs);

AssignValue('preambleBackgroundcolor', $color) if LookupValue('inPreamble');

MergeFont(background => $color);

(LookupValue('inPreamble') ? ()

: Box(undef, undef, undef, Invocation(T_CS('\pagecolor'), $models, $colororspecs))); });

#======================================================================

# Color Boxes

#======================================================================

# These probably work from the previous & color definitions?

# \colorbox{<color>}{<text>}

# \fcolorbox{<color/frame>}{<color/background>}{<text>}

# \fcolorbox[<model_list>]{<spec_list/frame>}{<spec_list/background>}{<text>}

# \fcolorbox[<model_list/frame>]{<spec_list/frame>}[<model_list/background>{<spec_list/background>}{<text>}

# \fcolorbox{<color/frame>}[<model_list/background>{<spec_list/background>}{<text>}

# \boxframe{<width>}{<height>}{<depth}>

# this should probably derive from the code for \hrule,

# but arrange for the color to determine the border's color, not the background!

DefConstructor('\boxframe{Dimension}{Dimension}{Dimension}',

"<ltx:rule width='#1' height='#2' depth='#3'"

. " color='#color' framed='rectangle' framecolor='#framecolor'/>",

afterDigest => sub {

my ($stomach, $whatsit) = @_;

my $font = LookupValue('font');

$whatsit->setProperties(color => $font->getBackground || White,

framecolor => $font->getColor || Black);

return; });

#======================================================================

# Blending Colors

#======================================================================

# \blendcolors{<mix_expr>}

# \blendcolors*{<mix_expr>}

DefPrimitive('\blendcolors OptionalMatch:* {}', sub {

my ($stomach, $star, $mix) = @_;

# global if \global

AssignValue(color_blend => (($star && LookupValue('color_blend')) || '') . ToString(Expand($mix)),

(LookupValue('Boolean:xglobal@' => 0) ? 'global' : undef));

AssignValue('Boolean:xglobal@' => 0); });

DefMacro('\colorblend', sub { Explode(LookupValue('color_blend')); });

# \maskcolors[<num_model>]{<color>}

# Interestingly, this COULD work, but something like this

# $color = $color->convert($mask->model)->multiply($mask->components);

# needs to be applied just before merging the color into the font.

# And anyway, it seems absurd that someone wants to generate color separated XML?!?!

DefPrimitive('\maskcolors[]{}', sub {

my ($stomach, $model, $color) = @_;

Info('ignored', '\maskcolors', $stomach,

"Ignoring \\maskcolors declaration.");

return;

# DefMacroI('\colormask',undef,$color);

# AssignValue('Boolean:maskcolors'=>1);

# $color = ToString(Expand($color));

# if($color){

# $color = ParseXColor(undef,$color,$model); }

# AssignValue(color_mask=>$color);

});

# \colormask

DefMacroI('\colormask', undef, '');

#======================================================================

# Color Series

#======================================================================

# \definecolorseries{<name>}{<core_model>}{<method>}[<b_model>]{<b_spec>}[<s_model>]{<s_spec>}

# <name> becomes a named color, but with provisions to step it through a sequence

DefPrimitive('\definecolorseries{}{}{}[]{}[]{}', sub {

my ($stomach, $name, $model, $method, $bmodel, $bspec, $smodel, $sspec) = @_;

($name, $model, $method, $bmodel, $bspec, $smodel, $sspec) =

map { $_ && Expand($_) } $name, $model, $method, $bmodel, $bspec, $smodel, $sspec;

$name = ToString($name);

$model = ToString($model);

my $base = ParseXColor($bmodel, $bspec, $model);

$method = ToString($method);

my $grad = (($method eq 'step') || ($method eq 'grad')

? Color($model, split(/,/, ToString($sspec)))

: ParseXColor($smodel, $sspec, $model));

AssignValue('color_series_' . $name . '_base' => $base, 'global');

AssignValue('color_series_' . $name . '_method' => $method, 'global');

AssignValue('color_series_' . $name . '_delta' => $grad, 'global'); # gradient or last

});

# \resetcolorseries[<div>]{<name>}

# reset/initialize the color series <name> for <div> steps.

DefPrimitive('\resetcolorseries Optional:\colorseriescycle {}', sub {

my ($stomach, $div, $name) = @_;

$name = ToString(Expand($name));

$div = ToString(Expand($div));

my $base = LookupValue('color_series_' . $name . '_base');

my $method = LookupValue('color_series_' . $name . '_method');

my $grad = LookupValue('color_series_' . $name . '_delta'); # gradient or last

my $step;

if ($method eq 'step') { $step = $grad; }

elsif ($method eq 'grad') { $step = $grad->scale(1 / $div); }

elsif ($method eq 'last') {

my @f = $grad->components;

my @b = $base->components;

$step = Color($base->model, map { ($f[$_] - $b[$_]) / $div } 0 .. $#b); }

DefColor($name, $base, 'global'); # Reset <name> to it's base value

AssignValue('color_series_' . $name . '_step' => $step, 'global'); # and set the current step size

});

# \colorseriescycle Default number of steps in color series

DefMacro('\colorseriescycle', '16');

# perverse rotation of value back into [0..1], INCLUSIVE!

# accomodating rounding down to 1, up to 0, and fudging for rounding errors...

sub rangeReduction {

my ($value) = @_;

return ($value > 1 ? ($value > 1.00001 ? $value - int($value) : 1)

: ($value < 0 ? ($value < -0.0001 ? ($value - int($value) + 1) : 0)

: $value)); }

# Step the color series to the next position.

sub stepColorSeries {

my ($name, $n) = @_;

my $color = LookupValue('color_' . $name);

my $step = LookupValue('color_series_' . $name . '_step');

my @comp = $color->components;

my @step = $step->components;

DefColor($name, Color($color->model,

map { rangeReduction($comp[$_] + $n * $step[$_]) } 0 .. $#comp), 'global');

return; }

# return the $p-th color in the color series (but don't step it!)

sub indexColorSeries {

my ($name, $p) = @_;

my $base = LookupValue('color_series_' . $name . '_base');

my $step = LookupValue('color_series_' . $name . '_step');

my @comp = $base->components;

my @step = $step->components;

return Color($base->model, map { rangeReduction($comp[$_] + $p * $step[$_]) } 0 .. $#comp); }

#======================================================================

# Table support

#======================================================================

# \rowcolors[<commands>]{<row>}{<color/odd>}{<color/even>}

# \rowcolors*[<commands>]{<row>}{<color/odd>}{<color/even>}

AddToMacro('\@tabular@row@after', '\@xcolor@row@after');

DefMacroI('\@xcolor@row@after', undef, '');

DefPrimitive('\rowcolors OptionalMatch:* []{Number}{}{}', sub {

my ($stomach, $star, $commands, $first, $oddcolor, $evencolor) = @_;

($oddcolor, $evencolor) = map { $_ && Expand($_) } $oddcolor, $evencolor;

## Wishful thinking...?

DefMacroI('\@xcolor@row@after', undef, $commands);

AssignValue(tabular_row_color_first => $first->valueOf);

AssignValue(tabular_row_color_odd => ($oddcolor->unlist ? ParseXColor(undef, $oddcolor) : undef));

AssignValue(tabular_row_color_even => ($evencolor->unlist ? ParseXColor(undef, $evencolor) : undef)); });

DefConditional('\if@rowcolors', undef);

AssignValue('Boolean:@rowcolors' => 1);

DefMacroI('\showrowcolors', undef, '\global\@rowcolorstrue');

DefMacroI('\hiderowcolors', undef, '\global\@rowcolorsfalse');

DefMacro('\rownum', sub { Explode(LookupValue('Alignment')->currentRowNumber); });

AddToMacro('\@tabular@row@before', '\@tabular@row@before@xcolor');

#AddToMacro('\@tabular@row@after','\@tabular@row@after@xcolor');

# Note that this does NOT override columncolor!

# so we do NOT assign to tabular_row_color!!!

# only set the background color & font for the row.

DefConstructor('\@tabular@row@before@xcolor', sub {

my ($document, %props) = @_;

if (my $bg = $props{background}) { # only set if explicitly set a color

if (my $node = $document->findnode('ancestor-or-self::ltx:tr', $document->getNode)) {

$document->setAttribute($node, backgroundcolor => $bg); } }

return; },

afterDigest => sub {

my ($stomach, $whatsit) = @_;

if (LookupValue('Boolean:@rowcolors')) {

my $n = LookupValue('Alignment')->currentRowNumber;

my $first = LookupValue('tabular_row_color_first');

my $odd = LookupValue('tabular_row_color_odd');

my $even = LookupValue('tabular_row_color_even');

if ((defined $n) && (defined $first) && (defined $odd) && (defined $even)) {

if ($n >= $first) {

my $bg = ($n % 2 ? $odd : $even);

MergeFont(background => $bg);

$whatsit->setFont(LookupValue('font'));

$whatsit->setProperty(background => $bg); } } }

return; });

#======================================================================

# Color Specs

#======================================================================

sub fixedpt {

my ($value) = @_;

return int($value * 10000 + 0.5) / 10000; }

# \extractcolorspec{<color>}{<cmd>}

# Decodes <color> and defines

# \cmd => {{<model>}{<spec>}}

DefPrimitive('\extractcolorspec{}{}', sub {

my ($stomach, $colordesc, $cmd) = @_;

my $color = ParseXColor(undef, Expand($colordesc));

my $model = $color->model;

my @spec = ($model eq 'HTML' ? $color->components

: map { fixedpt($_) } $color->components);

DefMacroI(ToString($cmd), undef, '{' . $model . '}{' . join(',', @spec) . '}'); });

# \extractcolorspecs{<color>}{<modelcmd>}{<speccmd>}

DefPrimitive('\extractcolorspecs{}{}{}', sub {

my ($stomach, $colordesc, $modelcmd, $speccmd) = @_;

my $color = ParseXColor(undef, Expand($colordesc));

my $model = $color->model;

my @spec = ($model eq 'HTML' ? $color->components

: map { fixedpt($_) } $color->components);

DefMacroI(ToString($modelcmd), undef, $model);

DefMacroI(ToString($speccmd), undef, '{' . join(',', @spec) . '}'); });

# \convertcolorspec{<model>}{<spec>}{<model/target>}{<cmd>}

DefPrimitive('\convertcolorspec{}{}{}{}', sub {

my ($stomach, $fmodel, $spec, $tomodel, $cmd) = @_;

($fmodel, $spec, $tomodel) = map { $_ && Expand($_) } $fmodel, $spec, $tomodel;

# We expect only one model/spec here, but simplify API

my $color = ParseXColor($fmodel, $spec, $tomodel);

my $model = $color->model;

my @spec = ($model eq 'HTML' ? $color->components

: map { fixedpt($_) } $color->components);

DefMacroI(ToString($cmd), undef, join(',', @spec)); });

#======================================================================

# Arithmetic

#======================================================================

# \rdivide#1#2

# \rmultiply#1#2

# \rshift, \rrshift

# \lshift, \llshift

# (and a bunch more? \\llshift, \lshiftnum...

Let('\rmultiply', '\multiply');

Let('\rdivide', '\divide');

DefPrimitive('\lshift Variable', sub {

my ($stomach, $var) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue($defn->valueOf(@args)->multiply(10), @args); });

DefPrimitive('\llshift Variable', sub {

my ($stomach, $var) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue($defn->valueOf(@args)->multiply(100), @args); });

DefMacro('\lshiftnum {}', sub {

my ($gullet, $num) = @_;

Explode(10 * ToString(Expand($num))); });

DefMacro('\llshiftnum {}', sub {

my ($gullet, $num) = @_;

Explode(100 * ToString(Expand($num))); });

DefPrimitive('\lshiftset Variable {}', sub {

my ($stomach, $var, $num) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue((10 * ToString(Expand($num)) . 'pt'), @args); });

DefPrimitive('\llshiftset Variable {}', sub {

my ($stomach, $var, $num) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue((100 * ToString(Expand($num)) . 'pt'), @args); });

DefPrimitive('\rshift Variable', sub {

my ($stomach, $var) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue($defn->valueOf(@args)->multiply(0.1), @args); });

DefPrimitive('\rrshift Variable', sub {

my ($stomach, $var) = @_;

return () unless $var;

my ($defn, @args) = @$var;

$defn->setValue($defn->valueOf(@args)->multiply(0.01), @args); });

#======================================================================

# General TeX internals

#======================================================================

RawTeX(<<'EOTeX');

\let\XC@bcolor\relax

\let\XC@mcolor\relax

\let\XC@ecolor\relax

\def\XC@append#1#2%

{\ifx#1\@undefined\def#1{#2}\else\ifx#1\relax\def#1{#2}\else

\toks@\expandafter{#1#2}\edef#1{\the\toks@}\fi\fi}

\def\XC@let@cc#1{\expandafter\XC@let@Nc\csname#1\endcsname}

\providecommand*\@namelet[1]{\expandafter\XC@let@Nc\csname#1\endcsname}

\def\XC@let@Nc#1#2{\expandafter\let\expandafter#1\csname#2\endcsname}

\def\XC@let@cN#1{\expandafter\let\csname#1\endcsname}

\def\@namexdef#1{\expandafter\xdef\csname #1\endcsname}

\def\aftergroupdef#1#2%

{\expandafter\endgroup\expandafter\def\expandafter#1\expandafter{#2}}

\def\aftergroupedef#1#2%

{\edef\@@tmp{\def\noexpand#1{#2}}\expandafter\endgroup\@@tmp}

\begingroup

\catcode`\!=13 \catcode`\:=13 \catcode`\-=13 \catcode`\+=13

\catcode`\;=13 \catcode`\/=13 \catcode`\"=13 \catcode`\>=13

\gdef\XC@edef#1#2%

{\begingroup

\ifnum\catcode`\!=13 \edef!{\string!}\fi

\ifnum\catcode`\:=13 \edef:{\string:}\fi

\ifnum\catcode`\-=13 \edef-{\string-}\fi

\ifnum\catcode`\+=13 \edef+{\string+}\fi

\ifnum\catcode`\;=13 \edef;{\string;}\fi

\ifnum\catcode`\"=13 \edef"{\string"}\fi

\ifnum\catcode`\>=13 \edef>{\string>}\fi

\edef#1{#2}\@onelevel@sanitize#1\aftergroupdef#1#1}

\gdef\XC@mdef#1#2%

{\begingroup

\ifnum\catcode`\/=13 \edef/{\string/}\fi

\ifnum\catcode`\:=13 \edef:{\string:}\fi

\edef#1{#2}\@onelevel@sanitize#1\aftergroupdef#1#1}

\endgroup

\def\XC@sdef#1#2{\edef#1{#2}\@onelevel@sanitize#1}

\def\@ifxempty#1{\@@ifxempty#1\@@ifxempty\XC@@}

\def\@@ifxempty#1#2\XC@@

{\ifx#1\@@ifxempty

\expandafter\@firstoftwo\else\expandafter\@secondoftwo\fi}

\def\XC@strip@comma#1,#2%

{\ifx,#2%

#1\expandafter\remove@to@nnil\else#1 \expandafter\XC@strip@comma\fi

#2}

{\catcode`Q=3

\gdef\XC@replace#1#2#3%

{\begingroup

\def\XC@repl@ce##1#2##2Q##3%

{\@ifxempty{##2}{\XC@r@pl@ce##1Q}{\XC@repl@ce##1##3##2Q{##3}}}%

\def\XC@r@pl@ce##1\@empty Q%

{\expandafter\endgroup\expandafter\def\expandafter#1\expandafter{##1}}%

\expandafter\XC@repl@ce\expandafter\@empty #1\@empty#2Q{#3}}

}

% ??

\def\XC@type#1%

{\expandafter\expandafter\expandafter\XC@typ@

\csname\string\color@#1\endcsname\@empty\@empty\@empty\XC@@}

\def\XC@typ@#1#2#3#4\XC@@

{\ifx#1\relax 0\else

\ifx#1\xcolor@

\ifx$#2$%

\ifx$#3$4\else3\fi\@gobbletwo

\else2\fi\@gobbletwo

\else1\fi

\fi}

EOTeX

#======================================================================

# Testing support (ugly)

#======================================================================

# Random TeX coding needed by xcolor

DefMacro('\testcolor', '\@testopt{\@testcolor}{}'); # define here, so texscan sees it!

RawTeX(<<'EOTeX');

\newenvironment*{testcolors}[1][rgb,cmyk,hsb,HTML]%

{\let\@@nam\@empty\count@\z@

\@for\@@tmp:=#1\do

{\advance\count@\@ne

\XC@sdef\@@tmp{\@@tmp}\edef\@@nam{\@@nam{\@@tmp}}}%

\edef\@@num{\the\count@}%

\def\XC@@gt{\textgreater}\def\@@tmp{OT1}%

\ifx\f@encoding\@@tmp

\@expandtwoargs\in@{,\f@family,}{,cmtt,pcr,}%

\ifin@\def\XC@@gt{>}\fi

\fi

\def\XC@@xcp@{-1}\ifnum\XC@tracing>1 \def\XC@tracing{1}\fi

\def\@testcolor[##1]##2%

{\XC@mdef\@@mod{##1}\XC@edef\@@clr{##2}%

\ifx\@@mod\@empty

\let\@@arg\@@clr\XC@replace\@@arg>\XC@@gt\else

\edef\@@arg{[\@@mod]{\@@clr}}\XC@definecolor[]{*}\@@mod\@@clr

\def\@@clr{*}\fi

\XC@append\@@arg{&}\extractcolorspecs\@@clr\@@mod\@@clr

\@testc@lor}%

\def\@testc@lor

{\count@\z@

\expandafter\@tfor\expandafter\@@tmp\expandafter:\expandafter=\@@nam\do

{\ifx\@@clr\@empty

\edef\@@cmd{\noexpand\textbf{\@@tmp}}%

\else

\convertcolorspec\@@mod\@@clr\@@tmp\@@cmd

\edef\@@cmd

{\noexpand\@testc@l@r{\@@tmp}{\@@cmd}%

\ifx\@@mod\@@tmp\noexpand\underline\fi

{\expandafter\XC@strip@comma\@@cmd,,\@nnil}}%

\fi

\expandafter\XC@append\expandafter\@@arg\expandafter{\@@cmd}%

\advance\count@\@ne

\ifnum\count@=\@@num\XC@append\@@arg{\\}\else\XC@append\@@arg{&}\fi}%

\@@arg}%

\def\@testc@l@r##1##2%

{\fboxsep\z@\fbox{\colorbox[##1]{##2}{\phantom{XX}}} }%

\tabular{@{}l*{\@@num}{l}@{}}%

\def\@@arg{\textbf{color}& }\let\@@clr\@empty\@testc@lor}%

{\endtabular\ignorespacesafterend}

EOTeX

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ProcessOptions();

1;