<<>> <> <> <> <> <> DIRECTORY Ascii, Atom, Char, CharCodeConvert, Convert, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerColorPrivate, ImagerFont, ImagerPath, ImagerPixel, ImagerPixelArray, ImagerPrivate, ImagerSample, ImagerTransformation, ImagerTypeface, IPtoPS, IO, Real, RefText, Rope, SF, Vector2; IPtoPSImpl: CEDAR PROGRAM IMPORTS Atom, Char, CharCodeConvert, Convert, ImagerColor, ImagerColorPrivate, ImagerFont, ImagerPath, ImagerPixel, ImagerPixelArray, ImagerPrivate, ImagerSample, ImagerTransformation, ImagerTypeface, IPtoPS, IO, RefText, Rope EXPORTS Imager, IPtoPS <<>> ~ BEGIN <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> 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; VEC: TYPE ~ Vector2.VEC; 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 Ź [ <> <> <> <> <> <> <
>
<>
<>
040B--32: --,    250B--33:
270B--37:÷--,    331B--38:
327B--42:
306B--47:
305B--52:
267B--57:
263B--62:
250B--67:
313B--72:
277B--77:[--,        317B--78:
302B--82:]--,    273B--83:
272B--87:{--,    264B--88:
250B--92:
300B--97:
253B--102:
353B--107:
250B--112:
250B--117:
250B--122:

greekChars:        ARRAY [65..122] OF BYTE _ [
101B--
107B--
115B--
123B--
131B--
250B--.--,    250B--.--,    141B--
145B--
153B--
161B--
167B--
<>
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] ~ {
<>
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.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];
<>
<>
<>
THEN ImagerOp[d, IO.PutFR["/%g findfont %g scalefont",
IO.rope[psFont.name], IO.real[factors.s.x]]]
ELSE {
ImagerOp[d, IO.PutFR1["/%g findfont", IO.rope[psFont.name]]];
PutFactoredTransformation[d, factors];
ImagerOp[d, "makefont ", FALSE];
};
IF specialEncoding # NIL
THEN {
IF NOT d.compact THEN d.nest Ź d.nest+1;
ImagerOp[d, "dup length dict begin"];
ImagerOp[d, "{1 index /FID ne {def} {pop pop} ifelse} forall"];
ImagerOp[d, IO.PutFR1["/Encoding %g def currentdict", IO.rope[specialEncoding]]];
IF NOT d.compact THEN d.nest Ź d.nest-1;
ImagerOp[d, "end"];
ImagerOp[d, IO.PutFR1["/font%g exch definefont pop", IO.int[id]]];
}
ELSE ImagerOp[d, IO.PutFR1["/font%g exch def", IO.int[id]]];
d.justifying Ź justifying;
};
id: INT Ź 0;
IF d.fonts = NIL
THEN d.fonts Ź LIST[d.font Ź DefineFont[0]]
ELSE FOR l: LIST OF FontRecord Ź d.fonts, l.rest WHILE l # NIL DO
IF FontsEqual[d, l.first.font, font] THEN {d.font Ź l.first; EXIT};
id Ź id+1; 
IF l.rest = NIL THEN {l.rest Ź LIST[d.font Ź DefineFont[id]]; EXIT};
ENDLOOP;
Debug[d, Rope.Concat["DoSetFont: Imager font name = ", FontName[d.font.font]]];
<>
ImagerOp[d, SetFontCommand[d.font]];
IF d.justifying THEN ImagerOpNeedForMeasure[d, SetFontCommand[d.font]];
};
<>
MyCorrect: PROC [context: Context, action: PROC] ~ {
PutPieceProc: PROC [title: ROPE, piece: ROPE, index: INT] ~ {
piece Ź Scrub[piece, d.nest];
ImagerOp[d, IO.PutFR["%g %g", IO.rope[title], IO.int[index]], FALSE];
SELECT Rope.Length[piece] FROM
0 => ImagerOp[d, "null put"];
< 55 => ImagerOp[d, Rope.Cat["{", piece, "} put"]];
ENDCASE => {ImagerOp[d, "{"]; ImagerOp[d, Rope.Concat[piece, "} put"]]};
};
d: Data ~ NARROW[context.data];
<>
<>
<>
<>
buffer: BOOL;
Debug[d, "Correct"];
Save[d];
FOR i: INT IN [(d.nPieces Ź 0)..maxNPieces) DO
d.piece[i] Ź [NIL, NIL, NIL, NIL];
ENDLOOP;
d.justifying Ź TRUE;
action[];
SELECT (buffer Ź d.nPieces > 1) FROM
TRUE => IF NOT d.defined[mixedJustify] THEN Define[d, mixedJustify];
ENDCASE => IF NOT d.defined[plainJustify] THEN Define[d, plainJustify];
d.justifying Ź FALSE;
FOR i: INT IN [0..d.nPieces) DO
txt: ROPE Ź d.piece[i].text;
ImagerOp[d, Scrub[d.piece[i].forMeasure, d.nest]];
IF buffer
THEN PutPieceProc["opsbef", d.piece[i].forBefore, i]
ELSE {
ris: IO.STREAM Ź IO.RIS[d.piece[i].forBefore];
DO
l: ROPE Ź IO.GetLineRope[ris ! IO.EndOfStream => EXIT];
len: INT Ź Rope.Length[l];
IF Rope.SkipOver[l,, " "] < len AND
NOT Rope.Equal["setfont", Rope.Substr[l, len-7], FALSE]
THEN ImagerOp[d, Scrub[l, d.nest]]; -- no buffer, setfont already forMeasure
ENDLOOP;
};
IF buffer
THEN ImagerOp[d, IO.PutFR["(%g) %g buf", IO.rope[txt], IO.int[i]]]
ELSE ImagerOp[d, IO.PutFR1["(%g) justify", IO.rope[txt]]];
IF buffer
THEN PutPieceProc["opsaft", d.piece[i].forAfter, i]
ELSE ImagerOp[d, Scrub[d.piece[i].forAfter, d.nest]];
ENDLOOP;
IF d.nPieces > 1 THEN ImagerOp[d, "mixedjustify"];
Restore[d];
};

