<<>>
    <<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.