[tex-k] MetaPost's dvitomp and colordvi.tex [again]
Eddie Kohler
kohler@icir.org
Wed, 26 Jun 2002 15:49:49 -0700
Hi again,
Sorry, but the last patch had a bug. This one works much better.
Eddie
--- dvitomp-orig.ch Wed Jun 26 12:29:18 2002
+++ dvitomp.ch Wed Jun 26 15:46:28 2002
@@ -40,9 +40,9 @@
@d banner=='% Written by DVItoMP, Version 0.64'
{the first line of the output file}
@y
-@d banner=='% Written by DVItoMP, Version 0.64'
+@d banner=='% Written by DVItoMP, Version 0.64colordvi'
{the first line of the output file}
-@d term_banner=='This is DVItoMP, Version 0.64'
+@d term_banner=='This is DVItoMP, Version 0.64colordvi'
{the same in the usual format, as it would be shown on a terminal}
@z
@@ -296,7 +296,15 @@
do_nothing
@z
-@x [78] Fix printing of real numbers.
+@x [75] Handle colored text. (COLOR)
+print_ln('vardef _s(expr _t,_f,_m,_x,_y)=');
+print_ln(' addto _p also _t infont _f scaled _m shifted (_x,_y); enddef;');
+@y
+print_ln('vardef _s(expr _t,_f,_m,_x,_y)(text _c)=');
+print_ln(' addto _p also _t infont _f scaled _m shifted (_x,_y) _c; enddef;');
+@z
+
+@x [78] Fix printing of real numbers, and add color (COLOR).
if (abs(x)>=4096.0)or(abs(y)>=4096.0)or(m>=4096.0)or(m<0) then
begin warn('text scaled ',m:1:1,@|
' at (',x:1:1,',',y:1:1,') is out of range');
@@ -313,11 +321,20 @@
print(',_n',str_f:1,',');
fprint_real(mpx_file, m,1,5); print(',');
fprint_real(mpx_file, x,1,4); print(',');
- fprint_real(mpx_file, y,1,4);
+ fprint_real(mpx_file, y,1,4); print(',');@/
+ @<Print a \.{withcolor} specifier if appropriate@>@/
print_ln(');');
@z
-@x [79] Another fix for printing of real numbers.
+@x [79] Fix _r definition (COLOR).
+ print_ln('vardef _r(expr _a,_w) =');
+ print_ln(' addto _p doublepath _a withpen pencircle scaled _w enddef;');
+@y
+ print_ln('vardef _r(expr _a,_w)(text _t) =');
+ print_ln(' addto _p doublepath _a withpen pencircle scaled _w _t enddef;');
+@z
+
+@x [79] Another fix for printing of real numbers, plus colors (COLOR).
if (abs(xx1)>=4096.0)or(abs(yy1)>=4096.0)or@|
(abs(xx2)>=4096.0)or(abs(yy2)>=4096.0)or(ww>=4096.0) then
warn('hrule or vrule near (',xx1:1:1,',',yy1:1:1,') is out of range');
@@ -332,7 +349,8 @@
fprint_real(mpx_file, yy1,1,4); print(')..(');
fprint_real(mpx_file, xx2,1,4); print(',');
fprint_real(mpx_file, yy2,1,4); print('), ');
- fprint_real(mpx_file, ww,1,4);
+ fprint_real(mpx_file, ww,1,4); print(',');
+ @<Print a \.{withcolor} specifier if appropriate@>@/
print_ln(');');
@z
@@ -350,6 +368,20 @@
fprint_real(mpx_file, h,1,4); print_ln(')--cycle;')
@z
+@x [88] push and pop commands (COLOR).
+@p procedure do_push;
+@y
+@p @<Declare procedures to handle color commands@>
+procedure do_push;
+@z
+
+@x [94] Additional cases for DVI commands (COLOR).
+four_cases(xxx1): for k:=1 to p do
+ down_the_drain:=get_byte;
+@y
+four_cases(xxx1): do_xxx(p);
+@z
+
@x [98] Main program.
print_ln(banner);
@y
@@ -455,4 +487,242 @@
@<Global...@> =
@!dvi_name, @!mpx_name:c_string;
+
+
+
+@* Color support.
+These changes support \.{dvips}-style ``\.{color push NAME}'' and
+``\.{color pop}'' specials. We store a list of named colors, sorted by
+name, and decorate the relevant drawing commands with ``\.{withcolor
+(r,g,b)}'' specifiers while a color is defined.
+
+@ First we declare a record for color types.
+
+@<Types...@> =
+@!named_color_record=record@;@/
+ @!name:c_string; {color name}
+ @!red,green,blue:real; {red, green, blue components}
+ end;
+
+@ A constant bounding the size of the named-color array.
+
+@<Constants...@> =
+@!max_named_colors=100; {maximum number of distinct named colors}
+
+@ Declare the named-color array itself.
+
+@<Globals...@> =
+@!named_colors: array[1..max_named_colors] of named_color_record;
+ {stores information about named colors, in sorted order by name}
+@!num_named_colors:integer; {number of elements of |named_colors| that are valid}
+
+@ This function, used only during initialization, defines a named color.
+
+@<Define |parse_arguments|@> =
+procedure def_named_color(n: c_string; r,g,b: real);
+ begin
+ if num_named_colors = max_named_colors then
+ abort('too many named color definitions')
+ else if (num_named_colors > 0) and (strcmp(n, named_colors[num_named_colors].name) <= 0) then
+ abort('named colors added out of alphabetical order');
+ incr(num_named_colors);
+ named_colors[num_named_colors].name := n;
+ named_colors[num_named_colors].red := r;
+ named_colors[num_named_colors].green := g;
+ named_colors[num_named_colors].blue := b;
+ end;
+
+@ During the initialization phase, we define values for all the named
+colors defined in \.{colordvi.tex}. CMYK-to-RGB conversion by GhostScript.
+
+@<Set initial values@> =
+num_named_colors := 0;
+def_named_color('Apricot', 1.0, 0.680006, 0.480006);
+def_named_color('Aquamarine', 0.180006, 1.0, 0.7);
+def_named_color('Bittersweet', 0.760012, 0.0100122, 0.0);
+def_named_color('Black', 0.0, 0.0, 0.0);
+def_named_color('Blue', 0.0, 0.0, 1.0);
+def_named_color('BlueGreen', 0.15, 1.0, 0.669994);
+def_named_color('BlueViolet', 0.1, 0.05, 0.960012);
+def_named_color('BrickRed', 0.719994, 0.0, 0.0);
+def_named_color('Brown', 0.4, 0.0, 0.0);
+def_named_color('BurntOrange', 1.0, 0.489988, 0.0);
+def_named_color('CadetBlue', 0.380006, 0.430006, 0.769994);
+def_named_color('CarnationPink', 1.0, 0.369994, 1.0);
+def_named_color('Cerulean', 0.0600122, 0.889988, 1.0);
+def_named_color('CornflowerBlue', 0.35, 0.869994, 1.0);
+def_named_color('Cyan', 0.0, 1.0, 1.0);
+def_named_color('Dandelion', 1.0, 0.710012, 0.160012);
+def_named_color('DarkOrchid', 0.6, 0.2, 0.8);
+def_named_color('Emerald', 0.0, 1.0, 0.5);
+def_named_color('ForestGreen', 0.0, 0.880006, 0.0);
+def_named_color('Fuchsia', 0.45, 0.00998169, 0.919994);
+def_named_color('Goldenrod', 1.0, 0.9, 0.160012);
+def_named_color('Gray', 0.5, 0.5, 0.5);
+def_named_color('Green', 0.0, 1.0, 0.0);
+def_named_color('GreenYellow', 0.85, 1.0, 0.310012);
+def_named_color('JungleGreen', 0.0100122, 1.0, 0.480006);
+def_named_color('Lavender', 1.0, 0.519994, 1.0);
+def_named_color('LimeGreen', 0.5, 1.0, 0.0);
+def_named_color('Magenta', 1.0, 0.0, 1.0);
+def_named_color('Mahogany', 0.65, 0.0, 0.0);
+def_named_color('Maroon', 0.680006, 0.0, 0.0);
+def_named_color('Melon', 1.0, 0.539988, 0.5);
+def_named_color('MidnightBlue', 0.0, 0.439988, 0.569994);
+def_named_color('Mulberry', 0.640018, 0.0800061, 0.980006);
+def_named_color('NavyBlue', 0.0600122, 0.460012, 1.0);
+def_named_color('OliveGreen', 0.0, 0.6, 0.0);
+def_named_color('Orange', 1.0, 0.389988, 0.130006);
+def_named_color('OrangeRed', 1.0, 0.0, 0.5);
+def_named_color('Orchid', 0.680006, 0.360012, 1.0);
+def_named_color('Peach', 1.0, 0.5, 0.3);
+def_named_color('Periwinkle', 0.430006, 0.45, 1.0);
+def_named_color('PineGreen', 0.0, 0.75, 0.160012);
+def_named_color('Plum', 0.5, 0.0, 1.0);
+def_named_color('ProcessBlue', 0.0399878, 1.0, 1.0);
+def_named_color('Purple', 0.55, 0.139988, 1.0);
+def_named_color('RawSienna', 0.55, 0.0, 0.0);
+def_named_color('Red', 1.0, 0.0, 0.0);
+def_named_color('RedOrange', 1.0, 0.230006, 0.130006);
+def_named_color('RedViolet', 0.590018, 0.0, 0.660012);
+def_named_color('Rhodamine', 1.0, 0.180006, 1.0);
+def_named_color('RoyalBlue', 0.0, 0.5, 1.0);
+def_named_color('RoyalPurple', 0.25, 0.1, 1.0);
+def_named_color('RubineRed', 1.0, 0.0, 0.869994);
+def_named_color('Salmon', 1.0, 0.469994, 0.619994);
+def_named_color('SeaGreen', 0.310012, 1.0, 0.5);
+def_named_color('Sepia', 0.3, 0.0, 0.0);
+def_named_color('SkyBlue', 0.380006, 1.0, 0.880006);
+def_named_color('SpringGreen', 0.739988, 1.0, 0.239988);
+def_named_color('Tan', 0.860012, 0.580006, 0.439988);
+def_named_color('TealBlue', 0.119994, 0.980006, 0.640018);
+def_named_color('Thistle', 0.880006, 0.410012, 1.0);
+def_named_color('Turquoise', 0.15, 1.0, 0.8);
+def_named_color('Violet', 0.210012, 0.119994, 1.0);
+def_named_color('VioletRed', 1.0, 0.189988, 1.0);
+def_named_color('White', 1.0, 1.0, 1.0);
+def_named_color('WildStrawberry', 1.0, 0.0399878, 0.610012);
+def_named_color('Yellow', 1.0, 1.0, 0.0);
+def_named_color('YellowGreen', 0.560012, 1.0, 0.260012);
+def_named_color('YellowOrange', 1.0, 0.580006, 0.0);
+
+@ Color commands get a separate warning procedure. |warn| sets |history :=
+warning_given|, which causes a nonzero exit status; but color errors are
+trivial and should leave the exit status zero.
+
+@d color_warn(#)==begin err_print('DVItoMP warning: ',#); if history < warning_given then history := cksum_trouble; end
+
+@ The |do_xxx| procedure handles DVI specials (defined with the
+|xxx1...xxx4| commands).
+
+@<Declare procedures to handle color commands@> =
+procedure do_xxx(p: integer);
+label 9999; {exit procedure}
+const bufsiz = 256;
+var buf: packed array[0..bufsiz] of eight_bits;
+ l, r, m, k, len: integer;
+ found: boolean;
+begin
+ len := 0;
+ while (p > 0) and (len < bufsiz) do begin
+ buf[len] := get_byte;
+ decr(p); incr(len);
+ end;
+ @<Check whether |buf| contains a color command; if not, |goto 9999|@>
+ if p > 0 then begin
+ color_warn('long "color" special ignored'); goto 9999; end;
+ if @<|buf| contains a color pop command@> then begin
+ @<Handle a color pop command@>
+ end else if @<|buf| contains a color push command@> then begin
+ @<Handle a color push command@>
+ end else begin
+ color_warn('unknown "color" special ignored'); goto 9999; end;
+9999: for k := 1 to p do down_the_drain := get_byte;
+end;
+
+@
+
+@<Check whether |buf| contains a color command; if not, |goto 9999|@> =
+if (len <= 5) or (buf[0] <> "c") or (buf[1] <> "o") or (buf[2] <> "l")
+ or (buf[3] <> "o") or (buf[4] <> "r") or (buf[5] <> " ")
+ then goto 9999;
+
+@
+
+@<|buf| contains a color push command@> =
+(len >= 11) and (buf[6] = "p") and (buf[7] = "u") and (buf[8] = "s") and (buf[9] = "h") and (buf[10] = " ")
+
+@
+
+@<|buf| contains a color pop command@> =
+(len = 9) and (buf[6] = "p") and (buf[7] = "o") and (buf[8] = "p")
+
+@ The \.{color push} and \.{pop} commands imply a color stack, so we need a
+global variable to hold that stack.
+
+@<Constants...@> =
+max_color_stack_depth=10; {maximum depth of saved color stack}
+
+@ Here's the actual stack variables.
+
+@<Globals...@> =
+color_stack_depth: integer; {current depth of saved color stack}
+color_stack: array[1..max_color_stack_depth] of named_color_record; {saved color stack}
+
+@ Initialize the stack to empty.
+
+@<Set initial values@> =
+color_stack_depth := 0;
+
+@ \.{color pop} just pops the stack.
+
+@<Handle a color pop command@> =
+finish_last_char;
+if color_stack_depth > 0 then
+ decr(color_stack_depth)
+else
+ color_warn('more "color pop" specials than "color push" specials');
+
+@ \.{color push} pushes a color onto the stack. We binary-search the
+|named_colors| array, then push the found color onto the stack.
+
+@<Handle a color push command@> =
+finish_last_char;
+if color_stack_depth >= max_color_stack_depth then
+ abort('color stack overflow');
+incr(color_stack_depth);
+{ I don't know how to do string operations in Pascal. }
+for k := 11 to len - 1 do begin
+ buf[k - 11] := xchr[buf[k]];
+end;
+buf[len - 11] := 0;
+l := 1; r := num_named_colors;
+found := false;
+while (l < r) and not found do begin
+ m := (l + r) / 2;
+ k := strcmp(buf, named_colors[m].name);
+ if k = 0 then begin
+ color_stack[color_stack_depth].red := named_colors[m].red;
+ color_stack[color_stack_depth].green := named_colors[m].green;
+ color_stack[color_stack_depth].blue := named_colors[m].blue;
+ found := true;
+ end else if k < 0 then
+ r := m - 1
+ else
+ l := m + 1;
+end;
+if not found then begin
+ color_warn('unknown color in "color push" command, pushing black');
+ color_stack[color_stack_depth].red := 0;
+ color_stack[color_stack_depth].green := 0;
+ color_stack[color_stack_depth].blue := 0;
+end;
+
+@ Last but not least, this code snippet prints a \.{withcolor} specifier
+for the top of the color stack, if the stack is nonempty.
+
+@<Print a \.{withcolor} specifier if appropriate@> =
+if color_stack_depth > 0 then
+ print(' withcolor (', color_stack[color_stack_depth].red, ', ', color_stack[color_stack_depth].green, ', ', color_stack[color_stack_depth].blue, ')');
+
@z