ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Examples/Calc/USynchScroller.inc1.p

Text File | 1990-10-25 | 12.5 KB | 461 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ USynchScroller.inc1.p }
{ Copyright © 1989-1990 by Apple Computer Inc. All rights reserved. }

{--------------------------------------------------------------------------------------------------}
{$S AInit}

PROCEDURE InitUSynchScroller;

    BEGIN
    IF qTemplateViews THEN
        BEGIN
        { Suppress Linker dead-stripping of these classes }
        IF gDeadStripSuppression THEN
            BEGIN
            IF Member(TObject(NIL), TSynchScroller) THEN;
            IF Member(TObject(NIL), TPrimaryScroller) THEN;
            IF Member(TObject(NIL), TSecondaryScroller) THEN;
            END;
        END;
    END;

{****************************************************************************************}
{  T S y n c h S c r o l l e r    }
{****************************************************************************************}
{$S ARes}

PROCEDURE TSynchScroller.IRes(itsDocument: TDocument;
                              itsSuperview: TView;
                              VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    fLimiting := FALSE;

    INHERITED IRes(itsDocument, itsSuperview, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TSynchScroller.SetScrollLimits(scrollLimit: VPoint;
                                         drawScrollBars: BOOLEAN); OVERRIDE;

    VAR
        wasLimiting:        BOOLEAN;
        fi:                 FailInfo;

    PROCEDURE HdlSetScrollLimits(error: OSErr;
                                 message: LONGINT);

        BEGIN
        fLimiting := wasLimiting;
        END;

    BEGIN
    wasLimiting := fLimiting;
    fLimiting := TRUE;
    CatchFailures(fi, HdlSetScrollLimits);
    INHERITED SetScrollLimits(scrollLimit, drawScrollBars);
    Success(fi);
    fLimiting := wasLimiting;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TSynchScroller.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                    fieldAddr: Ptr;
                                                    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TSynchScroller', NIL, bClass);
    DoToField('fLimiting', @fLimiting, bBoolean);

    INHERITED Fields(DoToField);
    END;

{****************************************************************************************}
{  T P r i m a r y S c r o l l e r    }
{****************************************************************************************}
{$S ARes}

PROCEDURE TPrimaryScroller.IRes(itsDocument: TDocument;
                                itsSuperview: TView;
                                VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    fSecondaryScrollers := NIL;
    INHERITED IRes(itsDocument, itsSuperview, itsParams);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPrimaryScroller.Free; OVERRIDE;

    BEGIN
    FreeIfObject(fSecondaryScrollers);                    { Next release this becomes a function that
                                                         returns nil. I'm getting sick of nilling
                                                         references by hand afterwards. Thanks for
                                                         the suggestion LT! }
    fSecondaryScrollers := NIL;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPrimaryScroller.AddSecondaryScroller(itsSecondaryScroller: TSecondaryScroller;
                                                itsHDependency, itsVDependency: VCoordinate);

    BEGIN
    IF itsSecondaryScroller <> NIL THEN
        BEGIN
        WITH itsSecondaryScroller DO
            BEGIN
            fPrimaryScroller := SELF;                    { !!! Really should give notification by
                                                         something like BeWithPrimaryScroller. }
            WITH fDeltaFactor DO
                BEGIN
                h := itsHDependency;
                v := itsVDependency;
                END;
            END;

        IF fSecondaryScrollers = NIL THEN
            fSecondaryScrollers := NewList;

        fSecondaryScrollers.Insert(itsSecondaryScroller);

        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPrimaryScroller.RemoveSecondaryScroller(itsSecondaryScroller: TSecondaryScroller);

    BEGIN
    IF itsSecondaryScroller <> NIL THEN
        WITH itsSecondaryScroller DO
            BEGIN
            fPrimaryScroller := NIL;                    { !!! Really should give notification by
                                                         something like BeInPrimaryScroller. }

            IF fSecondaryScrollers <> NIL THEN
                BEGIN
                fSecondaryScrollers.Delete(itsSecondaryScroller);
                IF fSecondaryScrollers.IsEmpty THEN     { !!! TViews should be this nice with
                                                         subview lists }
                    BEGIN
                    FreeIfObject(fSecondaryScrollers);
                    fSecondaryScrollers := NIL;
                    END;
                END;

            END;

    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPrimaryScroller.DoScroll(delta: VPoint;
                                    redraw: BOOLEAN); OVERRIDE;

    PROCEDURE SynchDependents(aSecondaryScroller: TSecondaryScroller);

        BEGIN
        WITH aSecondaryScroller DO
            BEGIN
            IF fDeltaFactor.h <> 0 THEN
                fTranslation.h := fTranslation.h + delta.h;

            IF fDeltaFactor.v <> 0 THEN
                fTranslation.v := fTranslation.v + delta.v;

            IF NOT EqualPt(fDeltaFactor, gZeroPt) THEN
                InvalidateFocus;                        { You never know who might call }
            END;
        END;

    BEGIN
    INHERITED DoScroll(delta, redraw);
    IF NOT (fLimiting | redraw) THEN                    { If invoked by SetScrollLimits, don't
                                                         affect peer scrollers }
        IF fSecondaryScrollers <> NIL THEN
            fSecondaryScrollers.Each(SynchDependents)
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPrimaryScroller.ScrollDraw(delta: VPoint;
                                      invalidate: BOOLEAN); OVERRIDE;

    VAR
        superVisRect:        Rect;
        myVFrame:            VRect;
        myQDFrame:            Rect;
        fi:                 FailInfo;
        fi2:                 FailInfo;
        theScrollRgn:        RgnHandle;
        {$IFC qExperimentalAndUnsupported}
        oldgEnableDoubleBuffering: Boolean;
        {$EndC}

    PROCEDURE HdlScrollDraw(error: OSErr;
                            message: LONGINT);

        BEGIN
        IF theScrollRgn <> NIL THEN
            DisposeRgn(theScrollRgn);
        theScrollRgn := NIL;
        END;

    PROCEDURE HdlDoScrollDraw(error: OSErr;
                            message: LONGINT);

        BEGIN
        {$IFC qExperimentalAndUnsupported}
        gEnableDoubleBuffering := oldgEnableDoubleBuffering;
        {$EndC}
        END;

    PROCEDURE SynchDependents(aSecondaryScroller: TSecondaryScroller);

        BEGIN
        WITH aSecondaryScroller DO
            BEGIN
            IF fDeltaFactor.h <> 0 THEN
                fTranslation.h := fTranslation.h + delta.h;

            IF fDeltaFactor.v <> 0 THEN
                fTranslation.v := fTranslation.v + delta.v;
            END;
        END;

    PROCEDURE ForceRedrawDependents(aSecondaryScroller: TSecondaryScroller);
    { Force the redraw if we're dependent on the direction }

        BEGIN
        WITH aSecondaryScroller DO
            BEGIN
            IF (delta.v <> 0) & (fDeltaFactor.v <> 0) THEN
                ForceRedraw
            ELSE IF (delta.h <> 0) & (fDeltaFactor.h <> 0) THEN
                ForceRedraw;
            END;
        END;

    PROCEDURE ScrollDependents(aSecondaryScroller: TSecondaryScroller);
    { Scroll the dependents if they're not }

        VAR
            frameVRect:         VRect;
            frameRect:            Rect;

        BEGIN
        WITH aSecondaryScroller DO
            BEGIN
            { !!! with additional tests we could also support scrollers in other superviews
            and non-matching extents and scrollLimits in the pertinent axis by simply calling
            their scrolling methods.  This would be nice for synchronized windows. }
            GetFrame(frameVRect);
            fSuperView.ViewToQDRect(frameVRect, frameRect);
            IF (delta.h <> 0) & (delta.v <> 0) & (fDeltaFactor.h = kNotHDependent) &
               (fDeltaFactor.v <> kNotVDependent) THEN { main scroller is moving both directions
                                                         but dependent can only move in v }
                BEGIN
                ScrollRect(frameRect, 0, - delta.v, gTempRgn);
                InvalRgn(gTempRgn);
                END
            ELSE IF (delta.h <> 0) & (delta.v <> 0) & (fDeltaFactor.h <> kNotHDependent) &
                    (fDeltaFactor.v = kNotVDependent) THEN { main scroller is moving both
                                                             directions but dependent can only move
                                                             in h }
                BEGIN
                ScrollRect(frameRect, - delta.h, 0, gTempRgn);
                InvalRgn(gTempRgn);
                END
            ELSE IF ((delta.h <> 0) & (fDeltaFactor.h <> kNotHDependent)) | ((delta.v <> 0) &
                    (fDeltaFactor.v <> kNotVDependent)) THEN { main scroller is moving in either
                                                               direction and dependent can follow }
                BEGIN
                RectRgn(gTempRgn, frameRect);
                UnionRgn(theScrollRgn, gTempRgn, theScrollRgn);
                END;
            END;
        END;

    PROCEDURE DoScrollDraw;

        VAR
            aPoint: Point;
            aWindow: TWindow;
            theUpdateRgn: RgnHandle;

        BEGIN
        theScrollRgn := NIL;
        CatchFailures(fi, HdlScrollDraw);
        theScrollRgn := MakeNewRgn;

        GetFrame(myVFrame);
        fSuperView.ViewToQDRect(myVFrame, myQDFrame);
        RectRgn(theScrollRgn, myQDFrame);

        fSuperView.GetVisibleRect(superVisRect);

        IF gIntenseDebugging THEN
            BEGIN
            WrLblRect('             superVisRect', superVisRect);
            WRITELN;
            WrLblVPt('          gLongOffset', gLongOffset);
            WRITELN;
            END;

        IF fSecondaryScrollers <> NIL THEN
            fSecondaryScrollers.Each(SynchDependents);

        IF (ABS(delta.h) > kMaxCoord) | (ABS(delta.v) > kMaxCoord) THEN
            BEGIN                                        { Too far to use ScrollRect }

            ForceRedraw;

            IF fSecondaryScrollers <> NIL THEN
                fSecondaryScrollers.Each(ForceRedrawDependents);

            END
        ELSE
            BEGIN                                        { Can use ScrollRect }
            {$IFC qDebug}
            UseTempRgn('TPrimaryScroller.ScrollDraw');
            {$ENDC}

            IF fSecondaryScrollers <> NIL THEN
                fSecondaryScrollers.Each(ScrollDependents);

            IF qDebug THEN
                fSuperView.AssumeFocused;

            { Now, we've either scrolled any dependent scrollers that can't scroll with
            us or we've accumulated their frames in theScrollRgn.  By clipping to the
            accumulated region we can just scroll the entire superview and the right
            stuff should happen. (Cross fingers) }

            RectRgn(gTempRgn, superVisRect);
            SectRgn(theScrollRgn, gTempRgn, theScrollRgn);
            SetClip(theScrollRgn);

            { If we're in a window then remove the update area from the clipRgn since it contains
            stale bits and it's no use to move them (in fact it's damaging) }
            aWindow := GetWindow;
            if aWindow <> NIL THEN
                BEGIN
                theUpdateRgn := WindowPeek(aWindow.fWMgrWindow)^.updateRgn;
                if not EmptyRgn(theUpdateRgn) THEN
                    begin

                    { The update region is in global coords but the clip is in local coords.
                    Offset the region to make it in local coords here and restore it there
                    to save copying it }
                    aPoint := gZeroPt;
                    LocalToGlobal(aPoint);
                    OffsetRgn(theUpdateRgn, -aPoint.h,-aPoint.v);

                    DiffRgn(thePort^.clipRgn, theUpdateRgn, gTempRgn);

                    OffsetRgn(theUpdateRgn, aPoint.h,aPoint.v);

                    SetClip(gTempRgn);
                    END;
                END;

            ScrollRect(superVisRect, - delta.h, - delta.v, gTempRgn);
            InvalRgn(gTempRgn);

            {$IFC qDebug}
            DoneWithTempRgn;
            {$ENDC}
            END;

        DisposeRgn(theScrollRgn);
        theScrollRgn := NIL;

        Success(fi);
        END;

    BEGIN
    IF FocusOnSuperView & fSuperView.IsVisible THEN
        BEGIN
        {$IFC qExperimentalAndUnsupported}
        IF gEnableDoubleBuffering & NOT (gPrinting | gDrawingPictScrap) THEN
            BEGIN
            oldgEnableDoubleBuffering := gEnableDoubleBuffering;
            gEnableDoubleBuffering := FALSE;        { so subviews won't attempt to do off screen
                                                     }
            CatchFailures(fi2, HdlDoScrollDraw);
            fSuperView.DoOffScreen(DoScrollDraw);
            Success(fi2);
            gEnableDoubleBuffering := oldgEnableDoubleBuffering;
            END
        ELSE
            DoScrollDraw;
        {$ELSEC}
        DoScrollDraw;
        {$EndC}

        IF qExperimentalAndUnsupported | NOT invalidate THEN
            fSuperView.Update
        ELSE
            fSuperView.InvalidateFocus;
        END;

    END;
{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TPrimaryScroller.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                      fieldAddr: Ptr;
                                                      fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TPrimaryScroller', NIL, bClass);
    DoToField('fSecondaryScrollers', @fSecondaryScrollers, bObject);

    INHERITED Fields(DoToField);
    END;

{****************************************************************************************}
{  T S e c o n d a r y S c r o l l e r    }
{****************************************************************************************}
{$S ARes}

PROCEDURE TSecondaryScroller.DoScroll(delta: VPoint;
                                      redraw: BOOLEAN); OVERRIDE;

    BEGIN
    IF fLimiting THEN                                    { Invoked by SetScrollLimits, so don't
                                                         affect peer scrollers }
        INHERITED DoScroll(delta, redraw)
    ELSE
        fPrimaryScroller.ScrollBy(fDeltaFactor.h * delta.h, fDeltaFactor.v * delta.v, redraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TSecondaryScroller.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                        fieldAddr: Ptr;
                                                        fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TSecondaryScroller', NIL, bClass);
    DoToField('fPrimaryScroller', @fPrimaryScroller, bObject);
    DoToField('fDeltaFactor', @fDeltaFactor, bPoint);

    INHERITED Fields(DoToField);
    END;