GGParseImpl.mesa
Copyright Ó 1986, 1989, 1992 by Xerox Corporation. All rights reserved.
Contents: Routines which turn various Gargoyle data structures into Rope.ROPEs and write them onto a file stream.
Last edited by Bier, December 4, 1992 1:36 pm PST
Pier, December 1, 1992 12:52 pm PST
Maureen Stone, June 25, 1987 2:56:07 pm PDT
Michael Plass, October 22, 1992 11:08 am PDT
Doug Wyatt, April 9, 1992 5:48 pm PDT
DIRECTORY
Basics, Convert, Feedback, GGBoundBox, GGColorOps, GGCoreOps, GGCoreTypes, GGParseIn, GGParseOut, Imager, ImagerColor, ImagerColorPrivate, ImagerDeviceVector, ImagerInterpress, ImagerPrivate, ImagerState, ImagerTransformation, InterpressInterpreter, IO, RefText, RefTextExtras, Rope, SimpleFeedback, SymTab, Tioga, TiogaIO;
GGParseImpl:
CEDAR
PROGRAM
IMPORTS Convert, Feedback, GGBoundBox, GGCoreOps, Imager, ImagerColor, ImagerColorPrivate, ImagerInterpress, ImagerState, ImagerTransformation, InterpressInterpreter, IO, RefText, RefTextExtras, Rope, SimpleFeedback, SymTab, TiogaIO
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] = Feedback.Problem;
STREAM: TYPE = IO.STREAM;
ColorType: TYPE = GGColorOps.ColorType;
OperatorType: TYPE = GGColorOps.OperatorType;
ColorOperator: TYPE = ImagerColor.ColorOperator;
ROPE: TYPE = Rope.ROPE;
CMYK: TYPE = ImagerColor.CMYK;
ColorOperatorClassRep: PUBLIC TYPE ~ ImagerColorPrivate.ColorOperatorClassRep;
Output
SkipWhitespace:
PROC [f:
STREAM] =
INLINE {
c: CHAR;
DO
IF IO.InlineEndOf[f] THEN RETURN;
c ¬ IO.InlineGetChar[f];
IF NOT c IN [IO.NUL .. IO.SP] THEN EXIT;
ENDLOOP;
f.Backup[c];
};
WriteColor:
PUBLIC
PROC [f:
STREAM, color: Color] = {
Encoding:
0: Red, Green, Blue triple
1: Grey value
2: Special Color
3: Sampled Black (?)
4: Sampled Color (?)
5: C, M, Y, K
6: Y, E, S
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.PutF1[" %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.PutFL[" %g %g %g]", LIST[[real[r]], [real[g]], [real[b]]]];
};
cmyk, process => {
cmyk: CMYK;
WriteNAT[f, 5];
cmyk ¬ CMYKFromColor[op];
f.PutFL[" %g %g %g %g]", LIST[[real[cmyk.C]], [real[cmyk.M]], [real[cmyk.Y]], [real[cmyk.K]]] ];
};
yesLinear => {
yes: ImagerColor.YES;
WriteNAT[f, 6];
yes ¬ ImagerColor.YESFromColor[op];
f.PutFL[" %g %g %g]", LIST[[real[yes.Y]], [real[yes.E]], [real[yes.S]]] ];
};
ENDCASE => ERROR;
};
special: ImagerColor.SpecialColor => {
WriteNAT[f, 2];
f.PutF1[" %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.PutF1[" %g]", [real[0]]];
};
};
};
ExtractCMYK:
PUBLIC
PROC [color: ImagerColor.ConstantColor]
RETURNS [c,m,y,k:
REAL] = {
cmyk: ImagerColor.CMYK;
op: ImagerColor.OpConstantColor;
IF color=NIL THEN ERROR Problem["NIL color for ExtractCMYK"];
op ¬ NARROW[color];
cmyk ¬ 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. Most are defined in ImagerColorImpl. Xerox/Research/CMYK is defined in CMYKCompatibilityImpl.
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] = {
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];
}
cmyk.C ¬ color.pixel[0]/1000.0;
cmyk.M ¬ color.pixel[1]/1000.0;
cmyk.Y ¬ color.pixel[2]/1000.0;
cmyk.K ¬ color.pixel[3]/1000.0;
};
>>
SupportsOutput:
PROC [co: ImagerColor.ColorOperator, colorSpace: ImagerColorPrivate.ColorSpace]
RETURNS [
BOOL ¬
FALSE] ~ {
class: REF ColorOperatorClassRep ~ co.class;
FOR t:
LIST
OF ImagerColorPrivate.ColorSpace ¬ class.supportedOutputs, t.rest
UNTIL t=
NIL
DO
IF t.first = colorSpace THEN RETURN [TRUE];
ENDLOOP;
};
CMYKFromRGB:
PROC [rgb: ImagerColor.
RGB]
RETURNS [cmyk:
CMYK] = {
cmyk.C ¬ 1.0-rgb.R;
cmyk.M ¬ 1.0-rgb.G;
cmyk.Y ¬ 1.0-rgb.B;
cmyk.K ¬ 0.0;
};
CMYKFromColor:
PUBLIC PROC [color: ImagerColor.OpConstantColor]
RETURNS [cmyk:
CMYK] = {
colorSpace: ImagerColorPrivate.ColorSpace ¬ ImagerColorPrivate.DefineProcessSpace[ImagerColor.NewColorOperatorCMYK[255]];
IF SupportsOutput[color.colorOperator, colorSpace]
THEN {
cp: ImagerColorPrivate.ColorPoint ¬ ImagerColorPrivate.TransformConstantColor[color: color, colorSpace: colorSpace];
cmyk.C ¬ cp[0]/255.0;
cmyk.M ¬ cp[1]/255.0;
cmyk.Y ¬ cp[2]/255.0;
cmyk.K ¬ cp[3]/255.0;
}
ELSE {
cmyk ¬ CMYKFromRGB[ImagerColor.RGBFromColor[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:
STREAM, pa: Imager.PixelArray] = {
Write a description of yourself onto stream f.
ipRef: ImagerInterpress.Ref;
masterStream: STREAM;
masterSize: CARD;
masterRope: ROPE;
IF pa = NIL THEN f.PutRope["0"]
ELSE {
MaskPixelArray:
PROC [dc: Imager.Context] = {
Imager.MaskPixel[dc, pa];
};
Write the interpress into a 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.PutF1["%g\n", [integer[masterSize]]];
f.PutRope[masterRope];
};
};
WriteSampledColor:
PROC [f:
STREAM, sColor: Imager.Color] = {
Write a description of yourself onto stream f.
ipRef: ImagerInterpress.Ref;
masterStream: STREAM;
masterSize: CARD;
masterRope: ROPE;
SetTheColor:
PROC [dc: Imager.Context] = {
Imager.SetColor[dc, sColor];
};
Write the interpress into a 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.PutF1["%g\n", [integer[masterSize]]];
f.PutRope[masterRope];
};
WriteNAT:
PROC [f:
STREAM, val:
NAT] = {
f.PutF1["%g", [integer[val]]];
};
WriteStrokeEnd:
PUBLIC
PROC [f:
STREAM, strokeEnd: StrokeEnd] = {
rope: ROPE;
SELECT strokeEnd
FROM
round => rope ¬ "round";
square => rope ¬ "square";
butt => rope ¬ "butt";
ENDCASE => ERROR;
f.PutRope[rope];
};
WriteStrokeJoint:
PUBLIC
PROC [f:
STREAM, strokeJoint: StrokeJoint] = {
rope: ROPE;
SELECT strokeJoint
FROM
round => rope ¬ "round";
miter => rope ¬ "miter";
bevel => rope ¬ "bevel";
ENDCASE => ERROR;
f.PutRope[rope];
};
WritePoint:
PUBLIC
PROC [f:
STREAM, point: Point] = {
f.PutF["[%g,%g]", [real[point.x]], [real[point.y]]];
};
WriteTransformation:
PUBLIC
PROC [f:
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:
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:
STREAM, transform: ImagerTransformation.Transformation] = {
Like WriteFactoredTransformation but suppresses the translation component
factored: ImagerTransformation.FactoredTransformation ¬ ImagerTransformation.Factor[transform];
f.PutFL["[r1: %g s: [%g %g] r2: %g]", LIST[[real[factored.r1]], [real[factored.s.x]], [real[factored.s.y]], [real[factored.r2]]] ];
};
WriteBox:
PUBLIC
PROC [f:
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.PutFL["[%g %g %g %g]",
LIST[[real[box.loX]], [real[box.loY]], [real[box.hiX]], [real[box.hiY]]]];
};
WriteBool:
PUBLIC
PROC [f:
STREAM, bool:
BOOL] = {
IF bool THEN f.PutRope["T"] ELSE f.PutRope["F"];
};
WriteListOfRope:
PUBLIC
PROC [f:
STREAM, ropes:
LIST
OF ROPE] = {
IF ropes = NIL THEN RETURN;
f.PutRope[ropes.first];
FOR list:
LIST
OF ROPE ¬ ropes.rest, list.rest
UNTIL list =
NIL
DO
f.PutRope[", "];
f.PutRope[list.first];
ENDLOOP;
};
WriteProps:
PUBLIC
PROC [f:
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:
STREAM, reals: SequenceOfReal] = {
f.PutChar['[];
IF reals.len > 0 THEN f.PutF1["%g", [real[reals[0]]]];
FOR i:
NAT
IN [1..reals.len)
DO
f.PutF1[" %g", [real[reals[i]]]];
ENDLOOP;
f.PutChar[']];
};
WriteScalarButtonValues:
PUBLIC PROC [f:
STREAM, names:
LIST
OF 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.PutF1[" %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.PutF1[" %g", [rope[names.first]] ];
f.PutChar[']];
ENDLOOP;
};
};
WriteText:
PUBLIC
PROC [f:
STREAM, text: Tioga.Node, screenStyle:
BOOL] = {
f.PutF1["%g ", [rope[IF screenStyle THEN "T" ELSE "F"]] ];
IF text=NIL THEN f.PutF1["%g ", [integer[0]] ] -- byte count of 0 => no text
ELSE {
r: ROPE ~ TiogaIO.ToRope[text];
f.PutF1["%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, notThere: ROPE] = CODE;
ReadText:
PUBLIC
PROC [f:
STREAM, version:
REAL]
RETURNS [text: Tioga.Node, screenStyle:
BOOL ¬
FALSE] = {
fillText: ROPE;
nodeSize: CARD ¬ 0;
screenStyle ¬ ReadBool[f];
nodeSize ¬ ReadCARD[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 ¬ TiogaIO.FromRope[fillText];
};
ReadBlank:
PUBLIC
PROC [f:
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:
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, IO.LF, IO.CR, IO.SP => RETURN [other];
ENDCASE => RETURN [break];
};
whiteSpace: ROPE;
end: BOOL ¬ FALSE;
[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:
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;
c: CHAR;
end: BOOL ¬ FALSE;
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:
PUBLIC
PROC [f:
STREAM]
RETURNS [word: ROPE] = {
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF
IsRealBreak[c]
THEN
{
IF RefText.Length[text] > 0
THEN f.Backup[c]
ELSE text ¬ RefText.InlineAppendChar[text, c]; -- return the break character as a word
EXIT;
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
word ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
};
ReadRope: PUBLIC PROC [f: STREAM, rope: ROPE] = {
Removes the given rope from the top of the stream. Used to remove formatting words and phrases. We are not interested in these strings but only in the data in between them.
Signals SyntaxError if some other rope is found.
c: CHAR;
endofstream: BOOL ¬ FALSE;
SkipWhitespace[f];
FOR i: INT IN[1..Rope.Length[rope]] DO
c ¬ IO.GetChar[f
! IO.EndOfStream => {endofstream ¬ TRUE; CONTINUE}];
IF endofstream THEN
SIGNAL SyntaxError [IO.GetIndex[f], NIL, rope];
IF NOT c = Rope.Fetch[rope,i-1] THEN
SIGNAL SyntaxError [IO.GetIndex[f], Rope.FromChar[c], rope];
ENDLOOP;
};
ReadRope:
PUBLIC
PROC [f:
STREAM, rope:
ROPE] = {
Removes the given rope from the top of the stream. Used to remove formatting words and phrases. We are not interested in these strings but only in the data in between them.
Signals SyntaxError if some other rope is found.
scratch, text: REF TEXT;
bytesRead: NAT;
count: NAT ¬ Rope.Length[rope];
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
bytesRead ¬ f.GetBlock[block: text, startIndex: 0, count: count];
IF
NOT Rope.Equal[RefText.TrustTextAsRope[text], rope,
FALSE]
OR bytesRead # count
THEN {
textRope: ROPE ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
SIGNAL SyntaxError [IO.GetIndex[f], textRope, rope];
};
RefTextExtras.ReleaseScratch100[scratch];
};
ReadChar:
PUBLIC
PROC [f:
STREAM, c:
CHAR] = {
streamC: CHAR;
SkipWhitespace[f];
streamC ¬ IO.InlineGetChar[f];
IF
NOT c = streamC
THEN SIGNAL SyntaxError[IO.GetIndex[f], Rope.FromChar[streamC], Rope.FromChar[c]];
};
InlineReadChar:
PROC [f:
STREAM, c:
CHAR] =
INLINE {
streamC: CHAR;
SkipWhitespace[f];
streamC ¬ IO.InlineGetChar[f];
IF
NOT c = streamC
THEN SIGNAL SyntaxError[IO.GetIndex[f], Rope.FromChar[streamC], Rope.FromChar[c]];
};
ReadLine:
PUBLIC
PROC [f:
STREAM]
RETURNS [line: 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: BOOL ¬ FALSE;
[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>
};
ReadKeyWord:
PUBLIC
PROC [f:
STREAM]
RETURNS [keyWord: 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: BOOL ¬ FALSE;
nextChar: 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];
};
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];
};
IsNATBreak:
PROC [c:
CHAR]
RETURNS [
BOOL] =
INLINE {
RETURN[c=IO.SP OR c=IO.CR OR c=IO.LF OR c=') OR c='] OR c=', OR c=IO.TAB OR c ='. OR c=':];
};
ReadNAT:
PUBLIC
PROC [f:
STREAM]
RETURNS [n:
NAT ¬ 1] = {
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF
IsNATBreak[c]
THEN {
f.Backup[c];
EXIT;
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
n ¬ Convert.
IntFromRope[RefText.TrustTextAsRope[text] !
Convert.Error => {
rope: ROPE ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
ERROR SyntaxError[position:
IO.GetIndex[f], wasThere: rope, notThere: "<a natural number>"]
}];
RefTextExtras.ReleaseScratch100[scratch];
};
ReadCARD:
PUBLIC
PROC [f:
STREAM]
RETURNS [n:
CARD ¬ 1] = {
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF
IsNATBreak[c]
THEN {
f.Backup[c];
EXIT;
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
n ¬ Convert.
CardFromRope[RefText.TrustTextAsRope[text] !
Convert.Error => {
rope: ROPE ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
ERROR SyntaxError[position:
IO.GetIndex[f], wasThere: rope, notThere: "<a cardinal number>"]
}];
RefTextExtras.ReleaseScratch100[scratch];
};
IsRealBreak:
PROC [c:
CHAR]
RETURNS [
BOOL] =
INLINE {
RETURN[c=IO.SP OR c=IO.CR OR c=IO.LF OR c=') OR c='] OR c=', OR c=IO.TAB];
};
ReadReal:
PUBLIC
PROC [f:
STREAM]
RETURNS [r:
REAL ¬ 0.0] = {
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF IsRealBreak[c]
THEN
{
f.Backup[c];
EXIT;
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
r ¬ Convert.RealFromRope[RefText.TrustTextAsRope[text] !
Convert.Error => {
rope: ROPE ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
ERROR SyntaxError[position:
IO.GetIndex[f], wasThere: rope, notThere: "<a REAL>"]
};
];
RefTextExtras.ReleaseScratch100[scratch];
};
ReadUpToEndBracket: PROC [f: STREAM] RETURNS [expr: ROPE] = {
CloseBracketProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
SELECT char FROM
'] =>RETURN [break];
ENDCASE => RETURN [other];
};
SkipWhitespace[f];
[expr, ----] ¬ IO.GetTokenRope[f, CloseBracketProc];
RETURN[IF Rope.Equal[expr, "]"] THEN NIL ELSE expr];
};
ReadUpToEndBracket:
PROC [f:
STREAM]
RETURNS [expr:
ROPE] = {
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch8192[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF c='] THEN {f.Backup[c]; EXIT};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
expr ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch8192[scratch];
IF Rope.Equal[expr, "]"] THEN expr ¬ NIL;
};
OpConstantColor: TYPE ~ ImagerColor.OpConstantColor;
ReadColor:
PUBLIC
PROC [f:
STREAM, version:
REAL]
RETURNS [color: Color] = {
s: STREAM;
word: ROPE;
isBlackToner: BOOL;
ReadBlack:
PROC [stream:
STREAM] = {
found: BOOL ¬ FALSE;
val: SymTab.Val;
grayRope: ROPE ¬ ReadUpToEndBracket[stream];
[found, val] ¬ SymTab.Fetch[colorTab, grayRope];
IF found
THEN color ¬
NARROW[val]
ELSE {
grayStream: STREAM ¬ IO.RIS[rope: grayRope];
level: REAL ¬ ReadReal[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:
STREAM] = {
found: BOOL ¬ FALSE;
val: SymTab.Val;
rgbRope: ROPE ¬ ReadUpToEndBracket[stream];
[found, val] ¬ SymTab.Fetch[colorTab, rgbRope];
IF found
THEN color ¬
NARROW[val]
ELSE {
r, g, b: REAL;
rgbStream: STREAM ¬ IO.RIS[rope: rgbRope];
r ¬ ReadReal[rgbStream];
IF version < 8701.26 THEN InlineReadChar[rgbStream, ',];
g ¬ ReadReal[rgbStream];
IF version < 8701.26 THEN InlineReadChar[rgbStream, ',];
b ¬ ReadReal[rgbStream];
color ¬ ImagerColor.ColorFromRGB[[r, g, b]];
[] ¬ SymTab.Insert[colorTab, rgbRope, color];
};
};
ReadCMYK:
PROC [stream:
STREAM] = {
found: BOOL ¬ FALSE;
val: SymTab.Val;
cmykRope: ROPE ¬ ReadUpToEndBracket[stream];
[found, val] ¬ SymTab.Fetch[colorTab, cmykRope];
IF found
THEN color ¬
NARROW[val]
ELSE {
c, m, y, k: REAL;
cmykStream: STREAM ¬ IO.RIS[rope: cmykRope];
c ¬ ReadReal[cmykStream];
m ¬ ReadReal[cmykStream];
y ¬ ReadReal[cmykStream];
k ¬ ReadReal[cmykStream];
color ¬ ImagerColor.ColorFromCMYK[[c, m, y, k]];
[] ¬ SymTab.Insert[colorTab, cmykRope, color];
};
};
ReadYESLinear:
PROC [stream:
STREAM] = {
found: BOOL ¬ FALSE;
val: SymTab.Val;
yesRope: ROPE ¬ ReadUpToEndBracket[stream];
[found, val] ¬ SymTab.Fetch[colorTab, yesRope];
IF found
THEN color ¬
NARROW[val]
ELSE {
y, e, s: REAL;
yesStream: STREAM ¬ IO.RIS[rope: yesRope];
y ¬ ReadReal[yesStream];
e ¬ ReadReal[yesStream];
s ¬ ReadReal[yesStream];
color ¬ ImagerColor.ColorFromYES[[y, e, s]];
[] ¬ SymTab.Insert[colorTab, yesRope, color];
};
};
SELECT
TRUE
FROM
version >= 8706.24 => {
key: NAT;
InlineReadChar[f, '[];
word ¬ ReadWord[f];
IF Rope.Equal[word, "]"] THEN RETURN[NIL];
key ¬ Convert.IntFromRope[word ! Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR1["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;
InlineReadChar[f, ']];
};
version < 8701.26 => {
word ¬ ReadColorToken[f];
IF Rope.Equal[word, "none"] THEN RETURN[NIL];
IF IO.InlinePeekChar[f]='] THEN InlineReadChar[f, ']];
s ¬ IO.RIS[word, colorStream];
InlineReadChar[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
word ¬ ReadBracketedExpression[f];
IF word = NIL THEN RETURN[NIL];
s ¬ IO.RIS[word, colorStream];
isBlackToner ¬ ReadBool[s];
IF isBlackToner THEN ReadBlack[s] ELSE ReadRGB[s];
};
}; -- end of ReadColor
ReadColorToken:
PUBLIC
PROC [f:
STREAM]
RETURNS [word:
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];
};
SkipWhitespace[f];
[word,
----] ¬
IO.GetTokenRope[f, ColorBreakProc
! IO.EndOfStream => {word ¬ NIL; CONTINUE}];
};
ReadPixelArray:
PUBLIC PROC [f:
STREAM]
RETURNS [pa: Imager.PixelArray] = {
ipMaster: InterpressInterpreter.Master ¬ NIL;
masterText: ROPE;
masterSize: CARD;
Read a description of yourself from stream f.
masterSize ¬ ReadCARD[f];
ReadBlank[f];
IF masterSize = 0 THEN pa ¬ NIL
ELSE {
masterText ¬ IO.GetRope[f, masterSize, TRUE];
ipMaster ¬ InterpressInterpreter.FromRope[masterText, NIL];
pa ¬ ReadPixelArrayFromIP[ipMaster];
};
};
ReadSampledColor:
PROC [f:
STREAM]
RETURNS [sColor: Imager.Color] = {
ipMaster: InterpressInterpreter.Master ¬ NIL;
masterText: ROPE;
masterSize: CARD;
Read a description of yourself from stream f.
masterSize ¬ ReadCARD[f];
ReadBlank[f];
masterText ¬ IO.GetRope[f, masterSize, TRUE];
ipMaster ¬ InterpressInterpreter.FromRope[masterText, NIL];
sColor ¬ ReadColorFromIP[ipMaster];
};
ReadPixelArrayFromIP:
PROC [ipMaster: InterpressInterpreter.Master]
RETURNS [pa: Imager.PixelArray] = {
ShowWarnings: InterpressInterpreter.LogProc = {
SimpleFeedback.Append[$MessageWindow, oneLiner, $Warning, explanation];
};
ReadMaster:
PROC [context: Imager.Context] = {
InterpressInterpreter.DoPage[master: ipMaster, page: 1, context: context, log: ShowWarnings];
};
pa ¬ CapturePixelArray[action: ReadMaster];
};
ReadColorFromIP:
PROC [ipMaster: InterpressInterpreter.Master]
RETURNS [sColor: Imager.Color] = {
ShowWarnings: InterpressInterpreter.LogProc = {
SimpleFeedback.Append[$MessageWindow, oneLiner, $Warning, explanation];
};
ReadMaster:
PROC [context: Imager.Context] = {
InterpressInterpreter.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:
STREAM]
RETURNS [strokeEnd: Imager.StrokeEnd] = {
endName: ROPE;
SkipWhitespace[f];
endName ¬ ReadWord[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:
STREAM]
RETURNS [strokeJoint: Imager.StrokeJoint] = {
endName: ROPE;
SkipWhitespace[f];
endName ¬ ReadWord[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:
STREAM]
RETURNS [point: Point] = {
Assumes the next rope on the stream will be of the form "[<real1>,<real2>]".
SkipWhitespace[f];
InlineReadChar[f, '[];
point.x ¬ ReadReal[f];
InlineReadChar[f, ',];
point.y ¬ ReadReal[f];
InlineReadChar[f, ']];
};
ReadTransformation:
PUBLIC
PROC [f:
STREAM]
RETURNS [transform: ImagerTransformation.Transformation] = {
a, b, c, d, e, g: REAL;
InlineReadChar[f, '[];
a ¬ ReadReal[f];
b ¬ ReadReal[f];
c ¬ ReadReal[f];
d ¬ ReadReal[f];
e ¬ ReadReal[f];
g ¬ ReadReal[f];
InlineReadChar[f, ']];
transform ¬ ImagerTransformation.Create[a, b, c, d, e, g];
};
ReadFactoredTransformationVEC:
PUBLIC
PROC [f:
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;
ReadRope[f, "[r1:"];
r1 ¬ ReadReal[f];
ReadRope[f, "s:"];
InlineReadChar[f, '[];
sx ¬ ReadReal[f];
sy ¬ ReadReal[f];
InlineReadChar[f, ']];
ReadRope[f, "r2:"];
r2 ¬ ReadReal[f];
InlineReadChar[f, ']];
{
OPEN ImagerTransformation;
transform ¬ Cat[Rotate[r1], Scale2[[sx, sy]], Rotate[r2]];
};
};
ReadFactoredTransformation:
PUBLIC
PROC [f:
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;
ReadRope[f, "[r1:"];
r1 ¬ ReadReal[f];
ReadRope[f, "s:"];
InlineReadChar[f, '[];
sx ¬ ReadReal[f];
sy ¬ ReadReal[f];
InlineReadChar[f, ']];
ReadRope[f, "r2:"];
r2 ¬ ReadReal[f];
ReadRope[f, "t:"];
InlineReadChar[f, '[];
tx ¬ ReadReal[f];
ty ¬ ReadReal[f];
InlineReadChar[f, ']];
InlineReadChar[f, ']];
{
OPEN ImagerTransformation;
transform ¬ Cat[Rotate[r1], Scale2[[sx, sy]], Rotate[r2], Translate[[tx, ty]] ];
};
};
ReadBox:
PUBLIC
PROC [f:
STREAM]
RETURNS [box: BoundBox] = {
loX, loY, hiX, hiY: REAL;
InlineReadChar[f, '[];
loX ¬ ReadReal[f];
loY ¬ ReadReal[f];
hiX ¬ ReadReal[f];
hiY ¬ ReadReal[f];
InlineReadChar[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: 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: BOOL ¬ FALSE;
boolRope: ROPE;
SkipWhitespace[f];
[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};
};
};
ReadBool:
PUBLIC
PROC [f:
STREAM]
RETURNS [truth:
BOOL] = {
The version argument is no longer needed.
scratch, text: REF TEXT;
c: CHAR;
SkipWhitespace[f];
scratch ¬ text ¬ RefTextExtras.ObtainScratch16[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF
IsNATBreak[c]
THEN
{
f.Backup[c];
EXIT;
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
IF Rope.Equal[RefText.TrustTextAsRope[text], "T", TRUE] THEN truth ¬ TRUE
ELSE IF Rope.Equal[RefText.TrustTextAsRope[text], "F", TRUE] THEN truth ¬ FALSE
ELSE IF Rope.Equal[RefText.TrustTextAsRope[text], "TRUE", TRUE] THEN truth ¬ TRUE
ELSE
IF Rope.Equal[RefText.TrustTextAsRope[text], "FALSE",
TRUE]
THEN truth ¬
FALSE
ELSE {
rope: ROPE ¬ Rope.FromRefText[text];
truth ¬ FALSE;
RefTextExtras.ReleaseScratch16[scratch];
SIGNAL SyntaxError [IO.GetIndex[f], rope, "<T or F>"];
RETURN;
};
RefTextExtras.ReleaseScratch16[scratch];
};
cr: ROPE = Rope.FromChar[IO.CR];
lf: ROPE = Rope.FromChar[IO.LF];
rightParen: ROPE = Rope.FromChar[')];
rightBracket: ROPE = Rope.FromChar[']];
IsRopesOnOneLineBreak:
PROC [c:
CHAR]
RETURNS [
BOOL] =
INLINE {
RETURN[c=IO.CR OR c=IO.LF OR c=') OR c=']];
};
IsRopesOnOneLineSepr:
PROC [c:
CHAR]
RETURNS [
BOOL] =
INLINE {
RETURN[c=IO.SP OR c=IO.TAB OR c=', OR c=';];
};
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];
};
<<
ReadListOfRope:
PUBLIC
PROC [f:
STREAM]
RETURNS [ropeList:
LIST
OF
ROPE] = {
scratch, text: REF TEXT;
c: CHAR;
rope: ROPE;
SkipWhitespace[f];
ropeList ¬ NIL;
DO
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF IsRopesOnOneLineBreak[c]
THEN {
IF RefText.Length[text] > 0
THEN f.Backup[c]
ELSE text ¬ RefText.InlineAppendChar[text, c]; -- return the break character as a word
EXIT;
}
ELSE IF IsRopesOnOneLineSepr[c] THEN EXIT; -- don't put the separator in the string
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
rope ¬ Rope.FromRefText[text];
RefTextExtras.ReleaseScratch100[scratch];
IF rope = NIL THEN RETURN;
IF Rope.Length[rope] = 1
THEN {
c ¬ Rope.Fetch[rope, 0];
IF c=IO.CR OR c=IO.LF THEN RETURN;
IF c=') OR c = '] THEN {f.Backup[c]; RETURN};
};
ropeList ¬ AppendRopeToRopeList[rope, ropeList];
ENDLOOP;
};
>>
ReadListOfRope:
PUBLIC
PROC [f:
STREAM]
RETURNS [ropeList:
LIST
OF
ROPE] = {
scratch, text: REF TEXT;
c: CHAR;
rope: ROPE;
len: INT;
SkipWhitespace[f];
ropeList ¬ NIL;
DO
scratch ¬ text ¬ RefTextExtras.ObtainScratch100[];
DO
IF IO.InlineEndOf[f] THEN EXIT;
c ¬ IO.InlineGetChar[f];
IF IsRopesOnOneLineBreak[c]
THEN {
IF RefText.Length[text] > 0
THEN f.Backup[c]
ELSE text ¬ RefText.InlineAppendChar[text, c]; -- return the break character as a word
EXIT;
}
ELSE
IF IsRopesOnOneLineSepr[c]
THEN {
-- found a separator
IF RefText.Length[text] > 0 THEN EXIT -- don't put the separator in the string
ELSE LOOP; -- ignore leading separators
};
text ¬ RefText.InlineAppendChar[text, c];
ENDLOOP;
rope ¬ Rope.FromRefText[text]; -- returns an empty rope instead of NIL
RefTextExtras.ReleaseScratch100[scratch];
IF rope = NIL THEN RETURN; -- rope is never NIL
len ¬ Rope.Length[rope];
IF len = 0 THEN RETURN;
IF len = 1
THEN {
c ¬ Rope.Fetch[rope, 0];
IF c=IO.CR OR c=IO.LF THEN RETURN;
IF c=') OR c = '] THEN {f.Backup[c]; RETURN};
};
ropeList ¬ AppendRopeToRopeList[rope, ropeList];
ENDLOOP;
};
ReadScalarButtonValues:
PUBLIC
PROC [f:
STREAM, version:
REAL]
RETURNS [names:
LIST
OF
ROPE, values:
LIST
OF
REAL, on:
LIST
OF
BOOL] = {
valuePtr: LIST OF REAL;
boolPtr: LIST OF BOOL;
ropeListt: RopeListt;
expr: ROPE;
stream: STREAM;
end, nextOn: BOOL ¬ FALSE;
nextVal: REAL;
nextName: ROPE ¬ NIL;
SkipWhitespace[f];
[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 ¬ ReadBool[stream];
nextVal ¬ ReadReal[stream];
nextName ¬ IF IO.EndOf[stream] THEN NIL ELSE ReadWord[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:
STREAM]
RETURNS [expr:
ROPE] = {
CloseBracketProc:
SAFE
PROC [char:
CHAR]
RETURNS [
IO.CharClass] = {
SELECT char
FROM
'] =>RETURN [break];
ENDCASE => RETURN [other];
};
end: BOOL ¬ FALSE;
InlineReadChar[f, '[ ! SyntaxError => {end ¬ TRUE; CONTINUE;}; ];
IF end THEN RETURN[NIL];
[expr, ----] ¬ IO.GetTokenRope[f, CloseBracketProc];
IF Rope.Equal[expr, "]"] THEN RETURN[NIL]
ELSE InlineReadChar[f, ']];
};
RealLength:
PROC [list:
LIST
OF
ROPE]
RETURNS [n:
INT ¬ 0] = {
UNTIL list =
NIL
DO
n ¬ n+1;
list ¬ list.rest;
ENDLOOP;
};
ReadArrayOfReal:
PUBLIC
PROC [f:
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;
real: REAL;
len, index: NAT;
InlineReadChar[f, '[];
ropeList ¬ ReadListOfRope[f];
InlineReadChar[f, ']];
len ¬ RealLength[ropeList];
reals ¬ NEW[SequenceOfRealObj[len]];
index ¬ 0;
FOR list:
LIST
OF
ROPE ¬ ropeList, list.rest
UNTIL list =
NIL
DO
real ¬ Convert.RealFromRope[list.first
! Convert.Error => {ERROR SyntaxError[position: IO.GetIndex[f], wasThere: IO.PutFR1["Couldn't convert %g to a REAL", [rope[list.first]]], notThere: NIL]}];
reals[index] ¬ real;
index ¬ index + 1;
ENDLOOP;
};
AppendRopeToRopeList:
PROC [rope:
ROPE, list:
LIST
OF
ROPE]
RETURNS [
LIST
OF
ROPE] = {
A copy of List.Nconc1 for LIST OF ROPE instead of LIST OF REF ANY
z: LIST OF 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: 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.