<<>>
    <<InterpressImageExtractImpl.mesa>>
        <<Copyright Ó 1988, 1989, 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, September 10, 1992 11:18 am PDT>>
        <<Willie-s, April 2, 1992 7:31 pm PST>>
        <<>>
    DIRECTORY
        BasicTime,
        Commander,
        FS,
        Imager,
        ImagerBackdoor,
        ImagerColor,
        ImagerDevice,
        ImagerPixelArray,
        ImagerPrivate,
        ImagerRaster,
        ImagerTransformation,
        InterpressInterpreter,
        IO,
        Prop,
        RasterEncodingStandardIO,
        RefTab,
        Rope,
        SF;

    InterpressImageExtractImpl: CEDAR PROGRAM
    IMPORTS Commander, BasicTime, FS, ImagerBackdoor, ImagerDevice, ImagerRaster, ImagerTransformation, InterpressInterpreter, IO, 
    Prop, RasterEncodingStandardIO, RefTab, Rope

    ~ BEGIN

        Device: TYPE ~ ImagerDevice.Device;
        ROPE: TYPE ~ Rope.ROPE;

        Data: TYPE ~ REF DataRep;
        DataRep: TYPE ~ RECORD [
            msg: IO.STREAM,
            tab: RefTab.Ref, -- to avoid putting them out more than once
            nameRoot: ROPE,
            counter: CARD Ź 0,
            sourceFileName: ROPE,
            page: INT Ź 0
            ];

        RopeFromFactoredTransformation: PROC [f: ImagerTransformation.FactoredTransformation] RETURNS [ROPE] ~ {
            fRope: ROPE Ź NIL;
            n: INT Ź 0;
            IF f.t # [0, 0] THEN {n Ź n + 1; fRope Ź IO.PutFR["%g %g TRANSLATE", [real[f.t.x]], [real[f.t.y]]]};
            IF f.r2 # 0 THEN {n Ź n + 1; fRope Ź IO.PutFR["%g ROTATE %g", [real[f.r2]], [rope[fRope]]]};
            IF f.s # [1, 1] THEN {
                n Ź n + 1;
                IF f.s.x = f.s.y
                    THEN {
                        fRope Ź IO.PutFR["%g SCALE %g", [real[f.s.x]], [rope[fRope]]];
                        }
                    ELSE {
                        fRope Ź IO.PutFR["%g %g SCALE2 %g", [real[f.s.x]], [real[f.s.y]], [rope[fRope]]];
                        };
                };
            IF f.r1 # 0 THEN {n Ź n + 1; fRope Ź IO.PutFR["%g ROTATE %g", [real[f.r1]], [rope[fRope]]]};
            IF fRope = NIL THEN {n Ź n + 1; fRope Ź "1 SCALE"};
            FOR i: INT IN [1..n) DO
                fRope Ź Rope.Concat[fRope, " CONCAT"];
                ENDLOOP;
            RETURN [fRope]
            };

        GetScanOrder: PROC [pa: ImagerPixelArray.PixelArray] RETURNS [ImagerTransformation.Transformation] ~ {
            r: Imager.Rectangle ~ ImagerTransformation.TransformRectangle[pa.m, [0, 0, pa.sSize, pa.fSize]];
            RETURN [ImagerTransformation.PostTranslate[pa.m, [-r.x, -r.y]]]
            };

        DoPixelArray: PROC [device: Device, pa: ImagerPixelArray.PixelArray, m: ImagerTransformation.Transformation, mask: BOOL, 
        colorOperator: ImagerColor.ColorOperator, remarks: ROPE] ~ {
            data: Data ~ NARROW[device.data];
            res: RasterEncodingStandardIO.RES ~ NEW[RasterEncodingStandardIO.RESRep];
            fileName: ROPE Ź NARROW[RefTab.Fetch[x: data.tab, key: pa].val];
            scanOrder: ImagerTransformation.Transformation ~ GetScanOrder[pa];
            f: ImagerTransformation.FactoredTransformation ~ ImagerTransformation.Factor[m: 
            ImagerTransformation.PostScale[ImagerTransformation.Cat[ImagerTransformation.Invert[scanOrder], pa.m, m], 0.001]];
            fRope: ROPE ~ RopeFromFactoredTransformation[f];
            normPA: ImagerPixelArray.PixelArray Ź NEW[ImagerPixelArray.PixelArrayRep Ź pa­];
            normPA.m Ź scanOrder;
            remarks Ź Rope.Cat[fRope, " as ", remarks, " on page ", IO.PutFR1["%g", [integer[data.page]]]];
            IF fileName # NIL THEN {
                IO.PutF[data.msg, "Repeat of %g: %g\n", [rope[fileName]], [rope[remarks]]];
                RETURN
                };
            IF mask THEN res.maskImage Ź normPA ELSE res.colorImage Ź normPA;
            IF colorOperator # NIL AND colorOperator.chromatic THEN {
                res.header Ź "Interpress/Xerox/3.0/RasterEncoding/1.0 ";
                };
            res.colorOperator Ź colorOperator;
            fileName Ź IO.PutFR["%g-%g.res", [rope[data.nameRoot]], [cardinal[data.counter]]];
            data.counter Ź data.counter + 1;
            res.imageProperties Ź Prop.Put[propList: res.imageProperties, key: $name, val: Rope.Cat["Extracted from ", data.sourceFileName, ": 
            ", remarks]];
            res.imageProperties Ź Prop.Put[propList: res.imageProperties, key: $creationTime, val: IO.PutFR1["%g", [time[BasicTime.Now[]]]]];
            IF f.s.x/f.s.y IN [0.999..1.001] THEN {
                res.imageScale.x Ź res.imageScale.y Ź f.s.x;
                };
            RasterEncodingStandardIO.Write[fileName: fileName, res: res];
            fileName Ź FS.FileInfo[name: fileName].fullFName;
            [] Ź RefTab.Insert[x: data.tab, key: pa, val: fileName];
            IO.PutF[data.msg, "%g: %g\n", [rope[fileName]], [rope[remarks]]];
            };

        ExtractSetColor: PROC [device: Device, color: ImagerColor.Color, viewToDevice: ImagerTransformation.Transformation] ~ {
            WITH color SELECT FROM
                color: ImagerColor.SampledColor => {
                    DoPixelArray[device: device, pa: color.pa, m: color.um, mask: FALSE, colorOperator: color.colorOperator, remarks: "Sampled Color"]
                    };
                color: ImagerColor.SampledBlack => {
                    DoPixelArray[device: device, pa: color.pa, m: color.um, mask: FALSE, colorOperator: NIL, remarks: IF color.clear THEN "Clear 
                    Sampled Black" ELSE "Sampled Black"]
                    };
                ENDCASE => NULL;
            device.state.allow Ź [FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE]
            };

        ExtractMaskBoxes: PROC [device: Device, bounds: SF.Box, boxes: SF.BoxGenerator] ~ {
            };

        deviceClass: ImagerDevice.DeviceClass ~ NEW [ImagerDevice.DeviceClassRep Ź [
            SetColor: ExtractSetColor,
            MaskBoxes: ExtractMaskBoxes
            ]];

        ExtractMaskPixel: PROC [context: Imager.Context, pa: ImagerPixelArray.PixelArray] ~ {
            DoPixelArray[device: ImagerRaster.GetDevice[context], pa: pa, m: ImagerBackdoor.GetT[context], mask: TRUE, colorOperator: NIL, 
            remarks: "Mask"];
            };

        class: ImagerPrivate.Class ~ CreateClass[];
        CreateClass: PROC RETURNS [ImagerPrivate.Class] ~ {
            class: ImagerPrivate.Class ~ ImagerRaster.CreateClass[type: $ExtractPixelArrays];
            class.MaskPixel Ź ExtractMaskPixel;
            RETURN [class]
            };

        CreateContext: PROC [data: Data] RETURNS [Imager.Context] ~ {
            deviceParm: ImagerDevice.DeviceParm ~ ImagerDevice.MakeDeviceParm[
                class: deviceClass, sSize: NAT.LAST, fSize: NAT.LAST, scanMode: [slow: right, fast: up], surfaceUnitsPerInch: [25.4, 25.4], 
                surfaceUnitsPerPixel: 1
                ];
            context: Imager.Context ~ ImagerRaster.Create[class: class, deviceClass: deviceClass, deviceParm: deviceParm, data: data, 
            pixelUnits: FALSE];
            RETURN [context];
            };

        GetFileNameToken: PROC [stream: IO.STREAM] RETURNS [rope: ROPE Ź NIL] = {
            FileNameTokenBreak: PROC [char: CHAR] RETURNS [IO.CharClass] = {
                IF char = '_ THEN RETURN [break];
                IF char = '  OR char = '\t OR char = ', OR char = '; OR char = '\n THEN RETURN [sepr];
                RETURN [other];
                };
            rope Ź stream.GetTokenRope[FileNameTokenBreak ! IO.EndOfStream => CONTINUE].token;
            };

        OutputRoot: PROC [inputName: ROPE] RETURNS [ROPE] ~ {
            cp: FS.ComponentPositions;
            [inputName, cp] Ź FS.ExpandName[inputName];
            RETURN [Rope.Substr[inputName, cp.base.start, cp.base.length]];
            };

        Command: Commander.CommandProc = {
            <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>>
            ENABLE FS.Error => {
                result Ź $Failure;
                msg Ź error.explanation;
                IF error.group = user THEN CONTINUE;
                };
            stream: IO.STREAM ~ IO.RIS[cmd.commandLine];
            inputName: ROPE Ź GetFileNameToken[stream];
            Log: InterpressInterpreter.LogProc ~ {
                IO.PutRope[cmd.err, "IP Log: "];
                IO.PutRope[cmd.err, explanation];
                IO.PutRope[cmd.err, "\n"];
                };
            IF inputName = NIL
                THEN RETURN[result: $Failure, msg: cmd.procData.doc]
                ELSE {
                    fullFName: ROPE ~ FS.FileInfo[inputName].fullFName;
                    master: InterpressInterpreter.Master ~ InterpressInterpreter.Open[fullFName, Log];
                    data: Data Ź NEW[DataRep Ź [msg: cmd.out, tab: RefTab.Create[], nameRoot: OutputRoot[fullFName], sourceFileName: fullFName]];
                    context: Imager.Context Ź CreateContext[data];
                    IO.PutF1[cmd.out, "Input file is %g . . .\n", [rope[fullFName]]];
                    FOR i: INT IN [1..master.pages] DO
                        data.page Ź i;
                        InterpressInterpreter.DoPage[master: master, page: i, context: context, log: Log, copy: 1];
                        ENDLOOP;
                    IO.PutF[cmd.out, "%g image%g extracted.\n", [cardinal[data.counter]], [rope[IF data.counter#1 THEN "s" ELSE ""]]];
                    InterpressInterpreter.Close[master: master];
                    };
            };

        Commander.Register[key: "IPImageExtract", proc: Command, doc: "Writes one RES (Raster Encoding Standard) file for each sampled 
        image in the specified Interpress file"];
        Commander.Register[key: "InterpressImageExtract", proc: Command, doc: "Writes one RES (Raster Encoding Standard) file for each 
        sampled image in the specified Interpress file"]

    END.