Carousel Volume 2 #1/carousel.iso/mactosh/tech/protocol.hqx/ProtocolSources.pit/UProtocol.inc1.p

Text File | 1985-07-10 | 13.9 KB | 651 lines

{copyright 1986 by Herb Barad}
{Protocol is a program to produce a PICT representation of a class}
{hierarchy from a textual description.}
{parts from Flow MacApp sample - Copyright 1985, 1986 by Apple Computer, Inc.}

CONST
    myFileType = 'TEXT';

   {Command numbers}
    cOutline    =    1000;
    cChart        =    1001;
    cShadow     =    1010;
    {Do my own About... since I have >1 Alerts}
    cAbout        =    1234;
    phAboutApp1    =    5678;
    phAboutApp2    =    5679;
    phAboutApp3    =    5680;

    cSizeBase    =    1100;
    cSizeMin    =    1109;
    cSizeMax    =    1124;
    {1101-1199 reserved for font sizes 1-99 pts.}

    cSavePICT    =    2000;

    kKeywords    =    1000;

   {Menu numbers}
    mView        = 4;
    mFont        = 5;
    mSize        = 6;
    mKeyword    = 7;

    kStaggerAmount    = 16;

    VAR
        gFont:        INTEGER; {Font number}
        gSize:        INTEGER; {Font Size in points}
        gStaggerCount:    INTEGER;

{$S Protocol}
    PROCEDURE OutlineSizes(fontNum: INTEGER);
        VAR c:    CmdNumber;
    BEGIN
        FOR c := cSizeMin TO cSizeMax DO
            BEGIN
            IF RealFont(fontNum, c - cSizeBase) THEN
                SetStyle(c, [outline])
            ELSE
                SetStyle(c, []);
            END;
    END;


    PROCEDURE TProtocolApplication.IProtocolApplication;
        LABEL    1;

        VAR fntName:    Str255;
            strIndex:    INTEGER;
            i:            INTEGER;
            s:            Str255;
            key:        KeyStr;
            shape:        KShape;
            alignment:    KAlignment;
            aStyle:     Style;

            kMenu:        MenuHandle;
            x:            INTEGER;

            FUNCTION  DeleteWord(VAR s: Str255): BOOLEAN; {return TRUE if string ends up empty}
                VAR x:    INTEGER;
            BEGIN
                x := POS(' ', s);
                IF x <= 0 THEN
                    BEGIN
                    s := '';
                    DeleteWord := TRUE;
                    END
                ELSE
                    BEGIN
                    DELETE(s, 1, x);

                    WHILE (s <> '') & (s[1] = ' ') DO
                        DELETE(s, 1, 1);
                    DeleteWord := s = '';
                    END;
            END;

    BEGIN
        IApplication(myFileType);

        InitProtocolchart;

        kMenu := GetMHandle(mKeyword);

        strIndex := 1;
        WHILE TRUE DO
            BEGIN
            GetIndString(s, kKeywords, strIndex);
            IF s = '' THEN LEAVE;

                {uppercase string}
            FOR i := 1 TO LENGTH(s) DO
                IF (s[i] >= 'a') & (s[i] <= 'z') THEN
                    s[i] := CHR(ORD(s[i]) - 32);

                {delete leading blanks}
            WHILE (s <> '') & (s[1] = ' ') DO
                DELETE(s, 1, 1);
            IF s = '' THEN GOTO 1;

                {find end of keyword}
            x := POS(' ', s);
            IF x <= 0 THEN GOTO 1
            ELSE
                BEGIN
                key := COPY(s, 1, x-1);

                    {delete keyword}
                IF DeleteWord(s) THEN GOTO 1;

                CASE s[1] OF
                    'N':    shape := shNone;
                    'O':    shape := shOval;
                    'D':    shape := shDRect;
                    'R':    IF (s[2] = 'R') OR (s[2] = 'O') THEN
                                shape := shRoundRect
                            ELSE
                                shape := shRect;
                    OTHERWISE
                            GOTO 1;
                    END;

                    {delete shape spec}
                IF DeleteWord(s) THEN GOTO 1;

                CASE s[1] OF
                    'L':        alignment := alLeft;
                    'M', 'C':    alignment := alMiddle;
                    'R':        alignment := alRight;
                    OTHERWISE    GOTO 1;
                    END;

                    {delete alignment spec}
                IF DeleteWord(s) THEN ;

                aStyle := [];
                WHILE s <> '' DO
                    BEGIN
                    CASE s[1] OF
                        'B':    aStyle := aStyle + [bold];
                        'I':    aStyle := aStyle + [italic];
                        'U':    aStyle := aStyle + [underline];
                        'O':    aStyle := aStyle + [outline];
                        'S':    aStyle := aStyle + [shadow];
                        'C':    aStyle := aStyle + [condense];
                        'E':    aStyle := aStyle + [extend];
                        OTHERWISE
                                GOTO 1
                        END;
                    IF DeleteWord(s) THEN ;
                    END;

                AddKeyword(key, shape, alignment, aStyle);

                AppendMenu(kMenu, key);
                END;
