# -*- mode: Perl -*-
# /=====================================================================\ #
# | 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);
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Options & Initializations.
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DefConditional('\ifglobalcolors', undef);
DefConditional('\ifdefinecolors', undef);
DefConditional('\ifconvertcolorsD', undef);
DefConditional('\ifconvertcolorsU', undef);
DefConditional('\ifblendcolors', undef);
DefConditional('\ifmaskcolors', undef);
DefConditional('\ifxglobal@', undef);
RawTeX('\globalcolorsfalse\definecolorstrue');
RequirePackage('color');
# 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');
# 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@\*]+|[a-zA-Z0-9@\*\-]+/;
my $ne_name_re = qr/[-]*\.|[-]*[a-zA-Z0-9@\*]+|[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/!\s*$pct_re(?:!$name_re!$pct_re)*(?:!\s*$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 Black; }
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('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
Info('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('xglobal@' => 0) ? 'global' : undef));
AssignValue('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('xglobal@' => 0) ? 'global' : undef));
AssignValue('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;
my $color = ParseXColor(undef, $colordesc, $tomodel);
DefColor(ToString($name), $color, (LookupValue('xglobal@' => 0) ? 'global' : undef));
AssignValue('xglobal@' => 0);
Box(undef, undef, undef,
Invocation(T_CS('\definecolor'), $type, $name, # Revert to ACTUAL color, not user's name
T_OTHER('rgb'), T_OTHER(join(',', $color->rgb->components)))); });
# \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('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('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('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('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'), T_OTHER('rgb'), # Revert to ACTUAL color, not user's name
T_OTHER(join(',', $color->rgb->components)))),
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('xglobal@' => 0) ? 'global' : undef));
AssignValue('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);
# \maskcolorstrue
# $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);
RawTeX('\@rowcolorstrue');
DefMacroI('\showrowcolors', undef, '\global\@rowcolorstrue');
DefMacroI('\hiderowcolors', undef, '\global\@rowcolorsfalse');
DefMacro('\rownum', sub { Explode(LookupValue('Alignment')->currentRowNumber); });
# This doesn't happen early enough to register \hiderowcolors|\showrowcolors in the same row!
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 (IfCondition(T_CS('\if@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;