
    <<SessionLogImpl.mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Last edited by Bier on November 4, 1987 4:39:10 pm PST>>
        <<Contents:  Routines recording and playing back a record of an interactive session.  SessionLog is intended to be used with 
        SlackProcess in systems built according to the new user interface architecture (see SlackProcessDoc and AtomButtonsDoc).>>
        <<Pier, October 28, 1987 11:39:17 am PST>>
        <<Bier, March 13, 1991 5:26 pm PST>>
    <<>>
    DIRECTORY
    Atom, Convert, Imager, IO, MessageWindow, RefText, Rope, SessionLog, SlackProcess, Vector2;

    SessionLogImpl: CEDAR PROGRAM
    IMPORTS Atom, Convert, IO, MessageWindow, RefText, Rope
        EXPORTS SessionLog = BEGIN

SyntaxError: SIGNAL [position: NAT, wasThere: Rope.ROPE, notThere: Rope.ROPE] = CODE;
<<Recording>>
    Complain: PROC [r: Rope.ROPE] = {
        MessageWindow.Append[message: r, clearFirst: TRUE];
        MessageWindow.Blink[];
        };

    recentEnterActionError: BOOL _ FALSE;

    EnterAction: PUBLIC PROC [f: IO.STREAM, action: LIST OF REF ANY] = {
        ioError: Rope.ROPE;
        BEGIN
            ENABLE IO.Error => {ioError _ DescribeIOError[ec]; GOTO IOError};
            FOR actionList: LIST OF REF ANY _ action, actionList.rest UNTIL actionList = NIL DO
                IF actionList.first=NIL THEN f.PutF["\"\""] -- assume its an empty rope
                ELSE WITH actionList.first SELECT FROM
                    atom: ATOM => f.PutF["%g", [rope[Atom.GetPName[atom]]]];
                    n: REF INT => f.PutF["%g", [integer[n^]]];
                    r: REF REAL => f.PutF["%g", [real[r^]]];
                    c: REF CHAR => f.PutF["'%g", [character[c^]]];
                    cd: REF CARD => f.PutF["%g", [cardinal[cd^]]];
                    rope: Rope.ROPE => f.PutF["\"%g\"", [rope[rope]]];
                    refText: REF TEXT => f.PutF["\"%g\"", [text[refText]]];
                    refPoint: REF Vector2.VEC => f.PutF["[%g, %g]", [real[refPoint.x]], [real[refPoint.y]]];
                    refRect: REF Imager.Rectangle => f.PutF["[%g %g %g %g]", [real[refRect.x]], [real[refRect.y]], [real[refRect.w]], [real[refRect.h]] 
                    ];
                    ENDCASE; -- shouldn't happen, but don't do anything bad
                IF actionList.rest = NIL THEN f.PutChar['\n]
                ELSE f.PutChar[IO.SP];
                ENDLOOP;
            recentEnterActionError _ FALSE;
            EXITS
                IOError => {
                    IF NOT recentEnterActionError THEN
                        Complain[Rope.Cat["IO.Error (", ioError, ") during SessionLog.EnterAction"]];
                    recentEnterActionError _ TRUE; -- don't Complain again until some call to EnterAction succeeds
                    };
            END;
        };

    DescribeIOError: PROC [ec: IO.ErrorCode] RETURNS [rope: Rope.ROPE] = {
        rope _ SELECT ec FROM
            Null => "Null",
            NotImplementedForThisStream => "NotImplementedForThisStream",
            StreamClosed => "StreamClosed",
            Failure => "Failure",
            IllegalBackup => "IllegalBackup",
            BufferOverflow => "BufferOverflow",
            BadIndex => "BadIndex",
            SyntaxError => "SyntaxError",
            Overflow => "Overflow",
            PFInvalidCode => "PFInvalidCode",
            PFInvalidPFProcs => "PFInvalidPFProcs",
            PFCantBindConversionProc => "PFCantBindConversionProc",
            PFFormatSyntaxError => "PFFormatSyntaxError",
            PFTypeMismatch => "PFTypeMismatch",
            PFUnprintableValue => "PFUnprintableValue",
            ENDCASE => "unknown";
        };
<<Playing Back>>
    PlayScript: PUBLIC PROC [f: IO.STREAM, clientData: REF ANY, notifyProc: SlackProcess.ActionProc] = {
        endOfStream: BOOL _ FALSE;
        WHILE NOT endOfStream DO
            endOfStream _ PlayAction[f, clientData, notifyProc];
            ENDLOOP;
        };

    recentPlayActionError: BOOL _ FALSE;

    PlayAction: PUBLIC PROC [f: IO.STREAM, clientData: REF ANY, notifyProc: SlackProcess.ActionProc] RETURNS [endOfStream: BOOL _ 
    FALSE] = {
        ioError: Rope.ROPE;
        BEGIN
            ENABLE IO.Error => {ioError _ DescribeIOError[ec]; GOTO IOError};
            c: CHAR;
            mouseEvent: BOOL;
            point: Vector2.VEC;
            good: BOOL;
            token: REF ANY;
            actionList: LIST OF REF;

            ReadBlank[f];
            <<For compatibility with the old style of script.>>
            c _ IO.GetChar[f
                !IO.EndOfStream => {endOfStream _ TRUE; CONTINUE}];
            IF endOfStream THEN RETURN;
            IF c = '* THEN {
                atom: ATOM;
                refPoint: REF Vector2.VEC;
                good _ ReadHorizontalBlank[f];
                IF NOT good THEN ERROR;
                point _ ReadPoint[f];
                refPoint _ NEW[Vector2.VEC _ point];
                token _ ReadSpacesAndToken[f];
                atom _ NARROW[token];
                UNTIL token = $EndOfLine DO
                    token _ ReadSpacesAndToken[f];
                    ENDLOOP;
                actionList _ LIST[atom, refPoint];
                }
            <<End of compatibility.>>
            ELSE {
                mouseEvent _ FALSE;
                IO.Backup[f, c];
                token _ $Start;
                UNTIL token = $EndOfLine DO
                    token _ ReadSpacesAndToken[f];
                    IF token = $EndOfLine THEN LOOP;
                    actionList _ AppendToken[token, actionList]
                    ENDLOOP;
                };
            notifyProc[clientData, actionList];
            EXITS
                IOError => {
                    IF NOT recentPlayActionError THEN
                        Complain[Rope.Cat["IO.Error (", ioError, ") during SessionLog.PlayAction"]];
                    recentPlayActionError _ TRUE; -- don't Complain again until some call to PlayAction succeeds
                    };
            END;
        };

    AppendToken: PROC [token: REF ANY, list: LIST OF REF ANY] RETURNS [newList: LIST OF REF ANY] = {
        l: LIST OF REF ANY _ list;
        IF l = NIL THEN RETURN[LIST[token]];
        UNTIL l.rest = NIL DO l _ l.rest ENDLOOP;
        l.rest _ CONS[token, NIL];
        newList _ list;
        };

    <<Parsing>>
        <<>>
    IsDigitOrOp: PROC [c: CHAR] RETURNS [BOOL] = {
        RETURN[c IN ['0..'9] OR c = '- OR c = '+];
        };

    ReadSpacesAndToken: PROC [f: IO.STREAM] RETURNS [token: REF ANY] = {
        word: Rope.ROPE;
        good: BOOL;
        int: INT;
        card: CARD;
        real: REAL;
        firstChar: CHAR;
        good _ ReadHorizontalBlank[f];
        IF NOT good THEN {
            token _ $EndOfLine;
            RETURN;
            };
        firstChar _ IO.PeekChar[f];
        SELECT TRUE FROM
        firstChar = '" => {
            token _ f.GetRopeLiteral[];
            };
        firstChar = '' => {
            [] _ f.GetChar[];
            token _ NEW[CHAR _ f.GetChar[]];
            };
        firstChar = '[ => {
            x, y, w, h: REAL;
            nextChar: CHAR;
        ReadRope[f, "["];
        x _ ReadBlankAndReal[f];
        nextChar _ IO.PeekChar[f];
        SELECT TRUE FROM
        nextChar = ', => {
        ReadRope[f, ","];
        y _ ReadBlankAndReal[f];
        ReadRope[f, "]"];
            token _ NEW[Vector2.VEC _ [x, y]];
        };
        ENDCASE => {
        y _ ReadBlankAndReal[f];
        w _ ReadBlankAndReal[f];
        h _ ReadBlankAndReal[f];
        ReadRope[f, "]"];
            token _ NEW[Imager.Rectangle _ [x, y, w, h]];
        };
            };
        IsDigitOrOp[firstChar] => {
            word _ ReadBlankAndWord[f];
            IF Rope.Find[word, "."] = -1 THEN { -- an integer
                IF Rope.Fetch[word, 0] = '- THEN {
                    int _ IO.GetInt[IO.RIS[word]];
                    token _ NEW[INT _ int];
                    }
                ELSE {
                    card _ IO.GetCard[IO.RIS[word]];
                    IF card > 2147483647 THEN token _ NEW[CARD _ card] -- too big to fit in an INT
                    ELSE token _ NEW[INT _ card];
                    };
                }
            ELSE {
                real _ IO.GetReal[IO.RIS[word]];
                token _ NEW[REAL _ real];
                };
            };
        ENDCASE => {
            word _ ReadBlankAndWord[f];
            token _ Atom.MakeAtom[word];
            };
        };