1:
            strIndex := strIndex + 1;
            END;

        AddResMenu(GetMHandle(mFont), 'FONT');

        {Find out what applFont maps to, so that we set gFont to a real font number.
         This code is inefficient but does not depend on absolute memory locations.
         The other approach is to look at the low memory global that contains the right value.}
        GetFontName(applFont, fntName);
        GetFNum(fntName, gFont);
        OutlineSizes(gFont);
        gSize := 10;
        gStaggerCount := 0;
    END;


    FUNCTION  TProtocolApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;
        VAR flowDocument:  TProtocolDocument;
    BEGIN
        New(flowDocument);
        flowDocument.IProtocolDocument;
        DoMakeDocument := flowDocument;
    END;


    FUNCTION  TProtocolApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
        VAR aName:    Str255;
            menu:    INTEGER;
            item:    INTEGER;

        PROCEDURE TellDocToGen(aProtocolDoc: TProtocolDocument);
        BEGIN
            IF aProtocolDoc.fChartView.fFrame <> NIL THEN
                aProtocolDoc.fChartView.GeneratePict;
        END;

        PROCEDURE TellDocSizeChanged(aDoc: TDocument);
            VAR aProtocolDoc:    TProtocolDocument;
        BEGIN
            aProtocolDoc := TProtocolDocument(aDoc);
            IF aProtocolDoc.fTree <> NIL THEN
                BEGIN
                aProtocolDoc.fTree.SetSize(gSize);
                TellDocToGen(aProtocolDoc);
                END;
        END;


        PROCEDURE TellDocFontChanged(aDoc: TDocument);
            VAR aProtocolDoc:    TProtocolDocument;
        BEGIN
            aProtocolDoc := TProtocolDocument(aDoc);
            IF aProtocolDoc.fTree <> NIL THEN
                BEGIN
                aProtocolDoc.fTree.SetFont(gFont);
                TellDocToGen(aProtocolDoc);
                END;
        END;

    BEGIN
        DoMenuCommand := gNoChanges;
        CmdToMenuItem(aCmdNumber, menu, item);
        IF (aCmdNumber = cAbout) THEN
            BEGIN
            StdAlert(phAboutApp1);
            StdAlert(phAboutApp2);
            StdAlert(phAboutApp3);
            END
        ELSE IF (cSizeMin <= aCmdNumber) AND (aCmdNumber <= cSizeMax) THEN
            BEGIN
            gSize := aCmdNumber - cSizeBase;
            ForAllDocumentsDo(TellDocSizeChanged);
            END
        ELSE IF menu = mFont THEN
            BEGIN
            GetItem(GetMHandle(menu), item, aName);
            GetFNum(aName, gFont);
            ForAllDocumentsDo(TellDocFontChanged);
            OutlineSizes(gFont);
            END
        ELSE
            DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
    END;


    PROCEDURE TProtocolApplication.DoSetupMenus;
        VAR item, fnt, c:    INTEGER;
            aName:            Str255;
            aMenuHandle:    MenuHandle;
    BEGIN
        INHERITED DoSetupMenus;

        aMenuHandle := GetMHandle(mFont);
        FOR item := 1 TO CountMItems(aMenuHandle) DO
            BEGIN
            GetItem(aMenuHandle, item, aName);
            GetFNum(aName, fnt);
            EnableItem(aMenuHandle, item);
            CheckItem(aMenuHandle, item, fnt = gFont);
            END;

        FOR c := cSizeMin TO cSizeMax DO
            EnableCheck(c, TRUE, (c - cSizeBase) = gSize);
    END;



    PROCEDURE TProtocolDocument.IProtocolDocument;
    BEGIN
        IDocument(myFileType, 'FLOW', kUsesDataFork, NOT kUsesRsrcFork,
                    NOT kDataOpen, NOT kRsrcOpen);

        fFileType := myFileType;

        fChartView := NIL;
        fOutlineView := NIL;
        fTree := NIL;
        fText := NewHandle(0);
        fPICT := NIL;
    END;


    PROCEDURE TProtocolDocument.DoNeedDiskSpace(VAR dataForkBytes, rsrcForkBytes: LONGINT);
    BEGIN
        IF fPICT = NIL THEN
            dataForkBytes := GetHandleSize(fText)
        ELSE
            dataForkBytes := 512 + fPICT^^.picSize;
    END;


    PROCEDURE TProtocolDocument.DoMakeViews(forPrinting: BOOLEAN);
        VAR aChartView:     TChartView;
            anOutlineView:    TOutlineView;
    BEGIN
        New(aChartView);
        fChartView := aChartView;
        aChartView.IChartView(SELF);

        IF forPrinting THEN
            aChartView.GeneratePict
        ELSE
            BEGIN
            New(anOutlineView);
            fOutlineView := anOutlineView;
            anOutlineView.IOutlineView(SELF, fText);
            END;
    END;


    PROCEDURE TProtocolDocument.DoMakeWindows; OVERRIDE;

        VAR aWindow:    TWindow;

    BEGIN
    aWindow := NewSimpleWindow(kIDStdWindow, NOT kDialogWindow, kWantHScrollBar, kWantVScrollBar,
                                    fOutlineView);
    AdaptToScreen(aWindow);
    SimpleStagger(aWindow, kStaggerAmount, kStaggerAmount, gStaggerCount);
    END;


    FUNCTION  TProtocolDocument.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
        VAR oldType:    OSType;
            oldCreator: OSType;
            oldPort:    GrafPtr;
            oldSaveExists: BOOLEAN;
            oldTitle:    STRING[63];
            pic:        PicHandle;
            port:        GrafPort;
            r:            Rect;

    BEGIN
            {cSavePICT is enabled by the chart view}
        IF aCmdNumber = cSavePICT THEN {??? This is a little kludgy right now ???}
            BEGIN
            gApplication.CommitLastCommand;

            oldType := fFileType;
            oldCreator := fCreator;
            oldSaveExists := fSaveExists;
            oldTitle := fTitle;
            GetPort(oldPort);

            fFileType := 'PICT';
            fCreator := 'MDRW';
            {This will save to NEW file, not to same existsing outline file}
            fSaveExists := FALSE;
            fTitle := Concat(oldTitle, '.PICT');

            r := fChartView.fExtentRect;
            OpenPort(@port);
            PortSize(r.right-r.left, r.bottom-r.top);
            ClipRect(r);

            pic := OpenPicture(r);

            gNowPrinting := FALSE;
            IF fChartView.fTree <> NIL THEN
                fChartView.fTree.Draw(r, TRUE);

            ClosePicture;
            fPICT := pic;

            Save(aCmdNumber, kAskForFilename, kMakingCopy);

            KillPicture(pic);
            fPICT := NIL;

            fFileType := oldType;
            fCreator := oldCreator;
            fSaveExists := oldSaveExists;
            fTitle := oldTitle;
            SetPort(oldPort);

            ClosePort(@port);

            DoMenuCommand := gNoChanges;
            END
        ELSE
            DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
    END;


    PROCEDURE TProtocolDocument.DoRead(aRefNum: INTEGER; rsrcExists, forPrinting: BOOLEAN);
        VAR numChars:        LONGINT;
    BEGIN
        FailOSErr(GetEOF(aRefNum, numChars));
        SetHandleSize(fText, numChars);
        FailOSErr(FSRead(aRefNum, numChars, fText^));
    END;


    PROCEDURE TProtocolDocument.DoWrite(aRefNum: INTEGER; makingCopy: BOOLEAN);
        VAR n:    LONGINT;
            i:    INTEGER;
            v:    LONGINT;
    BEGIN
        IF fPICT = NIL THEN
            BEGIN
            n := GetHandleSize(fText);
            FailOSErr(FSWrite(aRefNum, n, fText^));
            END
        ELSE
            BEGIN
            v := 0;
            FOR i := 1 TO 512 DIV 4 DO
                BEGIN
                n := 4;
                FailOSErr(FSWrite(aRefNum, n, @v));
                END;

            n := fPICT^^.picSize;
            FailOSErr(FSWrite(aRefNum, n, Ptr(fPICT^)));
            END;
    END;



    PROCEDURE TProtocolDocument.FreeData; OVERRIDE;
    BEGIN
        SetHandleSize(fText, 0);
    END;


    PROCEDURE TOutlineView.IOutlineView(itsDocument: TProtocolDocument; aText: Handle);
        VAR aTEView:        TTEView;
            itsExtent:        Rect;
            aStdHandler:    TStdPrintHandler;
    BEGIN
        fProtocolDoc := TProtocolDocument(itsDocument);
        SetRect(itsExtent, 0, 0, 1000, 100);
        ITEView(NIL, itsDocument, itsDocument.fText, Point(0), cTyping, 10, 8, 1000, 100,
            monaco, 12, [], sizeFixed, sizeVariable, kUnlimited);
        New(aStdHandler);
        aStdHandler.IStdPrintHandler(SELF, FALSE);
    END;


    FUNCTION  TOutlineView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
        VAR aChartView: TChartView;
            kwCmd:        TKWCommand;
            menuNum:    INTEGER;
            itemNum:    INTEGER;
            key:        Str255;
    BEGIN
        DoMenuCommand := gNoChanges;
        IF aCmdNumber < 0 THEN
            BEGIN
            CmdToMenuItem(aCmdNumber, menuNum, itemNum);

            IF menuNum = mKeyword THEN
                BEGIN
                GetItem(GetMHandle(mKeyword), itemNum, key);

                New(kwCmd);
                kwCmd.IKWCommand(SELF, aCmdNumber, key);
                DoMenuCommand := kwCmd;
                END;
            END
        ELSE
        CASE aCmdNumber OF
            cOutline:    BEGIN END;
            cChart:     BEGIN
                        aChartView := fProtocolDoc.fChartView;
                        aChartView.GeneratePict;
                        fFrame.HaveView(aChartView);
                        END;
            OTHERWISE    DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
            END;
    END;


    PROCEDURE TOutlineView.DoSetupMenus;
        CONST    kwCommand1 = -(256*mKeyword+1);

        VAR cmd:        CmdNumber;
            cmdLast:    CmdNumber;
    BEGIN
        INHERITED DoSetupMenus;
        EnableCheck(cOutline, TRUE, TRUE);
        EnableCheck(cChart, TRUE, FALSE);

        cmdLast := kwCommand1 - CountMItems(GetMHandle(mKeyword)) + 1;

        FOR cmd := kwCommand1 DOWNTO cmdLast DO {cmdLast <= kwCommand}
            Enable(cmd, TRUE);
    END;


    PROCEDURE TChartView.IChartView(itsDocument: TProtocolDocument);
        VAR r:                Rect;
            aStdHandler:    TStdPrintHandler;
    BEGIN
        fProtocolDoc := TProtocolDocument(itsDocument);
        fTree := NIL;
        fMinSize := Point($00010001);
        fTarget := SELF;
        fShadow := FALSE;
        fWouldMakePICTScrap := TRUE;

        SetRect(r, 0, 0, 8, 8);     {arbitrary; actual extent calculated at GeneratePict time}
        IView(NIL, itsDocument, r, sizeFixed, sizeFixed, TRUE, hlOff);
        New(aStdHandler);
        aStdHandler.IStdPrintHandler(SELF, TRUE);
    END;


    PROCEDURE TChartView.CalcMinExtent(VAR minExtent: Rect);
    BEGIN
        minExtent.topLeft := Point(0);
        minExtent.botRight := fMinSize;
    END;


    FUNCTION  TChartView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
    BEGIN
        DoMenuCommand := gNoChanges;
        CASE aCmdNumber OF
            cChart:     BEGIN END;
            cOutline:    fFrame.HaveView(fProtocolDoc.fOutlineView);
            cShadow:    BEGIN
                        fShadow := NOT fShadow;
                        GeneratePict;
                        END;
            OTHERWISE    DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
            END;
    END;


    PROCEDURE TChartView.DoPrinterChanged;
    BEGIN
        INHERITED DoPrinterChanged;
        IF fTree <> NIL THEN
            BEGIN
            GeneratePict;
            IF fFrame <> NIL THEN
                fFrame.ForceRedraw;
            END;
    END;


    PROCEDURE TChartView.DoSetupMenus;
    BEGIN
        INHERITED DoSetupMenus;
        EnableCheck(cChart, TRUE, TRUE);
        EnableCheck(cOutline, TRUE, FALSE);
        EnableCheck(cShadow, TRUE, fShadow);

        Enable(cSavePICT, TRUE); {command is handled by the document}
    END;


    PROCEDURE TChartView.Draw(area: Rect);
    BEGIN
        gNowPrinting := gPrinting;
        IF fTree <> NIL THEN
            fTree.Draw(area, FALSE);
    END;


    PROCEDURE TChartView.GeneratePict;
        CONST CR = 13;

        TYPE PAOC81 = PACKED ARRAY[0..80] OF CHAR;

        VAR aTree:        TTree;
            h:            Handle;
            len, n:     INTEGER;
            crChar:     Char;
            pCr:        Ptr;
            lineLen:    INTEGER;
            str:        String80;
            nextReturn: LONGINT;
            viewRect:    Rect;

    BEGIN
        FreeObject(fTree);

        New(aTree);
        aTree.ITree(gFont, gSize, fShadow);
        fProtocolDoc.fTree := aTree;

        h := Handle(fProtocolDoc.fText);
        len := GetHandleSize(h);
        crChar := Chr(CR);
        pCR := Ptr(ORD(@crChar)+1);

        n := 0;
        WHILE n < len DO
            BEGIN
                {find next carriage return}
            nextReturn := Munger(h, n, pCR, 1, NIL, 0);
            IF nextReturn < 0 THEN {not found}
                nextReturn := len;

                {nextReturn - n is size of next line}
            lineLen := nextReturn - n;
            IF lineLen > 80 THEN
                lineLen := 80;

                {Get next line of text}
            BlockMove(Ptr(LONGINT(h^) + n), Ptr(ORD(@str) + 1), lineLen);
            PAOC81(str)[0] := CHR(lineLen); {set length of line}

            IF Length(Str) > 0 THEN
                aTree.GenLine(str);

            n := nextReturn + 1; {skip the CR}
            END;

        gNowPrinting := gPrinting;
        DoCheckPrinter;
        aTree.Layout(viewRect);
        fMinSize := viewRect.botRight;

        fTree := aTree;
        SetExtent(viewRect);
        DoPagination;
        IF fFrame <> NIL THEN
            fFrame.ForceRedraw;
    END;


    PROCEDURE TKWCommand.IKWCommand(itsTEView: TTEView; itsCmdNumber: CmdNumber; s: Str255);
        VAR h:            Handle;
            size:        INTEGER;
    BEGIN
        ITECommand(itsTEView, itsCmdNumber, TRUE);

        size := Length(s);

        h := NewHandle(size);
        FailNIL(h);

        BlockMove(Ptr(ORD(@s)+1), h^, size);

        fNewText := h;
        fNewStart := fHTE^^.selStart;
        fNewEnd := fNewStart + size;
    END;