Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Utilities/AppBar 1.0d2/AppBar Source/AppBarUnit.p

Text File | 1993-06-18 | 19.6 KB | 712 lines | [TEXT/MPS ]

{
    $Workfile:   AppBarComp.p  $
    $Revision:   1.0  $

    This handles all of our pallette stuff.  Separated from AppBar.p for clarity.

    © 1993 CE Software, Inc.  All rights reserved.

    WHEN    WHO        WHAT

•••••

•••••
}

UNIT AppBarUnit;

INTERFACE

USES Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, MacPrint, GestaltEqu, Folders,
    Errors, Notification, Processes, Aliases, TextServices, AppleEvents;

Function InitLayer:OSErr;
Procedure CloseLayer;
Procedure LayerIdleProc(var doneflag:boolean);
Function myGNEFilter (result:integer; var event:EventRecord):integer;

Procedure DoOpenApp(AllowUserInteraction:Boolean);

IMPLEMENTATION

{$D+} {$R-}

CONST
    kClosePallette=-1;
    kRecalcWindow=-2;

    HiliteMode = $938; {[GLOBAL VAR]  used for color highlighting}

    MyItemWidth=22;
    MyItemHeight=20;
    MaxNumberIcons=20;

TYPE
    MyAppInfo=record
        name:str31;
        TheType,TheCreator:OSType;
        Thepsn:ProcessSerialNumber;
        end;

    MyGlobals=record
        StoredPalletteWindow:windowptr;            {MUST start our globals (TSMHelper assumes this}
        MyProcess:        ProcessSerialNumber;
        WhatToDo:        integer;                {Message to do stuff}
        PalletteIcons:    integer;
        BottomRight:        point;
        TheIcon:        array[1..MaxNumberIcons] of MyAppInfo; {Names of icons in folder}
        TempIcon:        packed array[1..kSmall8BitIconSize] of char;
        LastProcess:    ProcessSerialNumber;
        LastProcessIndex:    integer;
        end;
    MyGlobalsPtr=^MyGlobals;

Function Storage:MyGlobalsPtr; external;
    {This routine holds some data within our data, so we don't have to worry about A5}
Procedure HookUp; external;
    {This connects our jGNE Event filter, necessary so that we can grab the events for our windoid}
Procedure UnHook; external;
    {This unconnects our jGNE Event filter, so that we can quit cleanly.}

{--------------------------------------------------------------------------

    Some color grapics utilities, to draw pretty stuff.

    PlotColorPtr
        A simple routine to draw a color icon.
    PlotBWPtr
        A simple routine to draw a black and white icon (not using any color QuickDraw calls)
    ColorRectDepth
        Gets the "depth" of the rectangle, to know whether to plot color or B&W

        Not part of the layer stuff, used by our UpdateEvent handler.

 --------------------------------------------------------------------------}
Procedure PlotColorPtr(wDepth,wFaceSize:integer; DestRect : Rect; p:ptr; themode:integer);
type bitmapPtr=^bitmap;
var hPixMap:PixMapHandle; pCurPort:grafptr;
begin

    hPixMap:=NewPixMap;
    MoveHHi(handle(hPixMap));
    HLock(handle(hPixMap));

    with hPixMap^^ do begin
        hRes:=$480000;
        vRes:=$480000;
        pixelType:=0;
        planeBytes:=0;
        bounds.top:=0;
        bounds.left:=0;
        bounds.bottom:=wFaceSize;
        bounds.right:=wFaceSize;
        pixelSize:=wDepth;
        cmpCount:=wDepth;
        rowBytes:=((wDepth*wFaceSize) div 8)+$8000;
        baseAddr:=pointer(p);
        end;

    DisposCTable(hPixMap^^.pmTable);
    hPixMap^^.pmTable:=GetCTable(wDepth);

    GetPort(pCurPort);
    CopyBits(bitmapPtr(hPixMap^)^, pCurPort^.portbits, hPixMap^^.bounds,
        DestRect,themode,nil);
    hPixMap^^.baseaddr:=nil;
    hunlock(handle(hPixMap));
    disposPixMap(hPixMap);
    end;

Procedure PlotBWPtr(wFaceSize:integer; DestRect : Rect; p:ptr);
var pCurPort:grafptr; mybitmap:bitmap;
begin
    with mybitmap do begin
        bounds.top:=0;
        bounds.left:=0;
        bounds.bottom:=wFaceSize;
        bounds.right:=wFaceSize;
        rowBytes:=wFaceSize div 8;
        baseAddr:=pointer(p);
        end;
    GetPort(pCurPort);
    CopyBits(mybitmap, pCurPort^.portbits, mybitmap.bounds,DestRect,0,nil);
    end;

Function ColorRectDepth(therect:rect):integer;
var    response: LONGINT; r2:rect; thegd:GDHandle;
begin
    ColorRectDepth:=1;
    if gestalt(gestaltQuickdrawVersion,response)=noerr then
      if response>=gestalt8BitQD then begin {determine if we can use the color QD calls}
        r2:=therect;
        LocalToGlobal(r2.topleft);
        LocalToGlobal(r2.botright);
        thegd:=GetMaxDevice(r2);
        if thegd<>nil then
          ColorRectDepth:=thegd^^.gdPMap^^.pixelSize;
        end;
    end;

{--------------------------------------------------------------------------

    FSDTManRefNum
        Utility routine to get the refnum used by the DeskTop Manager

        Not part of the layer stuff, used by our UpdateEvent handler.

 --------------------------------------------------------------------------}
Function FSDTManRefNum(thevref:integer):integer;
var    myDTPB:    DTPBRec;
    io:OSErr;
begin
    myDTPB.ioNamePtr:=nil;
    myDTPB.ioVRefNum:=thevref;
    io:=PBDTGetPath(@myDTPB);
    if io=NoErr then FSDTManRefNum:=myDTPB.ioDTRefnum
        else FSDTManRefNum:=0;
    end;

{--------------------------------------------------------------------------

    PlotFileIcon
        Gets appropriate icon for a file (from the DeskTop Manager) and plots it.

        Not part of the layer stuff, used by our UpdateEvent handler.

 --------------------------------------------------------------------------}
Procedure PlotFileIcon(which:integer);
var    io:OSErr; flag:boolean; therect:rect;

    Procedure HandleDTMan;
    var    myDTPB:    DTPBRec;
        io:OSErr;
        vindex,tempref:integer;
        mypb:paramBlockRec;
        vname:str63;

        Procedure TryBAndWDT;
        begin
            myDTPB.ioDTReqCount:=kSmallIconSize;
            myDTPB.ioIconType:=kSmallIcon;
            io:=PBDTGetIcon(@myDTPB,false);
            if io=NoErr then begin
                with storage^ do
                    PlotBWPtr(16,therect,@TempIcon);
                exit(PlotFileIcon);
                end;
            end;

        Procedure TryColorDT;
        begin
            myDTPB.ioDTReqCount:=kSmall8BitIconSize;
            myDTPB.ioIconType:=kSmall8BitIcon;
            io:=PBDTGetIcon(@myDTPB,false);
            if io=NoErr then begin
                with storage^ do
                    PlotColorPtr(8,16,therect,@TempIcon,0);
                exit(PlotFileIcon);
                end
                else TryBAndWDT;
            end;

    begin
        vindex:=1;
            repeat
            with mypb do begin
                ioCompletion:=NIL;
                ioNameptr:=@vname;
                ioVRefNum:=0;
                ioVolIndex:=vindex;
                end;
            io:=PBGetVInfo(@mypb,false);
            if io=NoErr then begin
                tempref:=FSDTManRefNum(mypb.iovrefnum);
                if tempref<>0 then begin
                    with storage^,myDTPB do begin
                        ioDTRefNum:=tempref;
                        ioTagInfo:=0;
                        ioDTBuffer:=@TempIcon;
                        ioFileCreator:=storage^.TheIcon[which].TheCreator;
                        ioFileType:=storage^.TheIcon[which].TheType;
                        end;
                    if ColorRectDepth(therect)>2 then TryColorDT else TryBAndWDT;
                    end;
                end;
            vindex:=vindex+1;
            until io<>NoErr;
        end;

    Procedure HandleSpecialIcon(whichicon:integer);
    var    h:handle;
        Procedure TryBAndWSpecial;
        begin
            h:=GetResource('ics#',whichicon);  {Get the icon to the folder out of the system file}
            if h<>nil then begin
                hlock(h);
                PlotBWPtr(16,therect,pointer(h^));
                hunlock(h);
                end;
            end;
        Procedure TryColorSpecial;
        begin
            h:=GetResource('ics8',whichicon);  {Get the icon to the folder out of the system file}
            if h<>nil then begin
                hlock(h);
                PlotColorPtr(8,16,therect,pointer(h^),0);
                hunlock(h);
                end
                else TryBAndWSpecial;
            end;
    begin
        if ColorRectDepth(therect)>2 then TryColorSpecial else TryBAndWSpecial;
        exit(PlotFileIcon);
        end;

begin
    therect:=storage^.StoredPalletteWindow^.portrect;
    with therect do begin
        left:=(which-1)*MyItemWidth;
        right:=left+MyItemWidth;
        eraserect(therect);

        top:=(top+bottom-16) div 2;
        bottom:=top+16;
        left:=(left+right-16) div 2;
        right:=left+16;
        end;
    {Maybe frame it}
    with storage^ do io:=SameProcess(LastProcess,TheIcon[which].Thepsn,flag);
    if flag then begin
        insetrect(therect,-3,-3);
        pensize(2,2);
        framerect(therect);
        pensize(1,1);
        insetrect(therect,3,3);
        end;
    framerect(therect);

    HandleDTMan;

    if storage^.TheIcon[which].theType='APPL' then HandleSpecialIcon(-3996)
        else HandleSpecialIcon(-4000)
    end;

{--------------------------------------------------------------------------

    CloseThePallette
        If we've got a window, close it.  Note just one call to close the service window.
        This should only be called from the 'real' application, not from the event handler.


 --------------------------------------------------------------------------}
Procedure CloseThePallette;
var    io:OSErr;
begin
    if storage^.StoredPalletteWindow<>nil then begin
        io:=CloseServiceWindow(storage^.StoredPalletteWindow);
        storage^.StoredPalletteWindow:=nil;
        end;
    end;

{--------------------------------------------------------------------------

    DrawTheWindow
        Just draw the window.  Note that the ServiceWindow is just a
        window for this purpose.  Since we're calling this from our jGNE
        Event Filter, we are NOT in our owner layer.  So, we don't have our
        A5 world, and our resource file isn't open.  If this was a problem,
        we could go through our IdleProc handler.


 --------------------------------------------------------------------------}
Procedure DrawTheWindow;
var    thewindow:windowptr;
    index:integer;
begin
    thewindow:=storage^.StoredPalletteWindow;
    if thewindow<>nil then begin
        beginupdate(thewindow);
        setport(thewindow);
        with storage^ do begin {Show all the icons}
            for index:=1 to PalletteIcons do PlotFileIcon(index);
            end;
        endupdate(thewindow);
        end;
    end;

{--------------------------------------------------------------------------

    OpenPalletteWindow
        Creates the window.  Count processes, create the window, remember the
        processes.

 --------------------------------------------------------------------------}
Function OpenPalletteWindow:OSErr;
var    therect:rect;
    thewindow:windowptr;
    s2:str255;
    index,thecount,NumIcons:integer;
    myCPB:CInfoPBRec;
    io:OSErr;

        Procedure cio(io:OSErr);
        begin
            if io<>NoErr then begin
                OpenPalletteWindow:=io;
                exit(OpenPalletteWindow);
                end;
            end;

    Procedure EnumerateProcesses;
    var io,err:OSErr; psn:ProcessSerialNumber; myinfo:ProcessInfoRec; flag:boolean;
    begin
        io:=GetFrontProcess(storage^.LastProcess);
        storage^.LastProcessIndex:=0;
        psn.highLongOfPSN:=0;
        psn.lowLongOfPSN:=kNoProcess;
        thecount:=0;
        repeat
            io:=GetNextProcess(psn);
            if io=NoErr then begin
                myinfo.processName:=@s2;
                myinfo.processInfoLength:=sizeof(myinfo);
                myinfo.processAppSpec:=nil;
                io:=GetProcessInformation(psn,myinfo);
                if io=NoErr then
                    if bitand(myinfo.processMode,modeOnlyBackground)=0 then begin
                        thecount:=thecount+1;
                        with storage^.TheIcon[thecount] do begin
                            name:=s2;
                            TheType:=OSType(myinfo.processType);
                            TheCreator:=myinfo.processSignature;
                            Thepsn:=psn;
                            end;
                        io:=SameProcess(psn,storage^.LastProcess,flag);
                        if flag then storage^.LastProcessIndex:=thecount;
                        if thecount=MaxNumberIcons then exit(EnumerateProcesses);
                        end;
                end;
            until io<>NoErr;
        end;

begin
    OpenPalletteWindow:=NoErr;

    EnumerateProcesses;
    storage^.PalletteIcons:=thecount;

    if storage^.StoredPalletteWindow<>nil then CloseThePallette;
    with therect do begin
        bottom:=storage^.BottomRight.v; right:=storage^.BottomRight.h;
        if (storage^.PalletteIcons>0) then begin
            top:=bottom-MyItemHeight;
            left:=right-(storage^.PalletteIcons*MyItemWidth);
            end
            else begin
                left:=right-150;
                top:=bottom-1;
                end;
        end;
    cio(NewServiceWindow(nil, therect,'AppBar',true,noGrowDocProc,pointer(-1),true,
        componentInstance(kCurrentProcess),thewindow));
    storage^.StoredPalletteWindow:=thewindow;
    HiliteWindow(thewindow,true);
    end;
{--------------------------------------------------------------------------

    RecalcWindow
        We've changed the front process!  If both the new front and old front are in
        my list, just redraw the icons.  Otherwise, recreate the window.

 --------------------------------------------------------------------------}
Procedure RecalcWindow;
var    io:OSErr;
    Function IsOK(which:integer):boolean;
    var io,err:OSErr; myinfo:ProcessInfoRec;
    begin
        myinfo.processName:=nil;
        myinfo.processInfoLength:=sizeof(myinfo);
        myinfo.processAppSpec:=nil;
        IsOK:=(GetProcessInformation(storage^.TheIcon[which].ThePsn,myinfo)=NoErr);
        end;
    Procedure FullRecalc;
    var    io:OSErr;
    begin
        io:=OpenPalletteWindow;
        exit(RecalcWindow);
        end;
    Procedure CheckForNew;
    var    index:integer;
        frontpsn:ProcessSerialNumber;
        io:OSErr;
        flag:boolean;
        oldlast:integer;
        tempport:grafptr;
    begin
        io:=GetFrontProcess(frontpsn);
        with storage^ do begin
            for index:=1 to PalletteIcons do begin
                io:=SameProcess(frontpsn,TheIcon[index].ThePsn,flag);
                if io=NoErr then
                    if flag then begin
                        oldlast:=LastProcessIndex;
                        LastProcessIndex:=index;
                        LastProcess:=frontpsn;
                        GetPort(tempport);
                        SetPort(storage^.StoredPalletteWindow);
                        PlotFileIcon(oldlast);
                        PlotFileIcon(index);
                        SetPort(tempport);
                        exit(RecalcWindow);
                        end;
                end;
            end;
        FullRecalc;
        end;

begin
    SystemMenu($BF970002);
    if not IsOK(storage^.LastProcessIndex) then FullRecalc
        else CheckForNew;
    end;
{--------------------------------------------------------------------------

    SetWhatToDo
        We don't want to do much from our jGNE Event Filter, because that lives
        in other applications.  So, we set a flag for what to do, and call
        WakeUpProcess to break us out of our long WaitNextEvent.

 --------------------------------------------------------------------------}
Procedure SetWhatToDo(thecommand:integer);
var    io:OSErr;
begin
    storage^.WhatToDo:=thecommand;
    io:=WakeUpProcess(storage^.MyProcess);
    end;

{--------------------------------------------------------------------------

    LayerIdleProc
        Called from our app's main event loop, if there's a flag for a deferred
        action, we handle it now.

        We've got a special handlers for quitting when the pallette is
        closed.

        If one of our icons have been clicked on, we'll switch to it it here.  We
        might have been able to do it from the frontmost app, but this is
        safer.

 --------------------------------------------------------------------------}
Procedure LayerIdleProc(var doneflag:boolean);
var    io:OSErr;
begin
    with storage^ do
        case WhatToDo of
            kClosePallette:doneFlag:=true; {Quit the AppBar}
            kRecalcWindow:RecalcWindow;
            otherwise
                if WhatToDo>0 then
                    io:=SetFrontProcess(TheIcon[WhatToDo].Thepsn);
            end;
    storage^.WhatToDo:=0;
    end;

{--------------------------------------------------------------------------

    myGNEFilter
        This is how we see the events for our window.  It's called from assembler
        glue to jGNEFilter (it's not a trap patching, though I'll admit it's a
        technicallity).

        This code executes in the heap and A5 world of whatever the frontmost app
        is, it is NOT likely to be running inside of AppBar.  So, globals should
        be dealt with carefully if at all, and we need to be careful.

        We only handle click events.  We can hilite rectangles (but we MUST save and
        restore the port, because it's not our port we're tromping over!) and use
        normal window calls like TrackGoAway and DragWindow.

        To detect our clicks, we call a different kind of FindWindow that finds a
        service window.  We then must make sure it's OUR service window (not all
        service windows might be ours).

        Once we've handled our events, we must make sure to turn them into null events,
        or they will be passed on to the operating system!

        We also check here to see if our window needs updating.  Service Windows
        appear not to get update events, so we have to check manually.  (I could be
        wrong on this, this is what I've discovered so far.)  My update routine doesn't
        use any resources of mine, which is fortunate, because again I'm not really in
        my application's layer.  If this was a problem, I could just flag that an updating
        is necessary and handle it in my application's main event loop.

        I also am checking the front process here to see if the system changed it on me, so
        I need to update my window.

 --------------------------------------------------------------------------}
Function myGNEFilter (result:integer; var event:EventRecord):integer;
var    tempwindow:windowptr; typefind:integer;

    Procedure CheckProcessChanged;
    var    psn:ProcessSerialNumber;
        io:OSErr;
        flag:boolean;
    begin
        io:=GetFrontProcess(psn);
        io:=SameProcess(psn,storage^.LastProcess,flag);
        if not flag then SetWhatToDo(kRecalcWindow);
        end;

    Procedure KillEvent;
    begin
        event.what:=nullEvent;
        end;

    Procedure HandleDrag;
    var    tempport:Grafptr;
        dragrect:rect;
    begin
        Getport(tempport);
        Setport(tempwindow);
        SetRect(dragRect,-32767,-32767,32767,32767);
        DragWindow(tempWindow,event.where,dragRect);
        with storage^.BottomRight do begin
            h:=tempwindow^.portrect.right;
            v:=tempwindow^.portrect.bottom;
            end;
        LocalToGlobal(storage^.BottomRight);
        Setport(tempport);
        KillEvent;
        end;

    Procedure HandleClick;
    var    tempport:Grafptr;
        ThePoint:point;
        AmIn:Boolean;
        TheRect:rect;
        WhichItem:integer;
    begin
        KillEvent;
        Getport(tempport);
        Setport(tempwindow);
        with storage^ do begin
            ThePoint:=event.where;
            GlobalToLocal(ThePoint);
            WhichItem:=(ThePoint.h-tempwindow^.portrect.left) div MyItemWidth+1;
            if (WhichItem>0) and (WhichItem<=PalletteIcons) then begin
                TheRect:=tempWindow^.portrect;
                with TheRect do begin
                    left:=(WhichItem-1)*MyItemWidth;
                    right:=left+MyItemWidth;
                    end;
                BitClr(pointer(HILITEMODE),0);
                InvertRect(TheRect);
                AmIn:=true;
                While WaitMouseUp do begin
                    GetMouse(ThePoint);
                    if PtInRect(ThePoint,TheRect)<>AmIn then begin
                        AmIn:=not AmIn;
                        BitClr(pointer(HILITEMODE),0);
                        InvertRect(TheRect);
                        end;
                    end;
                if AmIn then begin
                    BitClr(pointer(HILITEMODE),0);
                    InvertRect(TheRect);
                    SetWhatToDo(WhichItem);
                    end;
                end;
            end;
        SetPort(tempport);
        end;
begin
    if storage^.StoredPalletteWindow<>nil then
        case event.what of
            mouseDown:begin

                typefind:=FindServiceWindow(event.where,tempWindow);
                if typefind>inSysWindow then
                    if tempwindow=storage^.StoredPalletteWindow then begin
                        case typefind of
                            inDrag: HandleDrag;
                            inGoAway: begin
                                IF TrackGoAway(tempWindow,event.where) THEN
                                    SetWhatToDo(kClosePallette);
                                KillEvent;
                                end;
                            inContent: HandleClick;
                            END;
                        end;
                end;

            nullEvent: begin
                tempwindow:=storage^.StoredPalletteWindow;
                if tempwindow<>nil then
                    if not EmptyRgn(windowpeek(tempwindow)^.updateRgn) then DrawTheWindow;
                CheckProcessChanged;
                end;
            END;    { of event case }
    myGNEFilter:=result;
    end;

{--------------------------------------------------------------------------

    CloseLayer
        This is called right before quitting.  We MUST close the pallette, if
        we don't, it'll stay around forever and be very annoying.  We also have
        to unhook ourselves from jGNEFilter.  Yes, we could encounter problems if
        someone has hooked jGNEFilter after we did.  I don't have a solution for
        that.

 --------------------------------------------------------------------------}
Procedure CloseLayer;
begin
    CloseThePallette;
    UnHook;
    end;

{--------------------------------------------------------------------------

    InitLayer
        This is called from our setup code to draw the window.  We check to
        make sure that we have the Text Services Manager here, and remember our
        process serial number (so we can call WakeUpProcesson ourself).  Finally,
        we hook ourselves into jGNEFilter so that we can get the events for our
        pallette.

 --------------------------------------------------------------------------}
Function InitLayer:OSErr;
var    io:OSErr;
    theresult:longint;
begin
    storage^.WhatToDo:=0;
    InitLayer:=-1;
    if gestalt(gestaltTSMgrVersion,theresult)<>NoErr then exit(InitLayer);
    io:=GetCurrentProcess(storage^.MyProcess);

    with storage^.BottomRight do begin
        v:=screenbits.bounds.bottom-10;
        h:=screenbits.bounds.right-40;
        end;

    if io=NoErr then HookUp;
    InitLayer:=io;
    end;

{--------------------------------------------------------------------------

    DoOpenApp;
        In Response to an AppleEvent, open the prefs folder.  If no such
        luck, select the folder.

 --------------------------------------------------------------------------}
Procedure DoOpenApp(AllowUserInteraction:Boolean);
var    io:OSErr;
begin
    {Try to open our Prefs folder}
    io:=OpenPalletteWindow;
    end;

END.