ReadLine: PROC [f: IO.STREAM] RETURNS [line: Rope.ROPE] = {
<<Reads a rope UNTIL <CR> is encountered.>>
LineBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
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};
};

    ReadSpaceAndChar: PROC [f: IO.STREAM] RETURNS [token: REF ANY] = {
        c: CHAR;
        good: BOOL;
        c _ IO.GetChar[f !IO.EndOfStream => ERROR];
        c _ IO.GetChar[f !IO.EndOfStream => ERROR];
        good _ ReadHorizontalBlank[f];
        IF good THEN ERROR;
        token _ NEW[CHAR _ c];
        };

ReadBlank: PROC [f: IO.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];
};

ReadHorizontalBlank: PROC [f: IO.STREAM] RETURNS [good: BOOL] = {
<<Reads <SPACE>'s, and <TABS>'s until something else is encountered.  Returns good = FALSE if a CR or LF is encountered before 
non-white space>>
HorizontalBlankProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
IO.TAB, IO.SP => RETURN [other];
ENDCASE => RETURN [break];
};
whiteSpace: Rope.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;
IO.TAB, IO.SP => { -- there was some whitespace
nextC: CHAR _ IO.PeekChar[f];
IF nextC = IO.CR OR nextC = IO.LF THEN { -- the whitespace comes at the end of a line
good _ FALSE;
[] _ IO.GetChar[f];
}
ELSE good _ TRUE; -- normal whitespace
};
ENDCASE => {good _ TRUE; IO.Backup[f, c]}; -- there was no whitespace
};

    <<>>
