CGMImpl.mesa
Copyright Ó 1988, 1990, 1992 by Xerox Corporation. All rights reserved.
Fumihiko Shibata, July 6, 1989 6:18:22 pm JST
Import/Export of CGM files.
Michael Plass, September 12, 1990 11:21 am PDT
DIRECTORY
FS USING [StreamOpen],
Imager, ImagerColor,
ImagerPixel USING [MakePixelMap],
ImagerPixelArray USING [Join3, FromPixelMap, PixelArray],
ImagerSample USING [Fill, NewSampleMap, Put, RasterSampleMap],
IO USING [Close, GetChar, STREAM, EndOfStream],
CGM,
Rope USING [ROPE];
ViewerIO USING [CreateViewerStreams];
CGMImpl: CEDAR PROGRAM
IMPORTS FS, Imager, ImagerColor, IO
EXPORTS CGM
~ BEGIN
inch: REAL = 0.0254; -- inches->meters conversion factor
defaultPageWidth: REAL ~ 0.210; -- for normal A4 sized paper
defaultPageHeight: REAL ~ 0.297; -- for normal A4 sized paper
cgmMarginW: REAL ~ 0.020; -- offset of CGM images on regular-sized paper
cgmMarginH: REAL ~ 0.040; -- offset of CGM images on regular-sized paper
Context: TYPE ~ Imager.Context;
VEC: TYPE ~ Vector2.VEC;
Font: TYPE ~ ImagerFont.Font;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
din, dout: STREAM;
ToInterpress: PUBLIC PROC [context: Imager.Context, fileName: ROPE, pageWidth: REAL ¬ defaultPageWidth, pageHeight: REAL ¬ defaultPageHeight] ~ {
Read the given CGM file and draw its contents.
CGM Globals
lenbytes, lenwords, id, class: CARDINAL ¬ 0;
rgbL, rgbF: ImagerColor.RGB ¬ [0,0,0];
vdc: ARRAY [0..4) OF INTEGER ¬ ALL[0];
maxColorIndex, colorSelectionMode: INTEGER ¬ 0;
bkgColor: ARRAY [0..3) OF INTEGER ¬ ALL[0];
colorTable: ARRAY [0..3) OF ARRAY [0..256) OF INTEGER ¬ ALL[ALL[0]];
colorValueMin, colorValueMax: ARRAY [0..3) OF INTEGER ¬ ALL[0];
lineWidth, lineType: CARDINAL ¬ 0;
edgeVisibility: CARDINAL ¬ 0;
interiorStyle: CARDINAL ¬ 0;
GetByte: PROC [stream: STREAM] RETURNS [BYTE] ~ {
RETURN [stream.GetChar[] - 0C]
};
GetWord: PROC [stream: STREAM] RETURNS [CARDINAL] ~ {
RETURN [(stream.GetChar[] - 0C) * 100H + (stream.GetChar[] - 0C)]
};
GetElement: PROC [stream: STREAM] RETURNS [CARDINAL] ~ {
opCode: CARDINAL ¬ GetWord[stream ! IO.EndOfStream => GOTO empty;];
class ¬ opCode / 4096;
id ¬ (opCode / 32) MOD 64;
lenbytes ¬ opCode MOD 32;
IF lenbytes = 31 THEN lenbytes ¬ GetWord[stream];
lenwords ¬ lenbytes / 2;
RETURN [class + id];
EXITS
empty => RETURN [0];
};
SkipWord: PROC [stream: STREAM, count: CARDINAL] ~ {
FOR i: CARDINAL IN [0..count) DO
dummy: CARDINAL ¬ GetWord[stream];
ENDLOOP;
};
ConsumeParm: PROC [stream: STREAM] ~ {
SkipWord[stream, lenwords];
};
invalidVersion: PUBLIC ERROR = CODE;
unsupportedOpCode: PUBLIC ERROR = CODE;
stream: STREAM ~ FS.StreamOpen[fileName];
WHILE GetElement[stream] ~= 0 DO
dout.PutF["Class = %g\n", IO.int[class]];
dout.PutF["ID = %g\n", IO.int[id]];
dout.PutF["Params = "];
FOR i: CARDINAL IN [0..lenwords) DO
dout.PutF["%g, ", IO.int[GetWord[stream]]];
ENDLOOP;
dout.PutF["\n------------\n"];
SELECT class FROM
0 => SELECT id FROM  -- Delimiter element
0 => NULL;   -- Nop
1 => ConsumeParm[stream]; -- Begin Metafile
2 => NULL;   -- END Metafile
3 => ConsumeParm[stream]; -- Begin Picture
4 => NULL;   -- Begin Picture Body
5 => NULL;   -- End Picture
ENDCASE => ERROR unsupportedOpCode;
1 => SELECT id FROM  -- Metafile Descriptor element
1 => ConsumeParm[stream]; -- Mitafile Version
2 => ConsumeParm[stream]; -- Metafile Description
3 => ConsumeParm[stream]; -- VDC Type
4 => ConsumeParm[stream]; -- Integer Precision
5 => ConsumeParm[stream]; -- Real Precision
6 => ConsumeParm[stream]; -- Index Precision
7 => ConsumeParm[stream]; -- Colour Precision
8 => ConsumeParm[stream]; -- Colour Index Precision
9 =>    -- Maximum Colour Index
maxColorIndex ¬ GetWord[stream];
10 => {   -- Colour Value Extent
FOR i: NAT IN [0..3) DO colorValueMin[i] ¬ GetWord[stream]; ENDLOOP;
FOR i: NAT IN [0..3) DO colorValueMax[i] ¬ GetWord[stream]; ENDLOOP;
};
11 => ConsumeParm[stream]; -- Metafile Element List
12 => ConsumeParm[stream]; -- Metafile Defaults Replacement
13 => ConsumeParm[stream]; -- Font List
14 => ConsumeParm[stream]; -- Character Set List
15 => ConsumeParm[stream]; -- Character Coding Announcer
ENDCASE => ERROR unsupportedOpCode;
2 => SELECT id FROM  -- Picture Descriptor element
1 => ConsumeParm[stream]; -- Scaling Mode
2 =>    -- Colour Selection Mode
colorSelectionMode ¬ GetWord[stream];
3 => ConsumeParm[stream]; -- Line Width Specification Mode
4 => ConsumeParm[stream]; -- Marker Size Spcification Mode
5 => ConsumeParm[stream]; -- Edge Width Spcification Mode
6 => {   -- VDC Extent
rotate: BOOL ¬ FALSE;
scale: REAL;
w, h: INTEGER;
FOR i: NAT IN [0..4) DO vdc[i] ¬ GetWord[stream]; ENDLOOP;
w ¬ ABS[vdc[2] - vdc[0]];
h ¬ ABS[vdc[3] - vdc[1]];
IF w > h THEN {
rotate ¬ TRUE;
scale ¬ MIN[(pageHeight-2*cgmMarginH)/w, (pageWidth-2*cgmMarginW)/h];
}
ELSE {
rotate ¬ FALSE;
scale ¬ MIN[(pageWidth-2*cgmMarginW)/w, (pageHeight-2*cgmMarginH)/h];
};
Imager.TranslateT[context, [pageWidth*0.5, pageHeight*0.5]];
IF rotate THEN Imager.RotateT[context, 90.0];
Imager.ScaleT[context, scale];
Imager.TranslateT[context, [-(vdc[0]+w*0.5), -(vdc[1]+h*0.5)]];
};
7 =>    -- Background Colour
FOR i: NAT IN [0..3) DO bkgColor[i] ¬ GetWord[stream]; ENDLOOP;
ENDCASE => ERROR unsupportedOpCode;
3 => SELECT id FROM  -- Control element
1 => ConsumeParm[stream]; -- VDC Integer Precision
2 => ConsumeParm[stream]; -- VDC Real Precision
3 => ConsumeParm[stream]; -- Auxiliary Colour
4 => ConsumeParm[stream]; -- Transparency
5 => ConsumeParm[stream]; -- Clip Rectangle
6 => ConsumeParm[stream]; -- Clip Indicator
ENDCASE => ERROR unsupportedOpCode;
4 => SELECT id FROM  -- Graphical Primitive element
1 => {   -- Polyline
x, y: INTEGER;
Path: Imager.PathProc ~ {
x ¬ GetWord[stream];
y ¬ GetWord[stream];
moveTo[[x, y]]; -- the first point
FOR i: NAT IN [1..lenwords/2) DO
x ¬ GetWord[stream];
y ¬ GetWord[stream];
lineTo[[x, y]];
ENDLOOP;
};
Imager.SetColor[context, ImagerColor.ColorFromRGB[rgbL]];
Imager.SetStrokeWidth[context, lineWidth];
Imager.MaskStroke[context: context, path: Path, closed: FALSE];
};
2 => ConsumeParm[stream]; -- Disjoint Polyline
3 => ConsumeParm[stream]; -- Polymarker
4 => ConsumeParm[stream]; -- Text
5 => ConsumeParm[stream]; -- Restricted Text
6 => ConsumeParm[stream]; -- Append Text
7 => {   -- Polygon
x, y: INTEGER;
Path: Imager.PathProc ~ {
x ¬ GetWord[stream];
y ¬ GetWord[stream];
moveTo[[x, y]]; -- the first point
FOR i: NAT IN [1..lenwords/2) DO
x ¬ GetWord[stream];
y ¬ GetWord[stream];
lineTo[[x, y]];
ENDLOOP;
};
Imager.SetColor[context, ImagerColor.ColorFromRGB[rgbF]];
Imager.MaskFill[context: context, path: Path];
};
8 => ConsumeParm[stream]; -- Polygon Set
9 => ConsumeParm[stream]; -- Cell Array
10 => ConsumeParm[stream]; -- Generalized Drawing Primitive
11 => {   -- Rectangle
pt: ARRAY [0..4) OF INTEGER;
Imager.MaskRectangleI[context, pt[0], pt[1], pt[2] - pt[0], pt[3] - pt[1]];
Path: Imager.PathProc ~ {
FOR i: NAT IN [0..4) DO pt[i] ¬ GetWord[stream]; ENDLOOP;
moveTo[[pt[0], pt[1]]];
lineTo[[pt[2], pt[1]]]; lineTo[[pt[2], pt[3]]];
lineTo[[pt[0], pt[3]]]; lineTo[[pt[0], pt[1]]];
};
Imager.SetColor[context, ImagerColor.ColorFromRGB[rgbF]];
Imager.MaskFill[context: context, path: Path];
};
12 => {   -- Circle
Path: Imager.PathProc ~ {
x, y, r: INTEGER;
x ¬ GetWord[stream]; y ¬ GetWord[stream]; r ¬ GetWord[stream];
moveTo[[x, y + r]];
arcTo[[x, y - r], [x, y + r]];
};
Imager.SetColor[context, ImagerColor.ColorFromRGB[rgbF]];
Imager.MaskFill[context: context, path: Path];
};
13 => ConsumeParm[stream]; -- Circular Arc 3 Point
14 => ConsumeParm[stream]; -- Circular Arc 3 Point Close
15 => ConsumeParm[stream]; -- Circular Arc Centre
16 => ConsumeParm[stream]; -- Circular Arc Centre Close
17 => ConsumeParm[stream]; -- Ellipse
18 => ConsumeParm[stream]; -- Elliptical Arc
19 => ConsumeParm[stream]; -- Elliptical Arc Close
ENDCASE => ERROR unsupportedOpCode;
5 => SELECT id FROM  -- Attribute element
1 => ConsumeParm[stream]; -- Line Bundle Index
2 =>    -- Line Type
lineType ¬ GetWord[stream];
3 => {   -- Line Width
lineWidth ¬ GetWord[stream];
IF lineWidth IN [0..3) THEN lineWidth ¬ 3;
};
4 => {   -- Line Colour
ci: CARDINAL;
dc: ARRAY [0..3) OF INTEGER;
IF colorSelectionMode = 0 THEN {
ci ¬ GetWord[stream];
rgbL ¬ [R: colorTable[0][ci] / REAL[colorValueMax[0]],
G: colorTable[1][ci] / REAL[colorValueMax[1]],
B: colorTable[2][ci] / REAL[colorValueMax[2]]];
}
ELSE {
FOR i: NAT IN [0..3) DO dc[i] ¬ GetWord[stream]; ENDLOOP;
rgbL ¬ [R: dc[0] / REAL[colorValueMax[0]],
G: dc[1] / REAL[colorValueMax[1]],
B: dc[2] / REAL[colorValueMax[2]]];
};
};
5 => ConsumeParm[stream]; -- Marker Bundle Index
6 => ConsumeParm[stream]; -- Marker Type
7 => ConsumeParm[stream]; -- Marker Size
8 => ConsumeParm[stream]; -- Marker Colour
9 => ConsumeParm[stream]; -- Text Bundle Index
10 => ConsumeParm[stream]; -- Text Font Index
11 => ConsumeParm[stream]; -- Text Precision
12 => ConsumeParm[stream]; -- Character Expansion Factor
13 => ConsumeParm[stream]; -- Character Spacing
14 => ConsumeParm[stream]; -- Text Colour
15 => ConsumeParm[stream]; -- Character Height
16 => ConsumeParm[stream]; -- Character Orientation
17 => ConsumeParm[stream]; -- Text Path
18 => ConsumeParm[stream]; -- Text Alignment
19 => ConsumeParm[stream]; -- Character Set Index
20 => ConsumeParm[stream]; -- Alternate Character Set Index
21 => ConsumeParm[stream]; -- Fill Bundle Index
22 =>    -- Interior Style
interiorStyle ¬ GetWord[stream];
23 => {   -- Fill Colour
ci: CARDINAL;
dc: ARRAY [0..3) OF INTEGER;
IF colorSelectionMode = 0 THEN {
ci ¬ GetWord[stream];
rgbF ¬ [R: colorTable[0][ci] / REAL[colorValueMax[0]],
G: colorTable[1][ci] / REAL[colorValueMax[1]],
B: colorTable[2][ci] / REAL[colorValueMax[2]]];
}
ELSE {
FOR i: NAT IN [0..3) DO dc[i] ¬ GetWord[stream]; ENDLOOP;
rgbF ¬ [R: dc[0] / REAL[colorValueMax[0]],
G: dc[1] / REAL[colorValueMax[1]],
B: dc[2] / REAL[colorValueMax[2]]];
};
};
24 => ConsumeParm[stream]; -- Hatch Index
25 => ConsumeParm[stream]; -- Pattern Index
26 => ConsumeParm[stream]; -- Edge Bundle Index
27 => ConsumeParm[stream]; -- Edge Type
28 => ConsumeParm[stream]; -- Edge Width
29 => ConsumeParm[stream]; -- Edge Colour
30 =>    -- Edge Visibility
edgeVisibility ¬ GetWord[stream];
31 => ConsumeParm[stream]; -- Pattern Index
32 => ConsumeParm[stream]; -- Pattern Table
33 => ConsumeParm[stream]; -- Pattern Size
34 => {   -- Colour Table
si: NAT ~ GetWord[stream];
FOR i:NAT IN [si..maxColorIndex] DO
colorTable[0][i] ¬ GetWord[stream];
colorTable[1][i] ¬ GetWord[stream];
colorTable[2][i] ¬ GetWord[stream];
ENDLOOP;
};
35 => ConsumeParm[stream]; -- Aspect Souce Flags
ENDCASE => ERROR unsupportedOpCode;
ENDCASE => ERROR unsupportedOpCode;
ENDLOOP;
stream.Close[];
};
END.