GGParseImpl.mesa
Last edited by Bier, January 22, 1992 11:00 am PST
Copyright Ó 1986, 1989 by Xerox Corporation. All rights reserved.
Contents: Routines which turn various Gargoyle data structures into Rope.ROPEs and write them onto a file stream.
Pier, November 20, 1990 3:52 pm PST
Maureen Stone, June 25, 1987 2:56:07 pm PDT
Doug Wyatt, September 14, 1989 4:03:00 pm PDT
Michael Plass, September 18, 1989 11:15:32 am PDT
DIRECTORY
Convert, Feedback, GGBoundBox, GGColorOps, GGCoreOps, GGCoreTypes, GGParseIn, GGParseOut, Imager, ImagerColor, ImagerColorES, ImagerColorFns, ImagerColorPrivate, ImagerDeviceVector, ImagerInterpress, ImagerPrivate, ImagerState, ImagerTransformation, Interpress, IO, PutGet, RefText, Rope, SimpleFeedback, SymTab, TextNode;
GGParseImpl: CEDAR PROGRAM
IMPORTS Convert, Feedback, GGBoundBox, GGColorOps, GGCoreOps, Imager, ImagerColor, ImagerColorES, ImagerColorFns, ImagerColorPrivate, ImagerInterpress, ImagerState, ImagerTransformation, Interpress, IO, PutGet, RefText, Rope, SimpleFeedback, SymTab
EXPORTS GGParseOut, GGParseIn, Imager, ImagerColor, GGColorOps =
BEGIN
BoundBox: TYPE = GGCoreTypes.BoundBox;
Color: TYPE = Imager.Color;
Point: TYPE = Imager.VEC;
RopeListt: TYPE = GGCoreTypes.RopeListt;
SequenceOfReal: TYPE = REF SequenceOfRealObj;
SequenceOfRealObj: TYPE = GGCoreTypes.SequenceOfRealObj;
StrokeEnd: TYPE = Imager.StrokeEnd;
StrokeJoint: TYPE = Imager.StrokeJoint;
Class: TYPE ~ REF ClassRep;
ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; -- export to Imager.ClassRep
PixelProc: TYPE ~ ImagerColorPrivate.PixelProc;
State: TYPE ~ REF StateRep;
StateRep: PUBLIC TYPE ~ ImagerState.StateRep;
TupleProc: TYPE ~ ImagerColorPrivate.TupleProc;
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = Feedback.Problem;
ColorType: TYPE = GGColorOps.ColorType;
OperatorType: TYPE = GGColorOps.OperatorType;
ColorOperator: TYPE = ImagerColor.ColorOperator;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
CMYK: TYPE = ImagerColorFns.CMYK;
ColorOperatorClassRep: PUBLIC TYPE ~ ImagerColorPrivate.ColorOperatorClassRep;
Output
WriteColor: PUBLIC PROC [f: IO.STREAM, color: Color] = {
Encoding:
0: Red, Green, Blue triple
1: Grey value
2: Special Color
3: Sampled Black (?)
4: Sampled Color (?)
gray: ImagerColor.OpConstantColor ← ImagerColor.ColorFromGray[1];
IF color=NIL THEN f.PutRope["[]"]
ELSE {
cc: ImagerColor.ConstantColor ← NARROW[color];
f.PutChar['[];
WITH color SELECT FROM
op: ImagerColor.OpConstantColor => {
SELECT GetOperatorType[GetColorType[op].op] FROM
grayLinear, grayDensity, grayVisual => { --put out "MakeGray"
val: REAL;
WriteNAT[f, 1];
val ← ImagerColorPrivate.IntensityFromColor[op];
f.PutF[" %g]", [real[1.0 - val]]];
};
map, buildMap, rgbLinear, xeroxRgbLinear, colorMap => { -- put out an RGB
r, g, b: REAL;
WriteNAT[f, 0];
[r,g,b] ← GGCoreOps.ExtractRGB[op];
f.PutF[" %g %g %g]", [real[r]], [real[g]], [real[b]]];
};
cmyk => {
cmyk: CMYK;
WriteNAT[f, 5];
cmyk ← CMYKFromColor[op];
f.PutF[" %g %g %g %g]", [real[cmyk.C]], [real[cmyk.M]], [real[cmyk.Y]], [real[cmyk.K]] ];
};
yesLinear => {
yes: ImagerColorES.YES;
WriteNAT[f, 6];
yes ← ImagerColorES.YESFromColor[op];
f.PutF[" %g %g %g]", [real[yes.Y]], [real[yes.E]], [real[yes.S]] ];
};
ENDCASE => ERROR;
};
special: ImagerColor.SpecialColor => {
WriteNAT[f, 2];
f.PutF[" %g]", [rope[special.name]]];
};
sampledBlack: ImagerColor.SampledBlack => {
WriteNAT[f, 3];
f.PutChar[IO.SP];
WriteSampledColor[f, sampledBlack];
f.PutChar[']];
};
sampledColor: ImagerColor.SampledColor => {
WriteNAT[f, 4];
f.PutChar[IO.SP];
WriteSampledColor[f, sampledColor];
f.PutChar[']];
};
ENDCASE => { --black rectangles for sampled colors
WriteNAT[f, 1];
f.PutF[" %g]", [real[0]]];
};
};
};
ExtractCMYK: PUBLIC PROC [color: ImagerColor.ConstantColor] RETURNS [c,m,y,k: REAL] = {
cmyk: ImagerColorFns.CMYK;
op: ImagerColor.OpConstantColor;
IF color=NIL THEN ERROR Problem["NIL color for ExtractCMYK"];
op ← NARROW[color];
cmyk ← GGColorOps.CMYKFromColor[op];
c ← cmyk.C; m ← cmyk.M; y ← cmyk.Y; k ← cmyk.K;
};
ExtractIntensity: PUBLIC PROC [color: ImagerColor.ConstantColor] RETURNS [intensity: REAL] = {
IF color=NIL THEN ERROR Problem["NIL color for ExtractIntensity"];
intensity ← ImagerColorPrivate.IntensityFromColor[color];
};
RopeFromOpType: ARRAY OperatorType OF ROPE ← [
grayLinear: "Xerox/GrayLinear",
grayDensity: "Xerox/GrayDensity",
grayVisual: "Xerox/GrayVisual",
map: "Xerox/Map",
buildMap: "Xerox/BuildMap",
rgbLinear: "Xerox/Research/RGBLinear",
xeroxRgbLinear: "Xerox/RGBLinear",
colorMap: "Xerox/Research/ColorMap",
cmyk: "Xerox/Research/CMYK",
yesLinear: "Xerox/YESLinear",
cielab: "Xerox/CIELAB",
highlightLinear: "Xerox/HighlightLinear",
process: "Xerox/Process",
highlight: "Xerox/Highlight"
];
GetColorType: PUBLIC PROC [color: ImagerColor.Color] RETURNS [type: ColorType, op: ColorOperator] ~ {
ColorOperator will be NIL for specialColor and sampledBlack
WITH color SELECT FROM
color: ImagerColor.OpConstantColor => {type ← constantOp; op ← color.colorOperator};
color: ImagerColor.SpecialColor => {type ← constantSpecial; op ← NIL};
color: ImagerColor.SampledColor => {type ← sampled; op ← color.colorOperator};
color: ImagerColor.SampledBlack => {type ← sampledBlack; op ← NIL};
ENDCASE => ERROR;
};
GetOperatorType: PUBLIC PROC [op: ColorOperator] RETURNS [OperatorType] ~ {
The names are defined in the implementation of the class. All but CMYK are defined in ImagerColorImpl. CMYK is defined in ImagerColorFnsImpl
class: REF ColorOperatorClassRep ← op.class;
type: OperatorType ← SELECT TRUE FROM
Rope.Equal[class.name, "Xerox/GrayLinear"] => grayLinear,
Rope.Equal[class.name, "Xerox/GrayDensity"] => grayDensity,
Rope.Equal[class.name, "Xerox/GrayVisual"] => grayVisual,
Rope.Equal[class.name, "Xerox/Map"] => map,
Rope.Equal[class.name, "Xerox/BuildMap"] => buildMap,
Rope.Equal[class.name, "Xerox/Research/RGBLinear"] => rgbLinear,
Rope.Equal[class.name, "Xerox/RGBLinear"] => xeroxRgbLinear,
Rope.Equal[class.name, "Xerox/Research/ColorMap"] => colorMap,
Rope.Equal[class.name, "Xerox/Research/CMYK"] => cmyk,
Rope.Equal[class.name, "Xerox/YESLinear"] => yesLinear,
Rope.Equal[class.name, "Xerox/CIELAB"] => cielab,
Rope.Equal[class.name, "Xerox/HighlightLinear"] => highlightLinear,
Rope.Equal[class.name, "Xerox/Process"] => process,
Rope.Equal[class.name, "Xerox/Highlight"] => highlight
ENDCASE => ERROR;
RETURN[type];
};
A color operator includes a list of atoms that define the type of color values it can produce.
Conventionally, all color operators can produce intensity ($Y) and rgb ($RGB)
ImagerColorPrivate IntensityFromColor and RGBFromColor will produce these values.
Only the CMYK color model understands the $CMYK atom, so only colors whose color operators
are type cmyk should be asked to produce it (the printing software, rather than the color
operator, does the RGB to CMYK transformation when printing)
CMYKFromColor: PUBLIC PROC [color: ImagerColor.OpConstantColor] RETURNS [cmyk: CMYK] = {
Only works for the CMYK color model so check the type first
IF ImagerColorPrivate.SupportsOutput[color.colorOperator, $CMYK] THEN {
set primaries directly, no color correction
pixelIn: PixelProc ~ { RETURN[color.pixel[i]] };
tupleAction: PROC [tupleOut: TupleProc] ~ {
cmyk ← [C: tupleOut[0], M: tupleOut[1], Y: tupleOut[2], K: tupleOut[3]];
};
ImagerColorPrivate.TupleFromPixel[color.colorOperator,
[type: $CMYK, samplesPerPixelOut: 4], pixelIn, tupleAction];
}
ELSE ERROR Problem["CMYKFromColor called with non-CMYK color"];
};
YESFromColor: PROC [c: Color] RETURNS [yes: ImagerColorES.YES] ~ BEGIN
Exerpted from ImagerColorESImpl.
WITH c SELECT FROM
sc: ImagerColor.SpecialColor =>
IF (sc.substitute # NIL) THEN yes ← YESFromColor [sc.substitute]
ELSE ERROR Imager.Error [[$noSubstituteColor, "No substitute for SpecialColor"]];
cc: ImagerColor.OpConstantColor => BEGIN
PixelIn: PixelProc ~ { RETURN [cc.pixel[i]] };
YesAction: PROC [tupleOut: TupleProc] ~
{ yes ← [Y: tupleOut[0], E: tupleOut[1], S: tupleOut[2]] };
IF ImagerColorPrivate.SupportsOutput[cc.colorOperator, $YES] THEN
ImagerColorPrivate.TupleFromPixel [cc.colorOperator, [type: $YES, samplesPerPixelOut: 3], PixelIn, YesAction]
ELSE ERROR Problem["YESFromColor called with non-YES color"];
END;
ENDCASE => ERROR Imager.Error [[$wrongType, "Wrong type (expected ConstantColor)"]]
END; -- YESFromColor
WritePixelArray: PUBLIC PROC [f: IO.STREAM, pa: Imager.PixelArray] = {
Write a description of yourself onto stream f.
ipRef: ImagerInterpress.Ref;
masterStream: IO.STREAM;
masterSize: CARD;
masterRope: Rope.ROPE;
IF pa = NIL THEN f.PutRope["0"]
ELSE {
MaskPixelArray: PROC [dc: Imager.Context] = {
Imager.MaskPixel[dc, pa];
};
Write the interpress into a Rope.ROPE.
masterStream ← IO.ROS[];
ipRef ← ImagerInterpress.CreateFromStream[masterStream, "Interpress/Xerox/3.0 "];
ImagerInterpress.DoPage[ipRef, MaskPixelArray];
ImagerInterpress.Finish[ipRef];
masterRope ← masterStream.RopeFromROS[];
masterSize ← Rope.Length[masterRope];
Send the rope to stream f.
f.PutF["%g\n", [integer[masterSize]]];
f.PutRope[masterRope];
};
};
WriteSampledColor: PROC [f: IO.STREAM, sColor: Imager.Color] = {
Write a description of yourself onto stream f.
ipRef: ImagerInterpress.Ref;
masterStream: IO.STREAM;
masterSize: CARD;
masterRope: Rope.ROPE;
SetTheColor: PROC [dc: Imager.Context] = {
Imager.SetColor[dc, sColor];
};
Write the interpress into a Rope.ROPE.
masterStream ← IO.ROS[];
ipRef ← ImagerInterpress.CreateFromStream[masterStream, "Interpress/Xerox/3.0 "];
ImagerInterpress.DoPage[ipRef, SetTheColor];
ImagerInterpress.Finish[ipRef];
masterRope ← masterStream.RopeFromROS[];
masterSize ← Rope.Length[masterRope];
Send the rope to stream f.
f.PutF["%g\n", [integer[masterSize]]];
f.PutRope[masterRope];
};
WriteNAT: PROC [f: IO.STREAM, val: NAT] = {
f.PutF["%g", [integer[val]]];
};
WriteStrokeEnd: PUBLIC PROC [f: IO.STREAM, strokeEnd: StrokeEnd] = {
rope: Rope.ROPE;
SELECT strokeEnd FROM
round => rope ← "round";
square => rope ← "square";
butt => rope ← "butt";
ENDCASE => ERROR;
f.PutRope[rope];
};
WriteStrokeJoint: PUBLIC PROC [f: IO.STREAM, strokeJoint: StrokeJoint] = {
rope: Rope.ROPE;
SELECT strokeJoint FROM
round => rope ← "round";
miter => rope ← "miter";
bevel => rope ← "bevel";
ENDCASE => ERROR;
f.PutRope[rope];
};
WritePoint: PUBLIC PROC [f: IO.STREAM, point: Point] = {
f.PutF["[%g,%g]", [real[point.x]], [real[point.y]]];
};
WriteTransformation: PUBLIC PROC [f: IO.STREAM, transform: ImagerTransformation.Transformation] = {
f.PutF["[%g %g %g ", [real[transform.a]], [real[transform.b]], [real[transform.c]]];
f.PutF["%g %g %g]", [real[transform.d]], [real[transform.e]], [real[transform.f]]];
};
WriteFactoredTransformation: PUBLIC PROC [f: IO.STREAM, transform: ImagerTransformation.Transformation] = {
Represents Cat[Rotate[r1], Scale2[s], Rotate[r2], Translate[t]].
Gargoyle file format "[r1: REAL s: [REAL REAL] r2: REAL t: [REAL REAL] ]"
factored: ImagerTransformation.FactoredTransformation ← ImagerTransformation.Factor[transform];
f.PutF["[r1: %g s: [%g %g] ", [real[factored.r1]], [real[factored.s.x]], [real[factored.s.y]] ];
f.PutF["r2: %g t: [%g %g]]", [real[factored.r2]], [real[factored.t.x]], [real[factored.t.y]]];
};
WriteFactoredTransformationVEC: PUBLIC PROC [f: IO.STREAM, transform: ImagerTransformation.Transformation] = {
Like WriteFactoredTransformation but suppresses the translation component
factored: ImagerTransformation.FactoredTransformation ← ImagerTransformation.Factor[transform];
f.PutF["[r1: %g s: [%g %g] r2: %g]", [real[factored.r1]], [real[factored.s.x]], [real[factored.s.y]], [real[factored.r2]] ];
};
WriteBox: PUBLIC PROC [f: IO.STREAM, box: BoundBox] = {
IF box.null THEN { f.PutRope["[0 0 -1 0]"]; RETURN};
IF box.infinite THEN { f.PutRope["[0 0 0 -1]"]; RETURN};
f.PutF["[%g %g %g %g]", [real[box.loX]], [real[box.loY]], [real[box.hiX]], [real[box.hiY]]];
};
WriteBool: PUBLIC PROC [f: IO.STREAM, bool: BOOL] = {
IF bool THEN f.PutRope["T"] ELSE f.PutRope["F"];
};
WriteListOfRope: PUBLIC PROC [f: IO.STREAM, ropes: LIST OF Rope.ROPE] = {
IF ropes = NIL THEN RETURN;
f.PutRope[ropes.first];
FOR list: LIST OF Rope.ROPE ← ropes.rest, list.rest UNTIL list = NIL DO
f.PutRope[", "];
f.PutRope[list.first];
ENDLOOP;
};
WriteProps: PUBLIC PROC [f: IO.STREAM, props: LIST OF REF ANY] = {
f.PutChar[IO.SP];
FOR name: LIST OF REF ANY ← props, name.rest UNTIL name=NIL DO
f.PutRope[NARROW[name.first]]; f.PutChar[IO.SP];
ENDLOOP;
};
WriteArrayOfReal: PUBLIC PROC [f: IO.STREAM, reals: SequenceOfReal] = {
f.PutChar['[];
IF reals.len > 0 THEN f.PutF["%g", [real[reals[0]]]];
FOR i: NAT IN [1..reals.len) DO
f.PutF[" %g", [real[reals[i]]]];
ENDLOOP;
f.PutChar[']];
};
WriteScalarButtonValues: PUBLIC PROC [f: IO.STREAM, names: LIST OF Rope.ROPE, values: LIST OF REAL, on: LIST OF BOOL] = {
Writes out a list of button values in the form:
[F 4.0 4] [F 2.0 2] [F 1.0 1] [F 0.75 3/4] ...
IF values # NIL THEN {
f.PutF["[%g %g", IF on.first THEN [character['T]] ELSE [character['F]], [real[values.first]] ];
IF names#NIL AND names.first#NIL THEN f.PutF[" %g", [rope[names.first]] ];
f.PutChar[']];
FOR thisValue: LIST OF REAL ← values.rest, thisValue.rest UNTIL thisValue = NIL DO
on ← on.rest; -- move down list of BOOLs
IF names#NIL THEN names ← names.rest; -- move down list of names
f.PutF[" [%g %g", IF on.first THEN [character['T]] ELSE [character['F]], [real[thisValue.first]] ];
IF names#NIL AND names.first#NIL THEN f.PutF[" %g", [rope[names.first]] ];
f.PutChar[']];
ENDLOOP;
};
};
WriteText: PUBLIC PROC [f: IO.STREAM, text: TextNode.Ref, screenStyle: BOOL] = {
f.PutF["%g ", [rope[IF screenStyle THEN "T" ELSE "F"]] ];
IF text=NIL THEN f.PutF["%g ", [integer[0]] ] -- byte count of 0 => no text
ELSE {
r: Rope.ROPE ← PutGet.ToRope[text].output;
f.PutF["%g ", [integer[Rope.Length[r]]] ];
f.PutRope[r]; -- for fast, big ropes
};
};
Input
Routines for reading gargoyle data structures from a stream.
SyntaxError: PUBLIC SIGNAL [position: NAT, wasThere: Rope.ROPE, notThere: Rope.ROPE] = CODE;
ReadText: PUBLIC PROC [f: IO.STREAM, version: REAL] RETURNS [text: TextNode.Ref, screenStyle: BOOL] = {
fillText: Rope.ROPE;
nodeSize: CARD ← 0;
[screenStyle, ----] ← ReadBool[f, version]; -- read screenStyle. Better be good.
nodeSize ← ReadWCARD[f]; -- read number of chars in node
IF nodeSize=0 THEN RETURN[NIL, screenStyle];
IF f.PeekChar[]= ' THEN []← f.GetChar[]; -- don't ask. Leave this in.
fillText ← f.GetRope[nodeSize, TRUE];
text ← PutGet.FromRope[fillText];
};
ReadBlank: PUBLIC PROC [f: IO.STREAM] = {
Reads, <SPACE>'s, <CR>'s, and <TAB>'s until something else is encountered. Doesn't mind if no white space characters are found. Treats comments as white space.
[] ← IO.SkipWhitespace[f, TRUE];
};
ReadWhiteSpace: PUBLIC PROC [f: IO.STREAM] = {
Reads, <SPACE>'s, <CR>'s, and <TAB>'s until something else is encountered. Signals SyntaxError if no white space characters are found.
WhiteSpaceProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
IO.TAB => RETURN [other];
IO.LF =>RETURN [other];
IO.CR =>RETURN [other];
IO.SP => RETURN [other];
ENDCASE => RETURN [break];
};
whiteSpace: Rope.ROPE;
end: BOOLFALSE;
[whiteSpace, ----] ← IO.GetTokenRope[f, WhiteSpaceProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end OR Rope.Size[whiteSpace] = 0 THEN SIGNAL SyntaxError[IO.GetIndex[f], "null", "<whitespace>"];
};
ReadHorizontalBlank: PUBLIC PROC [f: IO.STREAM] RETURNS [good: BOOL] = {
Reads <SPACE>'s, and <TABS>'s until something else is encountered. Returns good = FALSE if a CR is encountered before anything else
HorizontalBlankProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
IO.TAB, IO.SP => RETURN [other];
ENDCASE => RETURN [break];
};
whiteSpace: Rope.ROPE;
c: CHAR;
end: BOOLFALSE;
good ← TRUE;
[whiteSpace, ----] ← IO.GetTokenRope[f, HorizontalBlankProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {good ← FALSE; RETURN};
c ← Rope.Fetch[whiteSpace, 0];
SELECT c FROM
IO.CR, IO.LF => {good ← FALSE; RETURN};
IO.TAB, IO.SP => {good ← TRUE; RETURN};
ENDCASE => {good ← TRUE; IO.Backup[f, c]; RETURN};
};
ReadWord: PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
Used to read in a rope which is data.
WordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
IO.TAB => RETURN [break];
IO.LF =>RETURN [break];
IO.CR =>RETURN [break];
IO.SP => RETURN [break];
', => RETURN [break];
'] => RETURN [break];
') => RETURN [break];
ENDCASE => RETURN [other];
};
[word, ----] ← IO.GetTokenRope[f, WordBreakProc
!IO.EndOfStream => {word ← NIL; CONTINUE}];
};
ReadWWord: PUBLIC PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
[] ← IO.SkipWhitespace[f, TRUE];
word ← ReadWord[f];
};
ReadRope: PROC [f: STREAM, rope: Rope.ROPE] = {
Removes the given rope from the top of the stream. Used to remove formatting phrases from files. We are not interested in these strings but only in the data in between them.
Signals SyntaxError if some other rope is on top.
got: ROPE;
endofstream: BOOLFALSE;
got ← f.GetRope[len: Rope.Length[rope], demand: TRUE
! IO.EndOfStream => {endofstream ← TRUE; CONTINUE}];
IF endofstream THEN
SIGNAL SyntaxError [IO.GetIndex[f], NIL, rope];
IF NOT Rope.Equal[rope, got, TRUE] THEN SIGNAL SyntaxError [IO.GetIndex[f], got, rope];
};
ReadWRope: PUBLIC PROC [f: IO.STREAM, rope: Rope.ROPE] = {
[] ← IO.SkipWhitespace[f, TRUE];
ReadRope[f, rope];
};
ReadLine: PUBLIC PROC [f: IO.STREAM] RETURNS [line: Rope.ROPE] = {
Reads a rope UNTIL <CR> is encountered.
LineBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
IO.CR, IO.LF =>RETURN [break];
ENDCASE => RETURN [other];
};
end: BOOLFALSE;
[line, ----] ← IO.GetTokenRope[f, LineBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {line ← NIL; RETURN};
IF Rope.Equal[line, "\n"] THEN {line ← NIL; RETURN} -- nothing on this line
IF Rope.Equal[line, "\r"] OR Rope.Equal[line, "\l"] THEN {line ← NIL; RETURN} -- nothing on this line
ELSE [----, ----] ← IO.GetTokenRope[f, LineBreakProc]; -- remove trailing <CR>
};
ReadChar: PUBLIC PROC [f: IO.STREAM, c: CHAR] = {
streamC: CHAR;
[] ← IO.SkipWhitespace[f, TRUE];
streamC ← IO.GetChar[f];
IF NOT c = streamC THEN SIGNAL SyntaxError[IO.GetIndex[f], Rope.FromChar[streamC], Rope.FromChar[c]];
};
ReadKeyWord: PUBLIC PROC [f: IO.STREAM] RETURNS [keyWord: Rope.ROPE, good: BOOL] = {
Reads a rope until a ':' or <CR> are encountered. If CR is encountered first, then good is FALSE since ":" is expected after a keyword.
KeyWordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
IO.CR, IO.LF =>RETURN [break];
': => RETURN [break];
ENDCASE => RETURN [other];
};
end: BOOLFALSE;
nextChar: Rope.ROPE;
[keyWord, ----] ← IO.GetTokenRope[f, KeyWordBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {good ← FALSE; keyWord ← NIL; RETURN};
[nextChar, ----] ← IO.GetTokenRope[f, KeyWordBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {good ← FALSE; RETURN};
good ← Rope.Equal[nextChar, ":", TRUE];
};
ReadNAT: PROC [f: IO.STREAM] RETURNS [n: NAT] = {
Reads digits up to the next ], <CR>, <SPACE>. Leaves these terminators on the stream.
end: BOOLFALSE;
intRope: Rope.ROPE;
[intRope, ----] ← IO.GetTokenRope[f, NATBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {n ← 1; RETURN};
n ← Convert.IntFromRope[intRope ! Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR["Couldn't convert %g to an INT", [rope[intRope]]], notThere: NIL]};];
};
NATBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
'], IO.CR, IO.LF, IO.SP, IO.TAB, '., ',, ': => RETURN [break];
ENDCASE => RETURN [other];
};
ReadCARD: PROC [f: IO.STREAM] RETURNS [n: CARD] = {
Reads digits up to the next ], <CR>, <SPACE>. Leaves these terminators on the stream.
end: BOOLFALSE;
cardRope: Rope.ROPE;
[cardRope, ----] ← IO.GetTokenRope[f, NATBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {n ← 1; RETURN};
n ← Convert.CardFromRope[cardRope
!Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR["Couldn't convert %g to a CARD", [rope[cardRope]]], notThere: NIL]};];
};
ReadWNAT: PUBLIC PROC [f: IO.STREAM] RETURNS [n: NAT] = {
A convenience function.
[] ← IO.SkipWhitespace[f, TRUE];
n ← ReadNAT[f];
};
ReadWCARD: PUBLIC PROC [f: IO.STREAM] RETURNS [n: CARD] = {
A convenience function.
[] ← IO.SkipWhitespace[f, TRUE];
n ← ReadCARD[f];
};
ReadReal: PUBLIC PROC [f: IO.STREAM] RETURNS [r: REAL] = {
Reads digits up to the next ), ], <CR>, <SPACE> or <COMMA>. Leaves these terminators on the stream.
RealBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
'), '], ', => RETURN [break];
IO.CR, IO.LF, IO.SP, IO.TAB => RETURN [break];
ENDCASE => RETURN [other];
};
realText, buffer: REF TEXT;
end: BOOLFALSE;
buffer ← RefText.ObtainScratch[50];
[realText, ----] ← IO.GetToken[f, RealBreakProc, buffer
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {r ← 0.0; RETURN};
IF RefText.Find[realText, ".", 0, FALSE] = -1 THEN realText ← RefText.Append[realText, ".0"];
r ← Convert.RealFromRope[RefText.TrustTextAsRope[realText] !
Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR["Couldn't convert %g to a REAL", [rope[RefText.TrustTextAsRope[realText]]]], notThere: NIL]};
];
RefText.ReleaseScratch[buffer];
};
ReadWReal: PUBLIC PROC [f: IO.STREAM] RETURNS [r: REAL] = {
A convenience function. Equivalent to ReadBlank[f]; r ← ReadReal[f];
[] ← IO.SkipWhitespace[f, TRUE];
r ← ReadReal[f];
};
ReadWUpToEndBracket: PROC [f: IO.STREAM] RETURNS [expr: Rope.ROPE] = {
CloseBracketProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
SELECT char FROM
'] =>RETURN [break];
ENDCASE => RETURN [other];
};
[] ← IO.SkipWhitespace[f, TRUE];
[expr, ----] ← IO.GetTokenRope[f, CloseBracketProc];
RETURN[IF Rope.Equal[expr, "]"] THEN NIL ELSE expr];
};
OpConstantColor: TYPE ~ ImagerColor.OpConstantColor;
ReadColor: PUBLIC PROC [f: IO.STREAM, version: REAL] RETURNS [color: Color] = {
s: IO.STREAM;
word: Rope.ROPE;
ReadBlack: PROC [stream: IO.STREAM] = {
found: BOOLFALSE;
val: SymTab.Val;
grayRope: Rope.ROPE ← ReadWUpToEndBracket[stream];
[found, val] ← SymTab.Fetch[colorTab, grayRope];
IF found THEN color ← NARROW[val] ELSE {
grayStream: IO.STREAMIO.RIS[rope: grayRope];
level: REAL ← ReadWReal[grayStream];
color ← IF level=0.0 THEN Imager.white ELSE IF level=1.0 THEN Imager.black ELSE ImagerColor.ColorFromGray[level];
[] ← SymTab.Insert[colorTab, grayRope, color];
};
};
ReadRGB: PROC [stream: IO.STREAM] = {
found: BOOLFALSE;
val: SymTab.Val;
rgbRope: Rope.ROPE ← ReadWUpToEndBracket[stream];
[found, val] ← SymTab.Fetch[colorTab, rgbRope];
IF found THEN color ← NARROW[val] ELSE {
r, g, b: REAL;
rgbStream: IO.STREAMIO.RIS[rope: rgbRope];
r ← ReadWReal[rgbStream];
IF version < 8701.26 THEN ReadChar[rgbStream, ',];
g ← ReadWReal[rgbStream];
IF version < 8701.26 THEN ReadChar[rgbStream, ',];
b ← ReadWReal[rgbStream];
color ← ImagerColor.ColorFromRGB[[r, g, b]];
[] ← SymTab.Insert[colorTab, rgbRope, color];
};
};
ReadCMYK: PROC [stream: IO.STREAM] = {
found: BOOLFALSE;
val: SymTab.Val;
cmykRope: Rope.ROPE ← ReadWUpToEndBracket[stream];
[found, val] ← SymTab.Fetch[colorTab, cmykRope];
IF found THEN color ← NARROW[val] ELSE {
c, m, y, k: REAL;
cmykStream: IO.STREAMIO.RIS[rope: cmykRope];
c ← ReadWReal[cmykStream];
m ← ReadWReal[cmykStream];
y ← ReadWReal[cmykStream];
k ← ReadWReal[cmykStream];
color ← ImagerColorFns.ColorFromCMYK[[c, m, y, k]];
[] ← SymTab.Insert[colorTab, cmykRope, color];
};
};
ReadYESLinear: PROC [stream: IO.STREAM] = {
found: BOOLFALSE;
val: SymTab.Val;
yesRope: Rope.ROPE ← ReadWUpToEndBracket[stream];
[found, val] ← SymTab.Fetch[colorTab, yesRope];
IF found THEN color ← NARROW[val] ELSE {
y, e, s: REAL;
yesStream: IO.STREAMIO.RIS[rope: yesRope];
y ← ReadWReal[yesStream];
e ← ReadWReal[yesStream];
s ← ReadWReal[yesStream];
color ← ImagerColorES.ColorFromYES[[y, e, s]];
[] ← SymTab.Insert[colorTab, yesRope, color];
};
};
SELECT TRUE FROM
version >= 8706.24 => {
key: NAT;
ReadWRope[f, "["];
word ← ReadWWord[f];
IF Rope.Equal[word, "]"] THEN RETURN[NIL];
key ← Convert.IntFromRope[word ! Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR["Couldn't convert %g to an INT", [rope[word]]], notThere: NIL]};];
SELECT key FROM
0 => ReadRGB[f];
1 => ReadBlack[f];
2 => color ← ImagerColor.Find[ReadColorToken[f]];
3, 4 => color ← ReadSampledColor[f];
5 => ReadCMYK[f];
6 => ReadYESLinear[f];
ENDCASE => ERROR;
ReadWRope[f, "]"];
};
version < 8701.26 => {
word ← ReadColorToken[f];
IF Rope.Equal[word, "none"] THEN RETURN[NIL];
IF f.PeekChar[]='] THEN ReadWRope[f, "]"];
s ← IO.RIS[word, colorStream];
ReadChar[s, '[];
ReadRGB[s];
IF ImagerColorPrivate.GrayFromColor[NARROW[color]] = 1.0 THEN color ← Imager.black; -- the default used to be "black toner"
};
ENDCASE => { --8701.26 < version < 8706.24
isBlackToner, good: BOOL;
word ← ReadBracketedExpression[f];
IF word = NIL THEN RETURN[NIL];
s ← IO.RIS[word, colorStream];
[isBlackToner, good] ← ReadBool[s, version];
IF NOT good THEN ERROR;
IF isBlackToner THEN ReadBlack[s] ELSE ReadRGB[s];
};
}; -- end of ReadColor
ReadColorToken: PUBLIC PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
Reads a rope until <SPACE>, <CR> or <TAB> are encountered.
ColorBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = CHECKED {
SELECT char FROM
'], IO.SP, IO.CR, IO.LF, IO.TAB => RETURN [break];
ENDCASE => RETURN [other];
};
[] ← IO.SkipWhitespace[f, TRUE];
[word, ----] ← IO.GetTokenRope[f, ColorBreakProc
! IO.EndOfStream => {word ← NIL; CONTINUE}];
};
ReadPixelArray: PUBLIC PROC [f: IO.STREAM] RETURNS [pa: Imager.PixelArray] = {
ipMaster: Interpress.Master ← NIL;
masterText: Rope.ROPE;
masterSize: CARD;
Read a description of yourself from stream f.
masterSize ← ReadWCARD[f];
ReadBlank[f];
IF masterSize = 0 THEN pa ← NIL
ELSE {
masterText ← IO.GetRope[f, masterSize, TRUE];
ipMaster ← Interpress.FromRope[masterText, NIL];
pa ← ReadPixelArrayFromIP[ipMaster];
};
};
ReadSampledColor: PROC [f: IO.STREAM] RETURNS [sColor: Imager.Color] = {
ipMaster: Interpress.Master ← NIL;
masterText: Rope.ROPE;
masterSize: CARD;
Read a description of yourself from stream f.
masterSize ← ReadWCARD[f];
ReadBlank[f];
masterText ← IO.GetRope[f, masterSize, TRUE];
ipMaster ← Interpress.FromRope[masterText, NIL];
sColor ← ReadColorFromIP[ipMaster];
};
ReadPixelArrayFromIP: PROC [ipMaster: Interpress.Master] RETURNS [pa: Imager.PixelArray] = {
ShowWarnings: Interpress.LogProc = {
SimpleFeedback.Append[$MessageWindow, oneLiner, $Warning, explanation];
};
ReadMaster: PROC [context: Imager.Context] = {
Interpress.DoPage[master: ipMaster, page: 1, context: context, log: ShowWarnings];
};
pa ← CapturePixelArray[action: ReadMaster];
};
ReadColorFromIP: PROC [ipMaster: Interpress.Master] RETURNS [sColor: Imager.Color] = {
ShowWarnings: Interpress.LogProc = {
SimpleFeedback.Append[$MessageWindow, oneLiner, $Warning, explanation];
};
ReadMaster: PROC [context: Imager.Context] = {
Interpress.DoPage[master: ipMaster, page: 1, context: context, log: ShowWarnings];
};
sColor ← CaptureColor[action: ReadMaster];
};
CaptureColorData: TYPE ~ REF CaptureColorDataRep;
CaptureColorDataRep: TYPE ~ RECORD [
color: Imager.Color,
pa: Imager.PixelArray
];
CreateColorContext: PROC [] RETURNS [Imager.Context] ~ {
data: CaptureColorData ~ NEW[CaptureColorDataRep ← [color: NIL, pa: NIL]];
state: State ~ ImagerState.CreateState[];
state.color ← Imager.black;
RETURN[NEW[Imager.ContextRep ← [class: captureColorClass, state: state, data: data]]];
};
CaptureColor: PROC [action: PROC [Imager.Context]] RETURNS [Imager.Color] = {
context: Imager.Context ~ CreateColorContext[];
action[context];
WITH context.data SELECT FROM
data: CaptureColorData => RETURN [data.color];
ENDCASE => ERROR;
};
CapturePixelArray: PROC [action: PROC [Imager.Context]] RETURNS [Imager.PixelArray] = {
context: Imager.Context ~ CreateColorContext[];
action[context];
WITH context.data SELECT FROM
data: CaptureColorData => RETURN [data.pa];
ENDCASE => ERROR;
};
MySetSampledColor: PUBLIC PROC [context: Imager.Context, pa: Imager.PixelArray,
m: Imager.Transformation, colorOperator: Imager.ColorOperator] = {
data: CaptureColorData ~ NARROW[context.data];
state: State ~ context.state;
ImagerState.StateSetSampledColor[context, pa, m, colorOperator];
data.color ← state.color;
};
MySetSampledBlack: PUBLIC PROC [context: Imager.Context, pa: Imager.PixelArray,
m: Imager.Transformation, clear: BOOL] = {
data: CaptureColorData ~ NARROW[context.data];
state: State ~ context.state;
ImagerState.StateSetSampledBlack[context, pa, m, clear];
data.color ← state.color;
};
MyMaskPixel: PUBLIC PROC [context: Imager.Context, pa: Imager.PixelArray] = {
data: CaptureColorData ~ NARROW[context.data];
state: State ~ context.state;
data.pa ← pa;
};
MySetColor: PUBLIC PROC [context: Imager.Context, color: Imager.Color] = {
data: CaptureColorData ~ NARROW[context.data];
data.color ← color;
};
ReadStrokeEnd: PUBLIC PROC [f: IO.STREAM] RETURNS [strokeEnd: Imager.StrokeEnd] = {
endName: Rope.ROPE;
[] ← IO.SkipWhitespace[f, TRUE];
endName ← ReadWWord[f];
SELECT TRUE FROM
Rope.Equal[endName, "square", TRUE] => strokeEnd ← square;
Rope.Equal[endName, "butt", TRUE] => strokeEnd ← butt;
Rope.Equal[endName, "round", TRUE] => strokeEnd ← round;
ENDCASE => ERROR;
};
ReadStrokeJoint: PUBLIC PROC [f: IO.STREAM] RETURNS [strokeJoint: Imager.StrokeJoint] = {
endName: Rope.ROPE;
[] ← IO.SkipWhitespace[f, TRUE];
endName ← ReadWWord[f];
SELECT TRUE FROM
Rope.Equal[endName, "round", TRUE] => strokeJoint ← round;
Rope.Equal[endName, "miter", TRUE] => strokeJoint ← miter;
Rope.Equal[endName, "bevel", TRUE] => strokeJoint ← bevel;
ENDCASE => ERROR;
};
ReadPoint: PUBLIC PROC [f: IO.STREAM] RETURNS [point: Point] = {
Assumes the next rope on the stream will be of the form "[<real1>,<real2>]".
[] ← IO.SkipWhitespace[f, TRUE];
ReadRope[f, "["];
point.x ← ReadWReal[f];
ReadRope[f, ","];
point.y ← ReadWReal[f];
ReadRope[f, "]"];
};
ReadTransformation: PUBLIC PROC [f: IO.STREAM] RETURNS [transform: ImagerTransformation.Transformation] = {
a, b, c, d, e, g: REAL;
ReadWRope[f, "["];
a ← ReadWReal[f];
b ← ReadWReal[f];
c ← ReadWReal[f];
d ← ReadWReal[f];
e ← ReadWReal[f];
g ← ReadWReal[f];
ReadWRope[f, "]"];
transform ← ImagerTransformation.Create[a, b, c, d, e, g];
};
ReadFactoredTransformationVEC: PUBLIC PROC [f: IO.STREAM] RETURNS [transform: ImagerTransformation.Transformation] = {
FactoredTransformation: TYPE ~ RECORD[r1: REAL, s: VEC, r2: REAL, t: VEC];
Represents Cat[Rotate[r1], Scale2[s], Rotate[r2], Translate[t]].
Expects "[r1: REAL s: [REAL REAL] r2: REAL ]. No translation"
r1, sx, sy, r2 : REAL;
ReadWRope[f, "[r1:"];
r1 ← ReadWReal[f];
ReadWRope[f, "s:"];
ReadWRope[f, "["];
sx ← ReadWReal[f];
sy ← ReadWReal[f];
ReadWRope[f, "]"];
ReadWRope[f, "r2:"];
r2 ← ReadWReal[f];
ReadWRope[f, "]"];
{
OPEN ImagerTransformation;
transform ← Cat[Rotate[r1], Scale2[[sx, sy]], Rotate[r2]];
};
};
ReadFactoredTransformation: PUBLIC PROC [f: IO.STREAM] RETURNS [transform: ImagerTransformation.Transformation] = {
FactoredTransformation: TYPE ~ RECORD[r1: REAL, s: VEC, r2: REAL, t: VEC];
Represents Cat[Rotate[r1], Scale2[s], Rotate[r2], Translate[t]].
Gargoyle file format "[r1: REAL s: [REAL REAL] r2: REAL t: [REAL REAL] ]"
r1, sx, sy, r2, tx, ty: REAL;
ReadWRope[f, "[r1:"];
r1 ← ReadWReal[f];
ReadWRope[f, "s:"];
ReadWRope[f, "["];
sx ← ReadWReal[f];
sy ← ReadWReal[f];
ReadWRope[f, "]"];
ReadWRope[f, "r2:"];
r2 ← ReadWReal[f];
ReadWRope[f, "t:"];
ReadWRope[f, "["];
tx ← ReadWReal[f];
ty ← ReadWReal[f];
ReadWRope[f, "]" ];
ReadWRope[f, "]" ];
{
OPEN ImagerTransformation;
transform ← Cat[Rotate[r1], Scale2[[sx, sy]], Rotate[r2], Translate[[tx, ty]] ];
};
};
ReadBox: PUBLIC PROC [f: IO.STREAM] RETURNS [box: BoundBox] = {
loX, loY, hiX, hiY: REAL;
ReadWRope[f, "["];
loX ← ReadWReal[f];
loY ← ReadWReal[f];
hiX ← ReadWReal[f];
hiY ← ReadWReal[f];
ReadWRope[f, "]"];
IF loX = 0.0 AND hiX = -1.0 THEN RETURN[GGBoundBox.NullBoundBox[]];
IF loY = 0.0 AND hiY = -1.0 THEN RETURN[GGBoundBox.CreateBoundBox[0,0,0,0,FALSE,TRUE]];
box ← GGBoundBox.CreateBoundBox[loX, loY, hiX, hiY];
};
ReadBool: PUBLIC PROC [f: IO.STREAM, version: REAL] RETURNS [truth: BOOL, good: BOOL] = {
Tries to read T or F from the stream. If it encounters another word, good = FALSE;
BoolBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
'], IO.CR, IO.LF, IO.SP, '., ', => RETURN [break];
ENDCASE => RETURN [other];
};
end: BOOLFALSE;
boolRope: Rope.ROPE;
[] ← IO.SkipWhitespace[f, TRUE];
[boolRope, ----] ← IO.GetTokenRope[f, BoolBreakProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end THEN {good ← FALSE; truth ← FALSE; RETURN};
good ← TRUE;
IF version >= 8701.26 THEN {
IF Rope.Equal[boolRope, "T", TRUE] THEN truth ← TRUE
ELSE IF Rope.Equal[boolRope, "F", TRUE] THEN truth ← FALSE
ELSE {truth ← FALSE; good ← FALSE};
}
ELSE {
IF Rope.Equal[boolRope, "TRUE", TRUE] THEN truth ← TRUE
ELSE IF Rope.Equal[boolRope, "FALSE", TRUE] THEN truth ← FALSE
ELSE {truth ← FALSE; good ← FALSE};
};
};
ReadListOfRope: PUBLIC PROC [f: IO.STREAM] RETURNS [ropeList: LIST OF Rope.ROPE] = {
cr: Rope.ROPE = Rope.FromChar[IO.CR];
lf: Rope.ROPE = Rope.FromChar[IO.LF];
rightParen: Rope.ROPE = Rope.FromChar[')];
rightBracket: Rope.ROPE = Rope.FromChar[']];
RopesOnOneLineOrParenProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
SELECT char FROM
IO.CR, IO.LF, '), '] =>RETURN [break];
IO.SP, IO.TAB, ', , '; => RETURN [sepr];
ENDCASE => RETURN [other];
};
rope: Rope.ROPE;
end: BOOLFALSE;
[] ← IO.SkipWhitespace[f, TRUE];
ropeList ← NIL;
WHILE TRUE DO
[rope, ----] ← IO.GetTokenRope[f, RopesOnOneLineOrParenProc
!IO.EndOfStream => {end ← TRUE; CONTINUE}];
IF end OR rope = NIL THEN RETURN;
IF Rope.Equal[rope, cr] OR Rope.Equal[rope, lf] THEN RETURN;
IF Rope.Equal[rope, rightParen] THEN {
f.Backup[')];
RETURN;
};
IF Rope.Equal[rope, rightBracket] THEN {
f.Backup[']];
RETURN;
};
ropeList ← AppendRopeToRopeList[rope, ropeList];
ENDLOOP;
};
ReadScalarButtonValues: PUBLIC PROC [f: IO.STREAM, version: REAL] RETURNS [names: LIST OF Rope.ROPE, values: LIST OF REAL, on: LIST OF BOOL] = {
valuePtr: LIST OF REAL;
boolPtr: LIST OF BOOL;
ropeListt: RopeListt;
expr: Rope.ROPE;
stream: IO.STREAM;
end, nextOn, good: BOOLFALSE;
nextVal: REAL;
nextName: Rope.ROPENIL;
[] ← IO.SkipWhitespace[f, TRUE];
[values, valuePtr] ← GGCoreOps.StartRealList[];
[on, boolPtr] ← GGCoreOps.StartBoolList[];
ropeListt ← GGCoreOps.NewRopeListt[];
WHILE TRUE DO
expr ← ReadBracketedExpression[f ! IO.EndOfStream, SyntaxError => {end ← TRUE; CONTINUE}];
IF end OR expr = NIL THEN GOTO Done;
stream ← IO.RIS[expr, stream];
[nextOn, good] ← ReadBool[stream, version];
IF NOT good THEN ERROR; -- for now
nextVal ← ReadWReal[stream];
nextName ← IF IO.EndOf[stream] THEN NIL ELSE ReadWWord[stream]; -- read optional rope
[values, valuePtr] ← GGCoreOps.AddReal[nextVal, values, valuePtr];
[on, boolPtr] ← GGCoreOps.AddBool[nextOn, on, boolPtr];
GGCoreOps.AppendRope[nextName, ropeListt];
REPEAT
Done => names ← ropeListt.list;
ENDLOOP;
};
ReadBracketedExpression: PROC [f: IO.STREAM] RETURNS [expr: Rope.ROPE] = {
CloseBracketProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
SELECT char FROM
'] =>RETURN [break];
ENDCASE => RETURN [other];
};
end: BOOLFALSE;
ReadChar[f, '[ ! SyntaxError => {end ← TRUE; CONTINUE;}; ];
IF end THEN RETURN[NIL];
[expr, ----] ← IO.GetTokenRope[f, CloseBracketProc];
IF Rope.Equal[expr, "]"] THEN RETURN[NIL]
ELSE ReadChar[f, ']];
};
RealLength: PROC [list: LIST OF Rope.ROPE] RETURNS [n: INT ← 0] = {
UNTIL list = NIL DO
n ← n+1;
list ← list.rest;
ENDLOOP;
};
ReadArrayOfReal: PUBLIC PROC [f: IO.STREAM] RETURNS [reals: SequenceOfReal] = {
Reads a list of REALs enclosed in square brackets, separated by spaces, tabs, commas, or semi-colons. For instance [3.5, 2.6, 1, 4. 3.0 ] returns a list of 5 real numbers.
ropeList: LIST OF Rope.ROPE;
real: REAL;
len, index: NAT;
ReadWRope[f, "["];
ropeList ← ReadListOfRope[f];
ReadWRope[f, "]"];
len ← RealLength[ropeList];
reals ← NEW[SequenceOfRealObj[len]];
index ← 0;
FOR list: LIST OF Rope.ROPE ← ropeList, list.rest UNTIL list = NIL DO
real ← Convert.RealFromRope[list.first
! Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR["Couldn't convert %g to a REAL", [rope[list.first]]], notThere: NIL]}];
reals[index] ← real;
index ← index + 1;
ENDLOOP;
};
AppendRopeToRopeList: PROC [rope: Rope.ROPE, list: LIST OF Rope.ROPE] RETURNS [LIST OF Rope.ROPE] = {
A copy of List.Nconc1 for LIST OF Rope.ROPE instead of LIST OF REF ANY
z: LIST OF Rope.ROPE ← list;
IF z = NIL THEN RETURN[CONS[rope,NIL]];
UNTIL z.rest = NIL DO z ← z.rest; ENDLOOP;
z.rest ← CONS[rope,NIL];
RETURN[list];
};
colorStream: IO.STREAM;
captureColorClass: Class;
colorTab: SymTab.Ref;
Init: PROC [] = {
colorStream ← IO.RIS["This string is longer than any color is likely to be."];
captureColorClass ← NEW[ClassRep ← [
type: $CaptureColor,
Save: ImagerState.StateSave,
Restore: ImagerState.StateRestore,
SetInt: ImagerState.StateSetInt,
SetReal: ImagerState.StateSetReal,
SetT: ImagerState.StateSetT,
SetFont: ImagerState.StateSetFont,
SetColor: MySetColor,
SetClipper: ImagerState.StateSetClipper,
GetInt: ImagerState.StateGetInt,
GetReal: ImagerState.StateGetReal,
GetT: ImagerState.StateGetT,
GetFont: ImagerState.StateGetFont,
GetColor: ImagerState.StateGetColor,
GetClipper: ImagerState.StateGetClipper,
ConcatT: ImagerState.StateConcatT,
Scale2T: ImagerState.StateScale2T,
RotateT: ImagerState.StateRotateT,
TranslateT: ImagerState.StateTranslateT,
Move: ImagerState.StateMove,
SetXY: ImagerState.StateSetXY,
SetXYRel: ImagerState.StateSetXYRel,
Show: NIL,
ShowText: NIL,
StartUnderline: ImagerState.StateStartUnderline,
MaskUnderline: ImagerState.StateMaskUnderline,
CorrectMask: ImagerState.StateCorrectMask,
CorrectSpace: ImagerState.StateCorrectSpace,
Space: ImagerState.StateSpace,
SetCorrectMeasure: ImagerState.StateSetCorrectMeasure,
SetCorrectTolerance: ImagerState.StateSetCorrectTolerance,
Correct: ImagerState.StateCorrect,
DontCorrect: ImagerState.StateDontCorrect,
SetGray: ImagerState.StateSetGray,
SetSampledColor: MySetSampledColor,
SetSampledBlack: MySetSampledBlack,
ShowBackward: NIL,
MaskFill: NIL,
MaskStroke: NIL,
ShowAndFixedXRel: NIL,
MaskDashedStroke: NIL,
MaskRectangle: NIL,
MaskRectangleI: NIL,
MaskVector: NIL,
MaskPixel: MyMaskPixel,
MaskBitmap: NIL,
DrawBitmap: NIL,
DrawPixels: NIL,
DoIfVisible: NIL,
DoWithBuffer: NIL,
DrawObject: NIL,
Clip: ImagerState.StateClip,
ClipRectangle: ImagerState.StateClipRectangle,
ClipRectangleI: ImagerState.StateClipRectangleI,
GetCP: ImagerState.StateGetCP,
GetBounds: NIL,
ViewReset: NIL,
ViewTranslateI: NIL,
ViewClip: NIL,
ViewClipRectangleI: NIL,
GetTransformation: NIL,
Transform: NIL,
MoveViewRectangle: NIL,
TestViewRectangle: NIL,
propList: NIL
]];
colorTab ← SymTab.Create[];
};
Init[];
END.