Types and Constants
Context: TYPE ~ Imager.Context;
IntKey: TYPE ~ ImagerBackdoor.IntKey;
RealKey: TYPE ~ ImagerBackdoor.RealKey;
Rectangle: TYPE ~ ImagerBox.Rectangle;
Color: TYPE ~ ImagerColor.Color;
ColorOperator: TYPE ~ ImagerColor.ColorOperator;
Font: TYPE ~ ImagerFont.Font;
XStringProc: TYPE ~ ImagerFont.XStringProc;
PathProc: TYPE ~ ImagerPath.PathProc;
PixelArray: TYPE ~ ImagerPixelArray.PixelArray;
Transformation: TYPE ~ ImagerTransformation.Transformation;
TransformationRep: TYPE ~ ImagerTransformation.TransformationRep;
Factors: TYPE ~ ImagerTransformation.FactoredTransformation;
PSFont: TYPE ~ IPtoPS.PSFont;
ROPE: TYPE ~ Rope.ROPE;
Class: TYPE ~ ImagerPrivate.Class;
ClassRep:
PUBLIC
TYPE ~ ImagerPrivate.ClassRep;
-- export to Imager.ClassRep
FontRecord:
TYPE ~
RECORD [id:
INT ¬ -1, font: Font ¬
NIL, type:
ATOM ¬ $Unknown];
Piece:
TYPE ~
RECORD [
text: ROPE ¬ NIL, -- text to be justified
forMeasure: ROPE ¬ NIL, -- needed for string width measure
forBefore: ROPE ¬ NIL, -- needed before text shown
forAfter: ROPE ¬ NIL -- needed after text shown
];
DefType:
TYPE ~ {overlay, showbackward, plainJustify, mixedJustify};
Data: TYPE ~ REF DataRep;
DataRep:
TYPE ~
RECORD [
compact: BOOL ¬ FALSE, -- minimize output size?
stream: IO.STREAM, -- PostScript output stream
debug: IO.STREAM ¬ NIL, -- output stream for debugging
sampledColor: PixelArray ¬ NIL, -- maintain sampled color state
sampledColorM: Transformation ¬ NIL, -- maintain sampled color state
sampledColorOperator: ColorOperator ¬ NIL, -- maintain sampled color state
getTDone: BOOL ¬ FALSE, -- getTForm set?
getTForm: NAT ¬ firstIPForm, -- context transformation form
T: Transformation ¬ NIL, -- client to initial matrix
matrixStack: LIST OF TransformationRep ¬ NIL,
nest: INT ¬ 0, -- PostScript nesting level
fonts: LIST OF FontRecord ¬ NIL, -- cache of fonts found
font: FontRecord ¬ [0,, $Unknown], -- current font
fontStack: LIST OF FontRecord ¬ NIL, -- never promised a rose garden
nUnderlines: INT ¬ 0, -- ditto
justifying: BOOL ¬ FALSE, -- buffer for text justification?
colwidth: REAL ¬ 0.0, -- width of justification column
nPieces: INT ¬ 0, -- # different text pieces in line
piece: ARRAY [0..maxNPieces) OF Piece, -- piece of text for justified line
defined: ARRAY DefType OF BOOL ¬ ALL[FALSE], -- defined yet?
nInvalidChars: INT ¬ 0
];
ShowType:
TYPE ~ {normal, xRel, fixedXRel, backward};
maxNPieces: NAT ~ 100;
firstIPForm: NAT ~ 100;
endIPForm: NAT ~ 1000;
identity: Transformation ~ ImagerTransformation.Scale[1];
miterLimit: ImagerBackdoor.RealKey ~ miterLimit;
hex:
ARRAY [0..16)
OF
CHAR
¬
['0, '1, '2, '3, '4, '5, '6, '7, '8, '9, 'A, 'B, 'C, 'D, 'E, 'F];
mathChars:
ARRAY [32..126]
OF
BYTE ¬ [
each entry:
PostScript octal equivalent (or 250B if unsupported)
decimal Xerox character code
Xerox character with Look-M (math)
valid characters: 32-95, 97-111, 113-126 (but necessarily with PostScript equivalents)
invalid characters:
code = 59 (:): unprintable by Tioga
code = 96 (`): unprintable by Tioga
code = 112 (p): non-standard character set
040B--32:#--, 250B--33: --, 250B--34:°--, 245B--35: --, 250B--36:--,
270B--37:÷--, 331B--38:'--, 272B--39:P-- , 242B--40:`--, 326B--41:--,
327B--42:--, 261B--43:±--, 047B--44: --, 250B--45: --, 134B--46:+--,
306B--47:˜--, 117B--48:Ë--, 250B--49:¡--, 104B--50:--, 340B--51:.--,
305B--52:•--, 250B--53:–--, 304B--54:—--, 320B--55: --, 250B--56:Æ--,
267B--57:"--, 170B--58:§--, 250B--59:®--, 243B--60:d--, 271B--61:`--,
263B--62:e--, 250B--63:¿--, 250B--64:--, 042B--65: --, 316B--66:--,
250B--67:ï--, 321B--68:--, 044B--69:--, 250B--70:!--, 314B--71:‚--,
313B--72:î--, 315B--73:†--, 311B--74:ƒ--, 250B--75:…--, 312B--76:‡--,
277B--77:[--, 317B--78: --, 306B--79:--, 265B--80:Ü--, 333B--81:Ä--,
302B--82:]--, 273B--83:H--, 136B--84:¥--, 310B--85:*--, 332B--86:(--,
272B--87:{--, 264B--88: --, 257B--89:´--, 250B--90:õ--, 355B--91:z--,
250B--92:ý--, 375B--93:{--, 257B--94:Ë--, 256B--95:b--, 250B--96:ý--,
300B--97:è--, 250B--98:--, 323B--99:©--, 266B--100:--, 100B--101:C--,
253B--102:é--, 336B--103:Ò--, 250B--104:--, 351B--105:--, 371B--106:Ë--,
353B--107:Ð--, 373B--108:--, 250B--109:%--, 330B--110:¬--, 260B--111:--,
250B--112:¢--, 250B--113:«--, 322B--114:®--, 250B--115:g--, 250B--116:f--,
250B--117:--, 250B--118:h--, 250B--119:¡--, 250B--120:¢--, 307B--121:)--,
250B--122:£--, 250B--123:¼--, 250B--124:ý--, 250B--125:¾--, 333B--126:ý--];
greekChars:
ARRAY [65..122]
OF
BYTE ← [
101B--A--, 102B--B--, 103B--C--, 104B--D--, 105B--E--, 106B--F--,
107B--G--, 110B--H--, 111B--I--, 112B--J--, 113B--K--, 114B--L--,
115B--M--, 116B--N--, 117B--O--, 120B--P--, 121B--Q--, 122B--R--,
123B--S--, 124B--T--, 125B--U--, 126B--V--, 127B--W--, 130B--X--,
131B--Y--, 132B--Z--, 250B--.--, 250B--.--, 250B--.--, 250B--.--,
250B--.--, 250B--.--, 141B--a--, 142B--b--, 143B--c--, 144B--d--,
145B--e--, 146B--f--, 147B--g--, 150B--h--, 151B--i--, 152B--j--,
153B--k--, 154B--l--, 155B--m--, 156B--n--, 157B--o--, 160B--p--,
161B--q--, 162B--r--, 163B--s--, 164B--t--, 165B--u--, 166B--v--,
167B--w--, 170B--x--, 171B--y--, 172B--z--];
Support Procs
Warn:
PUBLIC
SIGNAL [reason:
ROPE] =
CODE;
Debug:
PROC [d: Data, r:
ROPE] ~ {
IF d.debug # NIL THEN IO.PutF1[d.debug, "%g\n", IO.rope[r]];
};
Create:
PUBLIC
PROC [
stream: IO.STREAM,
nPages: INT,
creator: ROPE,
comment: ROPE ← NIL,
compact: BOOL ¬ FALSE,
debug: IO.STREAM ← NIL]
RETURNS [c: Context]
~ {
d: Data ~
NEW[DataRep ← [
stream: stream,
debug: debug,
T: ImagerTransformation.Scale[0.0254/72.0],
compact: compact]];
c ← NEW[Imager.ContextRep ← [class: class, state: NIL, data: d, propList: NIL]];
IO.PutRope[stream, "%!PS-Adobe- PostScript translation of Interpress master\n"];
IF comment # NIL THEN IO.PutF1[stream, "%%%g\n", IO.rope[comment]];
IO.PutRope[stream, "%%DocumentFonts: unknown\n"];
IO.PutF1[stream, "%%%%Creator: %g\n", IO.rope[creator]];
IO.PutF1[stream, "%%%%Pages: %g\n", IO.int[nPages]];
IO.PutRope[stream, "%%EndComments\n"];
IF compact
THEN IO.PutRope[stream, "% Simple procedures (others defined as needed)
/width {stringwidth pop} bind def % stack: text
/s {setrgbcolor} bind def
/f {fill} bind def
/m {moveto} bind def
/l {lineto} bind def
/v {m l stroke} bind def % stack: x y
/nsp {0 exch {32 eq {1 add} if} forall} bind def % stack: txt -> #spaces
/try {dup where {exch get} {pop 0} ifelse} bind def % stack: value
%%EndProlog\n\n"]
ELSE IO.PutRope[stream, "% Simple procedures (others defined as needed)
/width {stringwidth pop} bind def % stack: text
/vec {moveto lineto stroke} bind def % stack: x y
/nsp {0 exch {32 eq {1 add} if} forall} bind def % stack: txt -> #spaces
/try {dup where {exch get} {pop 0} ifelse} bind def % stack: value
%%EndProlog\n\n"];
};
Define:
PROC [d: Data, type: DefType] ~ {
note: the space character can be named in PostScript as 32 or 8#040
definition:
ROPE ←
SELECT type
FROM
overlay =>
"/overlay { % stack: text overlay
exch width dup neg 0 rmoveto % stack: overlay twidth
exch dup width 3 -1 roll % stack: overlay owidth twidth
exch sub 2 div dup 0 rmoveto % stack: overlay delta
exch show 0 rmoveto % stack: NULL
} bind def",
showbackward =>
"/showbackward { % stack: text
dup width neg 0 rmoveto show % stack: NULL
} bind def",
plainJustify =>
"/justify { % stack: text
dup nsp /ns exch def % stack: text
ns 0 eq {show} { % stack: text
dup width /totwidth try add % stack: text width
colwidth exch sub % stack: text excess
ns div % stack: text spaceadd
0 32 4 -1 roll % stack: spaceadd 0 32 text
widthshow /totwidth 0 def % stack: NULL
} ifelse
} bind def",
mixedJustify =>
"/execget {arindex get dup null eq {pop} {exec} ifelse} bind def
/mixedjustify {
/excess colwidth totwidth sub def
0 1 npiece {
/arindex exch def
opsbef execget % exec any accumu before ops
nspaces arindex get % stack: nspaces
dup 0 eq { % stack: nspaces
pop texts arindex get % stack: text
show % stack: NULL
}{
weights arindex get % stack: nspaces weight
totwt div excess mul % stack: nspaces share-excess
exch div 0 32 % stack: spaceadd 0 32
texts arindex get % stack: spaceadd 0 32 text
widthshow % stack: NULL
} ifelse
opsaft execget % exec any accumulated after ops
} for
/totwidth 0 def /totwt 0.0 def
} bind def
/buf { % stack: text npiece
/npiece exch def % stack: text
dup nsp /ns exch def % stack: text
dup texts npiece 3 -1 roll put % stack: text
nspaces npiece ns put width % stack: width
totwidth add /totwidth exch def % stack: NULL
ns 0 ne {
( ) width ns mul % stack: weight
dup totwt add /totwt exch def % stack: weight
weights npiece 3 -1 roll put % stack: NULL
} if
} bind def
/texts 250 array def
/nspaces 250 array def
/weights 250 array def
/opsbef 250 array def
/opsaft 250 array def
/totwidth 0 def
/totwt 0.0 def",
ENDCASE => ERROR;
IO.PutRope[d.stream, Rope.Cat["\n", definition, "\n\n"]];
d.defined[type] ← TRUE;
};
DataFromContext:
PROC [context: Context]
RETURNS [data: Data ←
NIL] ~ {
WITH context.data SELECT FROM d: Data => {data ← d}; ENDCASE;
};
NInvalidChars:
PUBLIC
PROC [context: Context]
RETURNS [n:
INT ← 0] ~ {
d: Data ← DataFromContext[context];
IF d # NIL THEN n ← d.nInvalidChars;
};
Close:
PUBLIC
PROC [context: Context] ~ {
d: Data ← DataFromContext[context];
IF d # NIL THEN IO.PutRope[d.stream, Newline[d]]; IO.Close[d.stream];
};
Newline:
PROC [d: Data]
RETURNS [r:
ROPE ← "\n"] ~ {
THROUGH [0..d.nest) DO r ← Rope.Concat[r, " "]; ENDLOOP;
};
ImagerOpSend:
PROC [d: Data, cmd:
ROPE, nl:
BOOL ←
TRUE, op: {measure, before, after}] ~ {
ImagerOpRope:
PROC [d: Data, op:
ROPE, nl:
BOOL ←
TRUE]
RETURNS [r:
ROPE ←
NIL] ~ {
IF NOT Rope.IsEmpty[op] THEN r ← Rope.Cat[r, op, IF nl THEN Newline[d] ELSE " "];
};
r: ROPE ← ImagerOpRope[d, cmd, nl];
IF
NOT d.justifying
THEN IO.PutRope[d.stream, r]
ELSE
SELECT op
FROM
measure => d.piece[d.nPieces].forMeasure ← Rope.Concat[d.piece[d.nPieces].forMeasure, r];
before => d.piece[d.nPieces].forBefore ← Rope.Concat[d.piece[d.nPieces].forBefore, r];
after => d.piece[d.nPieces].forAfter ← Rope.Concat[d.piece[d.nPieces].forAfter, r];
ENDCASE;
};
ImagerOp:
PROC [d:
Data,
cmd:
ROPE,
nl:
BOOL
←
TRUE]
~
{ImagerOpSend[d, cmd, nl, before]};
ImagerOpNeedForMeasure:
PROC [d: Data, cmd:
ROPE] ~ {ImagerOpSend[d, cmd,, measure]};
ImagerOpNeedForAfter:
PROC [d: Data, cmd:
ROPE] ~ {ImagerOpSend[d, cmd,, after]};
Save:
PROC [d: Data] ~ {
IF NOT d.compact THEN d.nest ← d.nest+1;
ImagerOp[d, "gsave"];
PushFont[d, d.font];
d.matrixStack ¬ CONS[d.T, d.matrixStack];
};
Restore:
PROC [d: Data] ~ {
IF NOT d.compact THEN d.nest ← d.nest-1;
ImagerOp[d, "grestore"];
d.sampledColorSet ¬ NIL;
d.font ← PopFont[d];
d.T ¬ d.matrixStack.first;
d.matrixStack ¬ d.matrixStack.rest;
};
CompactRealRope:
PROC [r:
REAL]
RETURNS [ret:
ROPE] ~ {
length: INT ¬ Rope.Length[ret ¬ IO.PutFR1["%g", IO.real[r]]];
IF length > 2
AND Rope.Fetch[ret, length-1] = '0
AND Rope.Fetch[ret, length-2] = '.
THEN ret ¬ Rope.Substr[ret, 0, length-2];
PostScript printers should understand "e" (or "E") notation
FOR i: INT IN [1..Rope.Length[ret]-1) DO
IF Rope.Fetch[ret, i] = 'e THEN RETURN[IO.PutFR1["%8.5f", IO.real[r]]];
ENDLOOP;
};
JaMOp:
PROC [d: Data, name:
ROPE, newline:
BOOL ←
TRUE] ~ {ImagerOp[d, name, newline]};
JaMInt:
PROC [d: Data, int:
INT] ~ {ImagerOp[d, Convert.RopeFromInt[int],
FALSE]};
JaMReal:
PROC [d: Data, real:
REAL] ~ {
IF d.compact
THEN ImagerOp[d, CompactRealRope[real], FALSE]
ELSE ImagerOp[d, Convert.RopeFromReal[real], FALSE];
};
JaMVec:
PROC [d: Data, v:
VEC] ~ {
IF d.compact
THEN ImagerOp[d,
IO.PutFR["%g %g",
IO.rope[CompactRealRope[v.x]], IO.rope[CompactRealRope[v.y]]], FALSE]
ELSE ImagerOp[d, IO.PutFR["%g %g", IO.real[v.x], IO.real[v.y]], FALSE];
};
PutFactoredTransformation:
PROC [d: Data, f: Factors] ~ {
n: INT ← 0;
IF f.r1 # 0.0
THEN {
JaMReal[d, f.r1];
ImagerOp[d, "matrix rotate", FALSE];
n ← n+1;
};
IF f.s.x # 1.0
OR f.s.y # 1.0
THEN {
IF f.s.x = f.s.y
THEN {JaMReal[d, f.s.x]; ImagerOp[d, "dup matrix scale", FALSE]}
ELSE {JaMVec[d, f.s]; ImagerOp[d, "matrix scale", FALSE]};
n ← n+1;
};
IF f.r2 # 0.0
THEN {
JaMReal[d, f.r2];
ImagerOp[d, "matrix rotate", FALSE];
n ← n + 1;
};
IF f.t.x # 0.0
OR f.t.y # 0.0
THEN {
JaMVec[d, f.t];
ImagerOp[d, "matrix translate", FALSE];
n ← n+1;
};
IF n = 0 THEN {JaMReal[d, 1]; ImagerOp[d, "dup matrix scale"]; n ← 1};
WHILE n > 1
DO
ImagerOp[d, "matrix concatmatrix", n = 1];
n ← n-1;
ENDLOOP;
};
Scrub:
PROC [rope:
ROPE, nest:
INT]
RETURNS [ret:
ROPE ←
NIL] ~ {
IF
NOT Rope.IsEmpty[rope]
THEN {
Brief:
PROC [c:
CHAR]
RETURNS [b:
BOOL ←
FALSE] ~ {
IF c = '\n THEN c ← ' ;
IF c = '\t OR (c = ' AND (new.length = 0 OR new[new.length-1] = ' )) THEN RETURN;
new ← RefText.AppendChar[new, c];
};
Indent:
PROC [c:
CHAR]
RETURNS [b:
BOOL ←
FALSE] ~ {
Tab: PROC ~ {THROUGH [0..4) DO new ← RefText.AppendChar[new, ' ]; ENDLOOP};
IF new.length = 0 THEN Tab[];
new ← RefText.AppendChar[new, c];
IF c = '\n THEN Tab[];
};
Find:
PROC [t:
REF
TEXT, n, inc:
INT]
RETURNS [
INT] ~ {
DO
IF t[n] # ' AND t[n] # '\n THEN RETURN[n];
IF (n ← n+inc) NOT IN [0..t.length) THEN RETURN[n-inc];
ENDLOOP;
};
start: INT;
old: REF TEXT ← Rope.ToRefText[rope];
new: REF TEXT ← RefText.ObtainScratch[1000];
short: BOOL ← 3*nest+Find[old, old.length-1, -1]-Find[old, 0, 1] < 55;
[] ← RefText.Map[old,,, IF short THEN Brief ELSE Indent];
start ← IF short THEN Find[new, 0, 1] ELSE 0;
ret ← Rope.FromRefText[new, start, Find[new, new.length-1, -1]+1-start];
RefText.ReleaseScratch[new]};
};
NSpaces:
PROC [text:
ROPE]
RETURNS [n:
INT ← 0] ~ {
FOR i: INT IN [0..Rope.Length[text]) DO IF Rope.Fetch[text, i] = ' THEN n ← n+1; ENDLOOP;
};
Imaging State Procs
DoSetGray:
PROC [d: Data, gray:
REAL] ~ {
Debug[d, IO.PutFR1["SetGray (%g)", IO.real[gray]]];
d.sampledColor ¬ NIL;
JaMReal[d, gray];
ImagerOp[d, "setgray"];
};
DoSetColor:
PROC [d: Data, rgb: ImagerColor.
RGB] ~ {
Debug[d, IO.PutFR["SetColor (%g, %g, %g)", IO.real[rgb.R], IO.real[rgb.G], IO.real[rgb.B]]];
d.sampledColor ¬ NIL;
JaMReal[d, rgb.R];
JaMReal[d, rgb.G];
JaMReal[d, rgb.B];
ImagerOp[d, IF d.compact THEN "s" ELSE "setrgbcolor"];
};
MySave:
PROC [context: Context, all:
BOOL]
RETURNS [ref:
REF ¬
NIL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "Save"];
Save[d];
};
MyRestore:
PROC [context: Context, ref:
REF] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "Restore"];
Restore[d];
};
MySetInt:
PROC [context: Context, key: IntKey, val:
INT] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "SetInt"];
SELECT key
FROM
strokeEnd => {
endForEnd: ARRAY [0..3) OF [0..3) ~ [2, 0, 1];
JaMInt[d, endForEnd[val]];
ImagerOp[d, "setlinecap"];
};
strokeJoint => {
joinForJoint: ARRAY [0..3) OF [0..3) ~ [0, 2, 1];
JaMInt[d, joinForJoint[val]];
ImagerOp[d, "setlinejoin"];
};
priorityImportant => NULL;
ENDCASE =>
IF val # 1
THEN {
-- key = 1 doesn't actually occur in the Interpress master
SetInt 0 or 1 (ISET 0 or ISET 1) affects device coordinates (see IPMaster.ImagerVariable);
ISET doesn't make sense without a corresponding IGET.
type: ROPE ¬ SELECT key FROM noImage => "noImage", strokeEnd => "strokeEnd", strokeJoint => "strokeJoint", correctPass => "correctPass", intA => "intA", intB => "intB", intC => "intC", ENDCASE => "?";
Warn[
IO.PutFR["SetInt: key (%g = %g) unimplemented (not significant)",
IO.rope[type], IO.int[val]]];
JaMInt[d, ORD[key]];
JaMInt[d, val];
ImagerOp[d, "% pop pop setint"];
};
};
MySetReal:
PROC [context: Context, key: RealKey, val:
REAL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "SetReal"];
SELECT key
FROM
strokeWidth => {JaMReal[d, val]; ImagerOp[d, "setlinewidth"]};
miterLimit => {JaMReal[d, val]; ImagerOp[d, "setmiterlimit"]};
amplifySpace => NULL;
ENDCASE => {
type: ROPE ¬ SELECT key FROM DCScpx => ".setdcscpx", DCScpy => ".setdcscpy", mediumXSize => ".setmediumxsize", mediumYSize => ".setmediumysize", fieldXMin => ".setfieldxmin", fieldYMin => ".setfieldymin", fieldXMax => ".setfieldxmax", fieldYMax => ".setfieldymax", underlineStart => ".setunderlinestart", correctShrink => ".setcorrectshrink", correctMX => ".setcorrectmx", correctMY => ".setcorrectmy", correctTX => ".setcorrecttx", correctTY => ".setcorrectty", ENDCASE => "?";
Warn[IO.PutFR["SetReal: key (%g = %g) unimplemented", IO.rope[type], IO.real[val]]];
JaMInt[d, ORD[key]];
JaMInt[d, val];
ImagerOp[d, "% pop pop setint"];
};
};
MySetT:
PROC [context: Context, m: Transformation] ~ {
Warn["SetT: unimplemented"]};
d: Data ~ NARROW[context.data];
JaMOp[d, "["];
JaMReal[d, m.a]; JaMReal[d, m.d];
JaMReal[d, m.b]; JaMReal[d, m.e];
JaMReal[d, m.c]; JaMReal[d, m.f];
JaMOp[d, "]"];
ImagerOp[d, ".sett"];
MyGetT:
PROC [context: Context]
RETURNS [m: Transformation] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "GetT"];
m ¬ ImagerTransformation.Scale[1.0];
IF
NOT d.getTDone
AND (d.getTForm ¬ d.getTForm+1) = endIPForm
-- needed?
THEN d.getTForm ¬ firstIPForm;
d.getTDone ¬ TRUE;
m.form ¬ d.getTForm;
};
MySetColor:
PROC [context: Context, color: Color] ~ {
d: Data ~ NARROW[context.data];
WITH color
SELECT
FROM
c: ImagerColor.OpConstantColor =>
IF c.colorOperator.chromatic
THEN DoSetColor[d, ImagerColor.RGBFromColor[c]]
ELSE DoSetGray[d, 1.0-ImagerColorPrivate.GrayFromColor[c]];
c: ImagerColor.SampledBlack => MySetSampledBlack[context, c.pa, c.pa.m, TRUE];
ENDCASE => Warn[IO.PutFR1["SetColor: unimplemented (%g)", IO.refAny[color]]];
};
MyConcatT:
PROC [context: Context, m: Transformation] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "ConcatT"];
IF
NOT ImagerTransformation.Equal[m, identity]
THEN {
PutFactoredTransformation[d, ImagerTransformation.Factor[m]];
ImagerOp[d, "concat"];
ImagerTransformation.ApplyPreConcat[d.T, m];
};
};
MyScale2T:
PROC [context: Context, s:
VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "Scale2T"];
JaMVec[d, s];
ImagerOp[d, "scale"];
ImagerTransformation.ApplyPreScale2[d.T, s];
};
MyRotateT:
PROC [context: Context, a:
REAL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "RotateT"];
JaMReal[d, a];
ImagerOp[d, "rotate"];
ImagerTransformation.ApplyPreRotate[d.T, a];
};
MyTranslateT:
PROC [context: Context, t:
VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "TranslateT"];
JaMVec[d, t];
ImagerOp[d, "translate"];
ImagerTransformation.ApplyPreTranslate[d.T, t];
};
MyMove:
PROC [context: Context, rounded:
BOOL] ~ {
rounded: round to the nearest device grid point
d: Data ~ NARROW[context.data];
Debug[d, "Move"];
ImagerOp[d, "currentpoint translate"];
BUG: loses T
BUG: ignores rounded
};
MySetXY:
PROC [context: Context, p:
VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "SetXY"];
MoveTo[d, p];
};
MySetXYRel:
PROC [context: Context, v:
VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "SetXYRel"];
JaMVec[d, v];
ImagerOp[d, "rmoveto"];
IF d.justifying
AND d.nPieces > 0
AND v.x # 0.0
THEN
rmove has no effect on justification if merely an indent
ImagerOpNeedForMeasure[d, IO.PutFR1["/totwidth /totwidth try %g add def", IO.real[v.x]]];
};
MyStartUnderline:
PROC
[context:
Context]
~
{
d: Data ~ NARROW[context.data];
Debug[d, "StartUnderline"];
ImagerOp[d, "currentpoint /undery exch def /underx exch def"];
};
MyMaskUnderline:
PROC [context: Context, dy, h:
REAL] ~ {
IF h # 0.0
THEN {
-- hmmmm
d: Data ~ NARROW[context.data];
Debug[d, "MaskUnderline"];
dy ¬ 0.5+0.7*dy; -- change of underlining scale for PostScript
d.nPieces ¬ d.nPieces-1; -- if justifying, Show precedes MaskUnderline
ImagerOpNeedForAfter[d, IO.PutFR1["%g setlinewidth", IO.real[h]]];
ImagerOpNeedForAfter[d, "currentpoint currentpoint pop"]; -- stack: x2 y2 x2
ImagerOpNeedForAfter[d, IO.PutFR1["undery %g sub dup underx exch", IO.real[dy]]];
stack: x2 y2 x2 y1' x1 y1'
ImagerOpNeedForAfter[d,
IF d.compact
THEN "v m"
ELSE "
vec moveto"];
-- stack:
NULL
moveto needed?
d.nPieces ¬ d.nPieces+1;
};
};
MyCorrectMask:
PROC [context: Context] ~ {
Warn["CorrectMask: unimplemented: ."]};
MyCorrectSpace:
PROC [context: Context, v:
VEC] ~ {
Warn["CorrectSpace: unimplemented"]};
MySpace:
PROC [context: Context, x:
REAL] ~ {
Warn["Space: unimplemented"]};
MySetGray: PROC [context: Context, f: REAL] ~ {DoSetGray[NARROW[context.data], 1.0-f]};
Image Display Procs
MySetSampledColor:
PROC [
context: Context,
pa: PixelArray,
m: Transformation,
colorOperator: ColorOperator]
~ {
d: Data ~ NARROW[context.data];
um: Transformation ¬ ImagerTransformation.Concat[m, d.T]; -- color to view
d.sampledColor ¬ pa;
d.sampledColorM ¬ um;
d.sampledColorOperator ¬ colorOperator;
Use this `color' for subsequent imaging with MaskRectangle.
};
MySetSampledBlack:
PROC
[context:
Context,
pa:
PixelArray,
m:
Transformation,
clear:
BOOL]
~{
Occurs often in Viewpoint; PostScript does not support sampled colors, so compute a gray.
m: Transformation and clear: BOOL appear irrelevant in computing the gray.
d: Data ~ NARROW[context.data];
nBlack: INT ¬ 0;
Debug[d, IO.PutFR["SetSampledBlack (pa.size = [%g, %g])", IO.int[pa.fSize], IO.int[pa.sSize]]];
FOR s:
INT IN [0..pa.sSize)
DO
FOR f:
INT IN [0..pa.fSize)
DO
IF ImagerPixelArray.Get[pa, 0, s, f] = 0 THEN nBlack ¬ nBlack+1;
ENDLOOP;
ENDLOOP;
DoSetGray[d, REAL[nBlack]/REAL[pa.sSize*pa.fSize]];
};
MyMaskBitmap:
PROC [
context: Context,
bitmap: ImagerSample.SampleMap,
referencePoint: SF.Vec,
scanMode: ImagerTransformation.ScanMode,
position: VEC]
~ {
Warn["MaskBitmap: unimplemented"];
};
MyMaskPixel:
PROC
[context:
Context,
pa:
PixelArray]
~{
d: Data ~ NARROW[context.data];
bits: ARRAY [0..8) OF INTEGER ¬ [128, 64, 32, 16, 8, 4, 2, 1];
f: Factors ¬ ImagerTransformation.Factor[pa.m];
buffer: ImagerSample.SampleBuffer ¬ ImagerSample.ObtainScratchSamples[pa.fSize];
saveNest: INT ¬ d.nest;
nCharsPerLine: INT ¬ IF pa.fSize MOD 8 = 0 THEN pa.fSize/8 ELSE 1+pa.fSize/8;
Debug[d,
IO.PutFLR["MyMaskPixel:
rot1(%g),
scale(%g,
%g),
rot2(%g),
trans(%g,
%g)",
LIST[
IO.real[f.r1], IO.real[f.s.x], IO.real[f.s.y], IO.real[f.r2], IO.real[f.t.x], IO.real[f.t.y]]]];
Save[d];
ImagerOp[d, IO.PutFR1["/picstr %g string def", IO.int[nCharsPerLine]]];
ImagerOp[d, IO.PutFR1["%g rotate", IO.real[f.r1]]];
ImagerOp[d, IO.PutFR["%g %g scale", IO.real[f.s.x], IO.real[-f.s.y]]]; -- n.b.
ImagerOp[d, IO.PutFR["%g %g translate", IO.real[f.t.x], IO.real[f.t.y]]];
ImagerOp[d, IO.PutFR1["%g rotate", IO.real[f.r2]]];
ImagerOp[d, IO.PutFR["%g %g scale", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, IO.PutFR["%g %g 1", IO.int[pa.fSize], IO.int[pa.sSize]]];
Compare the following with SetSampledColor:
ImagerOp[d, IO.PutFR["[%g 0 0 %g 0 0]", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, "{currentfile picstr readhexstring pop}"];
ImagerOp[d, "image"];
d.nest ¬ 0;
FOR s:
INT
IN [0..pa.sSize)
DO
f: INT ¬ 0;
ImagerPixelArray.GetSamples[pa: pa, s: s, f: 0, buffer: buffer, count: pa.fSize];
FOR c:
INT
IN [0..nCharsPerLine)
DO
val: INT ¬ 0;
FOR i:
INT
IN [0..8)
DO
IF f < pa.fSize AND buffer[f] = 0 THEN val ¬ val+bits[i];
f ¬ f+1;
ENDLOOP;
IO.PutChar[d.stream, hex[val/16]];
IO.PutChar[d.stream, hex[val MOD 16]];
ENDLOOP;
IO.PutChar[d.stream, '\n];
ENDLOOP;
d.nest ¬ saveNest;
ImagerSample.ReleaseScratchSamples[buffer];
Restore[d];
};
Path and Mask Procs
MoveTo:
PROC [d: Data, p:
VEC] ~ {
JaMVec[d, p];
ImagerOp[d, IF d.compact THEN "m" ELSE "moveto"];
};
LineTo:
PROC [d: Data, p:
VEC] ~ {
JaMVec[d, p];
ImagerOp[d, IF d.compact THEN "l" ELSE "lineto"];
};
JaMPath:
PROC [d: Data, path: PathProc, close:
PROC] ~ {
moveTo: ImagerPath.MoveToProc ~ {MoveTo[d, p]};
lineTo: ImagerPath.LineToProc ~ {LineTo[d, p1]};
curveTo: ImagerPath.CurveToProc ~ {
JaMVec[d, p1];
JaMVec[d, p2];
JaMVec[d, p3];
ImagerOp[d, "curveto"];
};
ImagerPath.Transform[path,, moveTo, lineTo, curveTo,,, close];
};
MyMaskFill:
PROC [context: Context, path: PathProc, oddWrap:
BOOL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "MaskFill"];
IF d.sampledColor #
NIL
THEN {
Save[d];
JaMPath[d, path, NIL];
ImagerOp[d, "clip newpath"];
this is bogus, in that it does not replicate the color to fill the plane.
DoSampledColor[d, context];
Restore[d];
}
ELSE {
JaMPath[d, path, NIL];
ImagerOp[d, IF oddWrap THEN "eofill" ELSE IF d.compact THEN "f" ELSE "fill"];
};
};
DoSampledColor:
PROC
[d:
Data,
c:
Context]
~
{
this is within scope of a gsave/grestore, so it is free to alter state
pa: PixelArray = d.sampledColor;
pixelToColor: Transformation = pa.m;
colorToView: Transformation = d.sampledColorM;
viewToClient: Transformation = ImagerTransformation.Invert[d.T];
width: INT = pa.fSize;
height: INT = pa.sSize;
imageToPixel: Transformation = ImagerTransformation.XYToSF[
in PS image coordinate system, s points up (height) and f points to the right (width)
scanMode: [slow: up, fast: right],
sSize: pa.sSize,
fSize: pa.fSize
];
imageToClient: Transformation = ImagerTransformation.Cat[
imageToPixel,
pixelToColor,
colorToView,
viewToClient
];
bitsPerSample: INT = 8;
matrix: Transformation = ImagerTransformation.Invert[imageToClient];
multi: ROPE = "false";
ncomp: INT = pa.samplesPerPixel;
colorimage: BOOL = ncomp > 1;
pixels: ImagerPixel.PixelBuffer ¬ ImagerPixel.ObtainScratchPixels[ncomp, width];
ImagerOp[d, IO.PutFR1["/picstr %g string def", IO.int[ncomp*width]]];
JaMInt[d, width];
JaMInt[d, height];
JaMInt[d, bitsPerSample];
PutFactoredTransformation[d, ImagerTransformation.Factor[matrix]];
JaMOp[d, "{currentfile picstr readhexstring pop}"];
IF colorimage
THEN {ImagerOp[d, multi]; JaMInt[d, ncomp]; ImagerOp[d, "colorimage"]}
ELSE ImagerOp[d, "image"];
FOR s:
INT
IN [0..pa.sSize)
DO
ImagerPixelArray.GetPixels[pa, s, 0, pixels, 0, pa.fSize];
FOR f:
INT
IN [0..pa.fSize)
DO
FOR i:
INT
IN [0..pa.samplesPerPixel)
DO
sample: WORD ¬ pixels[i][f];
IO.PutChar[d.stream, hex[sample/16]]; -- high order 4 bits
IO.PutChar[d.stream, hex[sample MOD 16]]; -- low order 4 bits
ENDLOOP;
ENDLOOP;
IO.PutChar[d.stream, '\n];
ENDLOOP;
ImagerPixel.ReleaseScratchPixels[pixels];
};
MyMaskRectangle:
PROC [context: Context, r: Rectangle] ~ {
DoRectangle:
PROC ~ {
PutRectangle[d, r];
ImagerOp[d, IF d.compact THEN "f" ELSE "fill"];
};
d: Data ~ NARROW[context.data];
Debug[d, "MaskRectangle"];
IF d.sampledColor #
NIL
THEN {
Save[d];
PutRectangle[d, r];
ImagerOp[d, "clip newpath"];
DoSampledColor[d, context];
Restore[d];
}
ELSE DoRectangle[];
};
MyMaskRectangleI:
PROC [context: Context, x, y, w, h:
INT] ~ {
MyMaskRectangle[context, [x, y, w, h]];
};
MyMaskStroke:
PROC [context: Context, path: PathProc, closed:
BOOL] ~ {
d: Data ~ NARROW[context.data];
close: PROC ~ {ImagerOp[d, IF closed THEN "closepath stroke" ELSE "stroke"]};
Debug[d, "MaskStroke"];
JaMPath[d, path, close];
};
MyMaskVector:
PROC [context: Context, p1, p2:
VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "MaskVector"];
JaMVec[d, p1];
JaMVec[d, p2];
ImagerOp[d, IF d.compact THEN "v" ELSE "vec"];
};
MyMaskDashedStroke:
PROC [
context: Context,
path: PathProc,
patternLen: NAT,
pattern: PROC [NAT] RETURNS [REAL],
offset, length: REAL]
~ {
d: Data ~ NARROW[context.data];
close: PROC ~ {ImagerOp[d, "stroke [] 0 setdash"]};
f: REAL ← IF length = 0.0 THEN 1.0 ELSE 100.0/length; -- hmmmm....
Debug[d, IO.PutFR1["MaskDashedStroke: length = %g", IO.real[length]]];
ImagerOp[d, "[", FALSE];
FOR i: NAT IN [0..patternLen) DO JaMReal[d, ABS[--f*--pattern[i]]] ENDLOOP;
ImagerOp[d, "]", FALSE];
JaMReal[d, offset];
ImagerOp[d, "setdash"];
JaMPath[d, path, close];
};
MyClip:
PROC [context: Context, path: PathProc, oddWrap:
BOOL, exclude:
BOOL] ~ {
IF exclude
THEN Warn["ExcludeOutline: unimplemented"]
ELSE {
d: Data ~ NARROW[context.data];
JaMPath[d, path, NIL];
ImagerOp[d, "clip newpath"];
};
};
PutRectangle:
PROC [d: Data, r: Rectangle] ~ {
MoveTo[d, [r.x, r.y]];
LineTo[d, [r.x+r.w, r.y]];
LineTo[d, [r.x+r.w, r.y+r.h]];
LineTo[d, [r.x, r.y+r.h]];
};
MyClipRectangle:
PROC [context: Context, r: Rectangle, exclude:
BOOL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "MaskClipRectangle"];
PutRectangle[d, r];
ImagerOp[d, -- IF exclude THEN ".xclippath" ELSE -- "clip newpath"];
};
MyClipRectangleI:
PROC [context: Context, x, y, w, h:
INTEGER, exclude:
BOOL] ~ {
MyClipRectangle[context, [x, y, w, h], exclude];
};
PostScript Imager Class
class: Class ~
NEW [ClassRep ¬ [
type: $Postscript,
Save: MySave,
Restore: MyRestore,
SetInt: MySetInt,
SetReal: MySetReal,
SetT: MySetT,
SetFont: MySetFont,
SetColor: MySetColor,
SetClipper: NIL,
GetInt: NIL,
GetReal: NIL,
GetT: MyGetT,
GetFont: NIL,
GetColor: NIL,
GetClipper: NIL,
ConcatT: MyConcatT,
Scale2T: MyScale2T,
RotateT: MyRotateT,
TranslateT: MyTranslateT,
Move: MyMove,
SetXY: MySetXY,
SetXYRel: MySetXYRel,
Show: MyShow,
ShowBackward: MyShowBackward,
ShowAndFixedXRel: MyShowAndFixedXRel,
ShowText: MyShowText,
StartUnderline: MyStartUnderline,
MaskUnderline: MyMaskUnderline,
CorrectMask: MyCorrectMask,
CorrectSpace: MyCorrectSpace,
Space: MySpace,
SetCorrectMeasure: MySetCorrectMeasure,
SetCorrectTolerance: MySetCorrectTolerance,
Correct: MyCorrect,
DontCorrect: NIL,
SetGray: MySetGray,
SetSampledColor: MySetSampledColor,
SetSampledBlack: MySetSampledBlack,
MaskFill: MyMaskFill,
MaskStroke: MyMaskStroke,
MaskRectangle: MyMaskRectangle,
MaskRectangleI: MyMaskRectangleI,
MaskVector: MyMaskVector,
MaskDashedStroke: MyMaskDashedStroke,
MaskPixel: MyMaskPixel,
MaskBitmap: MyMaskBitmap,
DrawBitmap: ImagerPrivate.DefaultDrawBitmap,
DrawPixels: ImagerPrivate.DefaultDrawPixels,
DoIfVisible: ImagerPrivate.DefaultDoIfVisible,
DoWithBuffer: ImagerPrivate.DefaultDoWithBuffer,
DrawObject: ImagerPrivate.DefaultDrawObject,
GetBounds: ImagerPrivate.DefaultGetBounds,
ViewReset: ImagerPrivate.DefaultViewReset,
ViewTranslateI: ImagerPrivate.DefaultViewTranslateI,
ViewClip: ImagerPrivate.DefaultViewClip,
ViewClipRectangleI: ImagerPrivate.DefaultViewClipRectangleI,
GetTransformation: ImagerPrivate.DefaultGetTransformation,
Transform: ImagerPrivate.DefaultTransform,
MoveViewRectangle: ImagerPrivate.DefaultMoveViewRectangle,
TestViewRectangle: ImagerPrivate.DefaultTestViewRectangle,
Clip: MyClip,
ClipRectangle: MyClipRectangle,
ClipRectangleI: MyClipRectangleI,
GetCP: NIL,
propList: NIL
]];
..
MyMaskPixel:
PROC
[context:
Context,
pa:
PixelArray]
~ {
This takes a lot less file space, but executes much more slowly
nums: ARRAY [0..15] OF CHAR ¬ ['a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n, 'o, 'p];
d: Data ~ NARROW[context.data];
f: Factors ¬ ImagerTransformation.Factor[pa.m];
saveNest: INT ¬ d.nest;
buffer: ImagerSample.SampleBuffer ¬ ImagerSample.ObtainScratchSamples[pa.fSize+3];
buffer[pa.fSize] ¬ buffer[pa.fSize+1] ¬ buffer[pa.fSize+2] ¬ 0;
Debug[d, "MyMaskPixel"];
Save[d];
IO.PutRope[d.stream, "
/putimagestr {
nimage imagelimit lt {
and 0 eq {0} {255} ifelse imagestr nimage 3 -1 roll put
/nimage nimage 1 add def
}
{pop pop} ifelse
} def
/read4bits { % stack: file string
readline % stack: string bool
{
/imagelimit imagestr length def
length 1 sub 0 1 3 -1 roll % stack: string 0 1 length-1
{
dup 4 mul /nimage exch def
filestr exch get 97 sub % stack: char-as-num
dup 8 putimagestr
dup 4 putimagestr
dup 2 putimagestr
dup 1 putimagestr
pop
} for
imagestr % stack: imagestr
}
{0 string} ifelse % stack: nullstring
} bind def\n"];
ImagerOp[d, IO.PutFR["/filestr %g string def", IO.int[1+pa.fSize/4]]];
ImagerOp[d, IO.PutFR["/imagestr %g string def", IO.int[pa.fSize]]];
ImagerOp[d, IO.PutFR["%g %g translate", IO.real[f.t.x], IO.real[f.t.y]]];
ImagerOp[d, IO.PutFR["%g %g scale", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, IO.PutFR["%g %g 8", IO.int[pa.fSize], IO.int[pa.sSize]]];
Compare with SetSampledColor:
ImagerOp[d, IO.PutFR["[%g 0 0 %g 0 0]", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, "{currentfile filestr read4bits}"];
d.nest ¬ 0;
ImagerOp[d, "image"];
FOR y:
INT
IN [0..pa.sSize)
DO
ImagerPixelArray.GetSamples[pa: pa, s: y, f: 0, buffer: buffer, count: pa.fSize];
FOR x:
INT ¬ 0, x+4
WHILE x < pa.fSize
DO
IO.PutChar[d.stream, nums[8*buffer[x]+4*buffer[x+1]+2*buffer[x+2]+buffer[x+3]]];
ENDLOOP;
IO.PutChar[d.stream, '\n];
ENDLOOP;
d.nest ¬ saveNest;
ImagerSample.ReleaseScratchSamples[buffer];
Restore[d];
};
MyMaskPixel:
PROC
[context:
Context,
pa:
PixelArray]
~{
d: Data ~ NARROW[context.data];
f: Factors ¬ ImagerTransformation.Factor[pa.m];
buffer: ImagerSample.SampleBuffer ¬ ImagerSample.ObtainScratchSamples[pa.fSize];
saveNest: INT ¬ d.nest;
Debug[d, "MyMaskPixel"];
Save[d];
ImagerOp[d, IO.PutFR1["/picstr %g string def", IO.int[pa.fSize]]];
ImagerOp[d, IO.PutFR["%g %g translate", IO.real[f.t.x], IO.real[f.t.y]]];
ImagerOp[d, IO.PutFR["%g %g scale", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, IO.PutFR["%g %g 8", IO.int[pa.fSize], IO.int[pa.sSize]]];
Compare the following with SetSampledColor:
ImagerOp[d, IO.PutFR["[%g 0 0 %g 0 0]", IO.int[pa.fSize], IO.int[pa.sSize]]];
ImagerOp[d, "{currentfile picstr readhexstring pop}"];
ImagerOp[d, "image"];
d.nest ¬ 0;
FOR s:
INT
IN [0..pa.sSize)
DO
ImagerPixelArray.GetSamples[pa: pa, s: s, f: 0, buffer: buffer, count: pa.fSize];
FOR f:
INT
IN [0..pa.fSize)
DO
Should really set bps to 1 and pack the chars
IO.PutRope[d.stream, IF buffer[f] = 0 THEN "ff" ELSE "00"]; -- for Weiser
IO.PutRope[d.stream, IF buffer[f] = 0 THEN "00" ELSE "ff"];
ENDLOOP;
IO.PutChar[d.stream, '\n];
ENDLOOP;
d.nest ¬ saveNest;
ImagerSample.ReleaseScratchSamples[buffer];
Restore[d];
};
plainJustify =>
"/justify { % stack: text
dup nsp /ns exch def % stack: text
dup width /totwidth try add % stack: text width
colwidth exch sub % stack: text excess
ns 0 eq {
exch dup 0 exch {1 add} forall % stack: excess text #chars
dup 0 ne {
3 -1 roll exch div 0 % stack: text xcharadd 0
3 -1 roll ashow } if % stack: NULL
}{ % stack: text excess
ns div % stack: text spaceadd
0 8#040 4 -1 roll % stack: spaceadd 0 8#040 text
widthshow /totwidth 0 def % stack: NULL
} ifelse
} bind def",