ReadBlankAndReal: PROC [f: IO.STREAM] RETURNS [r: REAL] = {
<<A convenience function.  Equivalent to ReadBlank[f]; r _ ReadReal[f];>>
ReadBlank[f];
r _ ReadReal[f];
};

ReadReal: PROC [f: IO.STREAM] RETURNS [r: REAL] = {
<<Reads digits up to the next ), ], <CR>, <SPACE> or <COMMA>.  Leaves these terminators on the stream.>>
RealBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = TRUSTED {
SELECT char FROM
'), '], ', => RETURN [break];
IO.CR, IO.LF =>RETURN [break];
IO.SP => RETURN [break];
ENDCASE => RETURN [other];
};
realText, buffer: REF TEXT;
end: BOOL _ FALSE;
buffer _ RefText.ObtainScratch[50];
[realText, ----] _ IO.GetToken[f, RealBreakProc, buffer
!IO.EndOfStream => {end _ TRUE; CONTINUE}];
IF end THEN {r _ 0.0; RETURN};
IF RefText.Find[realText, ".", 0, FALSE] = -1 THEN realText _ RefText.Append[realText, ".0"];
r _ Convert.RealFromRope[RefText.TrustTextAsRope[realText]];
RefText.ReleaseScratch[buffer];
};

ReadPoint: PROC [f: IO.STREAM] RETURNS [point: Vector2.VEC] = {
<<Assumes the next rope on the stream will be of the form "[<real1>,<real2>]".>>
ReadBlank[f];
ReadRope[f, "["];
point.x _ ReadBlankAndReal[f];
ReadRope[f, ","];
point.y _ ReadBlankAndReal[f];
ReadRope[f, "]"];
};

ReadRope: PROC [f: IO.STREAM, rope: Rope.ROPE] = {
<<Removes the given rope from the top of the stream. Used to remove formatting words and phrases from 3d files.  We are not 
interested in these strings but only in the data in between them.>>
<<Signals SyntaxError if some other rope is on top.>>
c: CHAR;
endofstream: BOOL _ FALSE;
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;
};

ReadBlankAndWord: PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
ReadBlank[f];
word _ ReadWord[f];
};

ReadWord: PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
<<Used to read in a rope which is data.>>
WordBreakProc: PROC [char: CHAR] RETURNS [IO.CharClass] = {
SELECT char FROM
IO.TAB => RETURN [break];
IO.CR, IO.LF =>RETURN [break];
IO.SP => RETURN [break];
', => RETURN [break];
'] => RETURN [break];
') => RETURN [break];
ENDCASE => RETURN [other];
};
[word, ----] _ IO.GetTokenRope[f, WordBreakProc
!IO.EndOfStream => {word _ NIL; CONTINUE}];
};

    END.