
<<InterpressArrowsImpl.mesa>>
    <<Copyright Ó 1986, 1990 by Xerox Corporation.  All rights reserved.>>
    <<Michael Plass, March 23, 1990 5:15 pm PST>>
    <<Doug Wyatt, June 6, 1986 2:43:49 pm PDT>>
    <<Last tweaked by Mike Spreitzer on October 4, 1988 4:12:24 pm PDT>>
    <<>>

    DIRECTORY Commander, IO, FS, Imager, ImagerTransformation, ImagerInterpress, ImagerPrivate, Interpress, Process, RefText, Rope;

    InterpressArrowsImpl: CEDAR PROGRAM
    IMPORTS Commander, IO, FS, Imager, ImagerTransformation, ImagerInterpress, Interpress, Process, RefText, Rope
    EXPORTS Imager
    ~ BEGIN

        Transformation: TYPE ~ ImagerTransformation.Transformation;
        Context: TYPE ~ Imager.Context;
        ROPE: TYPE ~ Rope.ROPE;

        ShowTextProc: TYPE ~ PROC [context: Imager.Context, text: REF READONLY TEXT, start, len: NAT, xrel: BOOL];

    DefaultShowText: ShowTextProc _ NIL;

        insertMarkStart: ROPE _ "<==<";
        insertMarkSize: INT _ Rope.Size[insertMarkStart];
        insertMarkEnd: CHAR _ '<;

        InserterShowText: ShowTextProc ~ {
            len _ MIN[NAT[text.length-start], len];
            IF NOT xrel AND len > insertMarkSize+1 AND text[start+len-1] = insertMarkEnd AND Rope.Run[s1: RefText.TrustTextAsRope[text], pos1: 
            start, s2: insertMarkStart] = insertMarkSize AND Imager.GetProp[context, $Arrow] = NIL THEN {
                name: ROPE ~ Rope.Flatten[RefText.TrustTextAsRope[text], start+insertMarkSize, len-insertMarkSize-1];
                master: Interpress.Master _ Interpress.Open[name, NIL ! FS.Error => {SIGNAL Complain[error.explanation]; GOTO Botched}];
                action: PROC ~ {
                    m: ImagerTransformation.Transformation _ NARROW[Imager.GetProp[context, $T]];
                    Imager.PutProp[context, $Arrow, $Arrow];
                    Imager.Move[context];
                    Imager.ConcatT[context, m.TranslateTo[[0,0]].Invert];
                    Interpress.DoPage[master: master, page: 1, context: context, log: NIL];
                    };
                Imager.DoSaveAll[context, action];
                RETURN;
                EXITS Botched => len _ len};
            DefaultShowText[context, text, start, len, xrel];
            RETURN};

    DefaultConcatT: PROC[context: Context, m: Transformation] _ NIL;
        InserterConcatT: PROC[context: Context, m: Transformation] ~ {
            old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
            Imager.PutProp[context, $T, m.Concat[old]];
            DefaultConcatT[context, m];
            };

    DefaultScale2T: PROC[context: Context, s: Imager.VEC] _ NIL;
        InserterScale2T: PROC[context: Context, s: Imager.VEC] ~ {
            old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
            Imager.PutProp[context, $T, old.PreScale2[s]];
            DefaultScale2T[context, s];
            };

    DefaultRotateT: PROC[context: Context, a: REAL] _ NIL;
        InserterRotateT: PROC[context: Context, a: REAL] ~ {
            old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
            Imager.PutProp[context, $T, old.PreRotate[a]];
            DefaultRotateT[context, a];
            };

        Class: TYPE ~ REF ClassRep;
        ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; -- export to Imager.

        Inserter: PROC [context: Imager.Context] RETURNS [Imager.Context] ~ {
            class: Class ~ context.class;
            classCopy: Class ~ NEW[ClassRep _ class^];
            new: Imager.Context ~ NEW[Imager.ContextRep _ [class: classCopy, state: context.state, data: context.data, propList: NIL]];
            IF DefaultShowText = NIL THEN DefaultShowText _ classCopy.ShowText;
            IF DefaultShowText#classCopy.ShowText THEN ERROR;
            IF DefaultConcatT = NIL THEN DefaultConcatT _ classCopy.ConcatT;
            IF DefaultConcatT#classCopy.ConcatT THEN ERROR;
            IF DefaultScale2T = NIL THEN DefaultScale2T _ classCopy.Scale2T;
            IF DefaultScale2T#classCopy.Scale2T THEN ERROR;
            IF DefaultRotateT = NIL THEN DefaultRotateT _ classCopy.RotateT;
            IF DefaultRotateT#classCopy.RotateT THEN ERROR;
            classCopy.ShowText _ InserterShowText;
            classCopy.ConcatT _ InserterConcatT;
            classCopy.Scale2T _ InserterScale2T;
            classCopy.RotateT _ InserterRotateT;
            RETURN [new];
            };

        header: ROPE _ "Interpress/Xerox/3.0 ";

        InterpressArrowsAction: PROC [inputName: ROPE, outputName: ROPE, cmd: Commander.Handle, cmds: IO.STREAM] ~ {
            Log: Interpress.LogProc ~ {
                msg: IO.STREAM ~ cmd.out;
                msg.PutRope[
                    SELECT class FROM
                        Interpress.classMasterError => "Master Error: ",
                        Interpress.classMasterWarning => "Master Warning: ",
                        Interpress.classAppearanceError => "Appearance Error: ",
                        Interpress.classAppearanceWarning => "Appearance Warning: ",
                        Interpress.classComment => "Comment: ",
                        ENDCASE => NIL
                    ];
                msg.PutRope[explanation];
                msg.PutRope[" . . . "];
                };
            master: Interpress.Master ~ Interpress.Open[inputName, Log];
            output: ImagerInterpress.Ref ~ ImagerInterpress.Create[outputName, header];
            FOR i: INT IN [1..master.pages] DO
                Paint: PROC [context: Imager.Context] ~ {
                    cmd.out.PutF["[%g", IO.int[i]];
                    context _ Inserter[context];
                    Interpress.DoPage[master: master, page: i, context: context, log: Log];
                    cmd.out.PutRope["] "];
                    };
                Process.CheckForAbort[];
                ImagerInterpress.DoPage[self: output, action: Paint, scale: 1];
                ENDLOOP;
            ImagerInterpress.Close[output];
            };

        ActionProc: TYPE ~ PROC [inputName: ROPE, outputName: ROPE, cmd: Commander.Handle, cmds: IO.STREAM];

        FindFullName: PROC [inputName: ROPE] RETURNS [ROPE] ~ {
            fullFName: ROPE _ NIL;
            fullFName _ FS.FileInfo[inputName].fullFName;
            RETURN [fullFName]
            };

        CmdTokenBreak: 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];
            };

        GetCmdToken: PROC [stream: IO.STREAM] RETURNS [rope: ROPE] = {
            rope _ NIL;
            rope _ stream.GetTokenRope[CmdTokenBreak ! IO.EndOfStream => CONTINUE].token;
            };

        Command: Commander.CommandProc ~ {
            refAction: REF ActionProc ~ NARROW[cmd.procData.clientData];
            stream: IO.STREAM _ IO.RIS[cmd.commandLine];
            outputName: ROPE _ GetCmdToken[stream];
            secondTokenIndex: INT _ IO.GetIndex[stream];
            gets: ROPE _ GetCmdToken[stream];
            inputName: ROPE _ NIL;
            IF NOT gets.Equal["_"] THEN {
                inputName _ outputName;
                outputName _ NIL;
                stream.SetIndex[secondTokenIndex];
                }
            ELSE {inputName _ GetCmdToken[stream]};
            IF inputName = NIL THEN RETURN[result: $Failure, msg: cmd.procData.doc];
            IF outputName = NIL THEN {
                outputName _ inputName;
                };
            inputName _ FindFullName[inputName ! FS.Error => {
                IF error.group = user THEN {result _ $Failure; msg _ error.explanation; GOTO Quit}
                }];
            cmd.out.PutRope["Reading "];
            cmd.out.PutRope[inputName];
            cmd.out.PutRope[" . . . "];
            refAction^[inputName, outputName, cmd, stream ! Complain => {cmd.err.PutRope[complaint]; cmd.err.PutRope["\n"]; RESUME}];
            outputName _ FindFullName[outputName ! FS.Error => {
                outputName _ "Output file(s)"; CONTINUE};
                ];
            cmd.out.PutRope[outputName];
            cmd.out.PutRope[" written.\n"];
            EXITS Quit => NULL
            };

        Complain: SIGNAL [complaint: ROPE] ~ CODE;

        Commander.Register["InterpressArrows", Command, "Merge figures into an Interpress file using  <==<file<  convention: [output _] 
        input\n", NEW[ActionProc _ InterpressArrowsAction]];

    END.
    <<>>