MySetCorrectMeasure: PROC [context: Context, v: VEC] ~ {
d: Data ~ NARROW[context.data];
Debug[d, "SetCorrectMeasure"];
IF d.colwidth # v.x THEN ImagerOp[d, IO.PutFR1["/colwidth %g def", IO.real[v.x]]];
d.colwidth Ź v.x;
};

MySetCorrectTolerance: PROC [context: Context, v: VEC] ~ {--Warn["unimplemented"]--};
<>
ShowInner: PROC [d: Data, str: XStringProc, type: ShowType, fixedXRel: REAL Ź 0] ~ {
InvalidChar: PROC [type: ROPE, c: ImagerFont.XChar] ~ {
d.nInvalidChars Ź d.nInvalidChars+1;
Warn[IO.PutFLR["invalid %g char (set %bB, code %bB, name %g)", LIST[
IO.rope[type], IO.int[Char.Set[c]], IO.int[Char.Code[c]],
IO.atom[CharCodeConvert.NameFromXChar[c]]]]];
};
PutStandard: PROC [code: BYTE] ~ {
SetMode[$Standard];
text Ź IF (SELECT code+0C FROM
'\\, '(, '), '" => FALSE, IN [' ..'~] => TRUE, ENDCASE => FALSE)
THEN RefText.AppendChar[text, code+0C]
ELSE RefText.AppendRope[text, IO.PutFR1["\\%03B", IO.int[code]]];
};
PutSpecial: PROC [code: INT, type: ATOM] ~ { -- type = $ISO or $Symbol
DoWithText[text];
SetMode[$Special];
SetSpecialFont[d, type];
DoWithText[RefText.AppendRope[text, IO.PutFR1["\\%03B", IO.int[code]]]];
};
PutOverlay: PROC [c: CHAR, code: INT] ~ {
Debug[d, "overlay"];
DoWithText[text];
SetMode[$Standard];
IF NOT d.defined[overlay] THEN Define[d, overlay];
IF d.justifying
THEN {
<>
IF NOT d.defined[mixedJustify] THEN Define[d, mixedJustify];
ImagerOpNeedForAfter[d, IO.PutFR1["texts arindex get (\\%03B) overlay",
IO.int[code]]];
DoWithText[RefText.AppendChar[text, c]];
}
ELSE ImagerOp[d, IO.PutFR["(%g) show (%g) (\\%03B) overlay",
IO.char[c], IO.char[c], IO.int[code]]];
};
PutMath: PROC [c: ImagerFont.XChar] ~ {
IF Char.Code[c] IN [32..126]
THEN text Ź
RefText.AppendRope[text, IO.PutFR1["\\%03B", IO.int[mathChars[Char.Code[c]]]]]
ELSE PutNamedChar[c, "math"];
};
PutGreek: PROC [c: ImagerFont.XChar] ~ {
code: BYTE _ Char.Code[c];
IF code IN [65..90] OR code IN [97..122]
THEN text Ź
RefText.AppendRope[text, IO.PutFR1["\\%03B", IO.int[greekChars[Char.Code[c]]]]]
ELSE PutNamedChar[c, "greek"];
};
PutChar: PROC [c: ImagerFont.XChar] ~ {
code: BYTE Ź Char.Code[c];
IF Char.Set[c] # 0 OR code NOT IN [0..126] -- OR c.code+0C = '- OR c.code+0C = '$
THEN PutNamedChar[c, "standard"]
ELSE PutStandard[code];
};
PutNamedChar: PROC [c: ImagerFont.XChar, type: ROPE] ~ {
Action: IPtoPS.DoWithCodeProc ~ {
IF code = 0 THEN {InvalidChar[type, c]; code Ź 32};
SELECT encodingVector FROM
isoLatin1 => PutSpecial[code, $ISO];
symbol => PutSpecial[code, $Symbol];
ENDCASE => PutStandard[code];
RETURN[FALSE];
};
name: ATOM Ź CharCodeConvert.NameFromXChar[c];
SELECT name FROM
$Ydieresis, $ydieresis => PutOverlay[Rope.Fetch[Atom.GetPName[name]], 310B];
$Scaron, $scaron => PutOverlay[Rope.Fetch[Atom.GetPName[name]], 317B];
ENDCASE => IPtoPS.DoWithCode[name, Action];
Debug[d, IO.PutFR["non-standard char, set = %g, code = %g, name = %g",
IO.int[Char.Set[c]], IO.int[Char.Code[c]], IO.atom[name]]];
};
DoWithText: PROC [text: REF TEXT] ~ {
IF text.length # 0 THEN SELECT TRUE FROM
d.justifying => {
d.piece[d.nPieces].text Ź Rope.FromRefText[text];
<>
<>
<>
IF Rope.Find[d.piece[d.nPieces].forBefore, "setfont"] = -1
THEN ImagerOp[d, SetFontCommand[d.font]];
d.nPieces Ź d.nPieces+1;
};
type = backward => {
FOR i: INT IN [0..text.length/2) DO
temp: CHAR Ź text[i];
text[i] Ź text[text.length-i-1];
text[text.length-i-1] Ź temp;
ENDLOOP;
IF NOT d.defined[showbackward] THEN Define[d, showbackward];
ImagerOp[d, IO.PutFR1["(%g) showbackward", IO.text[text]]];
};
ENDCASE => ImagerOp[d, IO.PutFR1["(%g) show", IO.text[text]]];
Debug[d, IO.PutFR["dowithtext: (%g), font = %g",
IO.text[text], IO.rope[FontName[d.font.font]]]];
text.length Ź 0;
};
SetMode: PROC [a: ATOM] ~ {
IF mode # a THEN SELECT (mode Ź a) FROM
$Special => saveFont Ź d.font.font; -- restore saveFont when done with Special
$Standard => DoSetFont[d, saveFont];
ENDCASE;
};
text: REF TEXT Ź RefText.ObtainScratch[1000];
saveFont: Font Ź NIL;
mode: ATOM Ź $Standard;
str[SELECT d.font.type FROM $Greek => PutGreek, $Math => PutMath, ENDCASE => PutChar];
IF type # normal AND type # backward THEN
Warn[IO.PutFR["Can't show \"%g\" (type = %g)",
IO.rope[RefText.TrustTextAsRope[text]],
IO.rope[SELECT type FROM xRel=>"xRel",fixedXRel=>"fixedXRel",ENDCASE=>"backward"]]];
DoWithText[text];
RefText.ReleaseScratch[text];
};

TextFromString: PROC [string: XStringProc] RETURNS [text: REF TEXT] ~ {
CharPut: PROC [c: ImagerFont.XChar] ~ {text Ź RefText.AppendChar[text, Char.Code[c]+0C]};
text Ź RefText.ObtainScratch[1000];
string[CharPut];
};

MyShow: PROC [context: Context, string: XStringProc, xrel: BOOL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, IO.PutFR1["Show (%g)", IO.text[TextFromString[string]]]];
ShowInner[d, string, IF xrel THEN xRel ELSE normal];
};

MyShowAndFixedXRel: PROC [context: Context, string: XStringProc, x: REAL] ~ {
d: Data ~ NARROW[context.data];
Debug[d, IO.PutFR1["ShowAndFixedXRel (%g)", IO.text[TextFromString[string]]]];
ShowInner[d, string, fixedXRel, x];
};

MyShowBackward: PROC [context: Context, string: XStringProc] ~ {
d: Data ~ NARROW[context.data];
Debug[d, IO.PutFR1["ShowBackward (%g)", IO.text[TextFromString[string]]]];
ShowInner[d, string, backward];
};

MyShowText: PROC [context: Context, text: REF READONLY TEXT, start, len: NAT, xrel: BOOL]
~ {
string: XStringProc ~ {ImagerFont.MapText[text, start, len, charAction]};
MyShow[context, string, xrel];
};
<>
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
<>
<>
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]]];
<>
<>
<>
};
};

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]]];
<>
<>
<>
};
};

MySetT: PROC [context: Context, m: Transformation] ~ {Warn["SetT: unimplemented"]};
<>
<>
<>
<>
<>
<>
<>
<<>>
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] ~ {
<>
d: Data ~ NARROW[context.data];
Debug[d, "Move"];
ImagerOp[d, "currentpoint translate"];
<>
<>
};

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
<>
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]]];
<>
ImagerOpNeedForAfter[d, IF d.compact THEN "v m" ELSE "vec moveto"]; -- stack: NULL
<>
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]};
<>
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;
<>
};

MySetSampledBlack: PROC [context: Context, pa: PixelArray, m: Transformation, clear: BOOL] ~{
<>
<>
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.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.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]]];
<>
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];
};
<>
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"];
<>
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] ~ {
<>
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[
        <>
        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"]};
<>
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];
};
<>
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
]];

END.
..

MyMaskPixel: PROC [context: Context, pa: PixelArray] ~ {
<>
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]]];
<>
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]]];
<>
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
<>
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];
};

<>>
<<"/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",>>