home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-06-18 | 33.3 KB | 1,172 lines | [TEXT/MPS ] |
- {
- $Workfile: pLayerComp.p $
- $Revision: 1.0 $
-
- This handles all of our pallette stuff. Separated from pLayer.p for clarity.
-
- © 1993 CE Software, Inc. All rights reserved.
-
- WHEN WHO WHAT
-
- •••••
-
- •••••
- }
-
- UNIT pLayerUnit;
-
- 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 HandleNew;
- Procedure HandleOpen;
- Procedure HandleSave;
- Procedure DoOpenFile(TheSpec:FSSpec);
- Procedure DoOpenApp(AllowUserInteraction:Boolean);
-
- IMPLEMENTATION
-
- {$D+} {$R-}
-
- CONST
- kClosePallette=-1;
- kZoomPallette=-2;
-
- HiliteMode = $938; {[GLOBAL VAR] used for color highlighting}
-
- MyItemWidth=48;
- MyItemHeight=80;
- MaxNumberIcons=12;
-
- TYPE
- MyGlobals=record
- StoredPalletteWindow:windowptr; {MUST start our globals (TSMHelper assumes this}
- MyProcess: ProcessSerialNumber;
- WhatToDo: integer; {Message to do stuff}
- PalletteIcons: integer;
- PalletteVref: integer;
- PalletteDirID: longint;
- PalletteName: str63;
- PalletteDTMan: integer;
- IAmZoomed: Boolean;
- BottomLeft: point;
- TheName: array[1..MaxNumberIcons] of str31; {Names of icons in folder}
- TempIcon: packed array[1..kLarge8BitIconSize] of char;
- 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.}
-
- {--------------------------------------------------------------------------
-
- TellFinderOpen
- A simple routine that sends an AppleEvent to the Finder to launch a file. Since
- the Finder does all the work, we don't have to distinguish between cdevs, desk accessories,
- data files, or applications.
-
- Not part of the layer stuff, just the "engine" that makes things work.
-
- --------------------------------------------------------------------------}
- Function TellFinderOpen(name:str63; Thevref:integer; TheDir:longint):OSErr;
- var message, reply: AppleEvent ;
- targetAddress: AEAddressDesc ;
- listElem: AEDesc ;
- resultList: AEDescList ;
- TheSpec:FSSpec;
- TheCreator:OSType;
-
- Procedure FailErr(io:OSErr);
- begin
- if io<>NoErr then begin
- TellFinderOpen:=io;
- exit(TellFinderOpen);
- end;
- end;
-
- begin
- TellFinderOpen:=NoErr;
-
- {Address the AppleEvent}
- TheCreator:='MACS';
- FailErr(AECreateDesc(typeApplSignature,@TheCreator,sizeof(TheCreator),targetAddress));
-
- FailErr( AECreateAppleEvent( 'FNDR', 'sope', targetAddress, 0, 0, message ) ) ;
-
- {Create the parameters}
-
- FailErr( AECreateList( nil, 0, false, resultList ) ) ;
- FailErr(FSMakeFSSpec(TheVref, thedir, name, TheSpec));
- FailErr(NewAliasMinimal(TheSpec,aliashandle(listElem.dataHandle)));
- listElem.descriptorType:=typeAlias;
- FailErr(AEPutDesc(resultList, 1, listElem));
- FailErr(AEDisposeDesc( listElem ) ) ;
- FailErr( AEPutParamDesc( message, 'fsel', resultList ) ) ;
- FailErr( AEDisposeDesc( resultList ) ) ;
-
- FailErr(FSMakeFSSpec(TheVref, thedir, '', TheSpec));
- FailErr(NewAliasMinimal(TheSpec,aliashandle(listElem.dataHandle)));
- listElem.descriptorType:=typeAlias;
- FailErr( AEPutParamDesc( message, '----', listElem ) ) ;
- FailErr( AEDisposeDesc( listElem ) ) ;
-
- {Set up the reply, except we don't really want one}
- reply.dataHandle := nil ;
-
- FailErr( AESend( message, reply, kAENoReply + kAENeverInteract, kAENormalPriority, 1000, nil, nil ) ) ;
-
- FailErr( AEDisposeDesc( message ) ) ; { we own message and reply, and must dispose oftthem }
- FailErr( AEDisposeDesc( targetAddress ) ) ;
- end;
-
- {--------------------------------------------------------------------------
-
- GetPrefsFileSpec
-
- Returns an FSSpec of the preferences folder
-
- --------------------------------------------------------------------------}
- Procedure GetPrefsFileSpec(var TheSpec:FSSpec);
- var io:OSErr;
- begin
- with TheSpec do begin
- io:=FindFolder(kOnSystemDisk,kPreferencesFolderType,true,vRefNum,parID);
- name:='pLayer.Prefs';
- end;
- end;
-
- {--------------------------------------------------------------------------
-
- SaveThePallette
-
- Given an FSSpec, create a data file of the current spec
-
- --------------------------------------------------------------------------}
- Function SaveThePallette(TheSpec:FSSpec):OSErr;
- var refnum:integer;
- PalletteSpec:FSSpec;
- TempAlias:AliasHandle;
- h:handle;
-
- Procedure FailErr(io:OSErr);
- begin
- if io<>NoErr then begin
- SaveThePallette:=io;
- if refnum<>0 then CloseResFile(refnum);
- exit(SaveThePallette);
- end;
- end;
-
- begin
- refnum:=0;
- with storage^ do
- FailErr(FSMakeFSSpec(PalletteVref,PalletteDirID, '', PalletteSpec));
- FailErr(NewAlias(nil,PalletteSpec,TempAlias));
-
- FSpCreateResFile(TheSpec,'pLay','pall',0);
- refnum:=FSpOpenResFile(TheSpec,0);
- if refnum=-1 then FailErr(-100); {oops, can't save file}
- h:=Get1Resource('alis',0);
- if h<>nil then begin
- RmveResource(h);
- disposhandle(h);
- CloseResFile(refnum);
- refnum:=FSpOpenResFile(TheSpec,0);
- end;
- AddResource(handle(TempAlias),'alis',0,storage^.PalletteName);
- WriteResource(handle(TempAlias));
-
- h:=Get1Resource('BLft',0);
- if h=nil then begin
- h:=NewHandle(4);
- AddResource(h,'BLft',0,'BottomLeft');
- WriteResource(h);
- end;
- with storage^ do
- BlockMove(@BottomLeft,h^,4);
- ChangedResource(h);
- WriteResource(h);
- CloseResFile(refnum);
- SaveThePallette:=NoErr;
- end;
-
- {--------------------------------------------------------------------------
-
- SavePrefs
-
- Itsy-bits routine to save the current setting as the preferences
-
- --------------------------------------------------------------------------}
- Procedure SavePrefs;
- var TempSpec:FSSpec;
- io:OSErr;
- begin
- GetPrefsFileSpec(TempSpec);
- io:=SaveThePallette(TempSpec);
- end;
- {--------------------------------------------------------------------------
-
- ReadThePallette
-
- Given an FSSpec, get the FSSpec from within it
-
- --------------------------------------------------------------------------}
- Function ReadThePallette(var TheSpec:FSSpec):OSErr;
- var refnum:integer;
- WasChanged:boolean;
- TempAlias:AliasHandle;
- h:handle;
- TempPoint:point;
-
- Procedure FailErr(io:OSErr);
- begin
- if io<>NoErr then begin
- ReadThePallette:=io;
- if refnum<>0 then CloseResFile(refnum);
- exit(ReadThePallette);
- end;
- end;
-
- begin
- refnum:=0;
- refnum:=FSpOpenResFile(TheSpec,0);
- if refnum=-1 then FailErr(-100); {oops, can't open file}
- TempAlias:=pointer(Get1Resource('alis',0));
- if TempAlias<>nil then FailErr(ResolveAlias(nil,TempAlias,TheSpec,WasChanged))
- else FailErr(-101); {No alias resource}
- h:=Get1Resource('BLft',0);
- if h<>nil then begin
- Blockmove(h^,@TempPoint,4);
- if PtInRgn(TempPoint,GetGrayRgn) then {only update bottom left if on screen}
- storage^.BottomLeft:=TempPoint;
- end;
- CloseResFile(refnum);
- ReadThePallette:=NoErr;
- end;
-
- {--------------------------------------------------------------------------
-
- SilentResolveAliasFile
-
- A replacement for ResolveAliasFile that won't attempt to go to other
- volumes.
-
- --------------------------------------------------------------------------}
- FUNCTION SilentResolveAliasFile(VAR theSpec: FSSpec;
- resolveAliasChains: BOOLEAN;
- VAR targetIsFolder: BOOLEAN;
- VAR wasAliased: BOOLEAN): OSErr;
- var refnum: integer;
- WasChanged: boolean;
- TempAlias: AliasHandle;
- fndrInfo: FInfo;
- theCount: integer;
- myCPB: CInfoPBRec;
- s2: str255;
- io: OSErr;
-
- Procedure FailErr(io:OSErr);
- begin
- if io<>NoErr then begin
- SilentResolveAliasFile:=io;
- if refnum<>0 then CloseResFile(refnum);
- exit(SilentResolveAliasFile);
- end;
- end;
-
- begin
- refnum:=0;
- SilentResolveAliasFile:=NoErr;
- targetIsFolder:=false;
- wasAliased:=false;
- FailErr(FSpGetFInfo(TheSpec,fndrInfo));
- if bitand(fndrInfo.fdflags,$00008000)=0 then exit(SilentResolveAliasFile); {Not an alias file}
-
- wasAliased:=true;
- refnum:=FSpOpenResFile(TheSpec,0);
- if refnum=-1 then FailErr(-100); {oops, can't open file}
- TempAlias:=pointer(Get1Resource('alis',0));
- if TempAlias=nil then FailErr(-101); {No alias resource}
-
- thecount:=1;
- io:=(MatchAlias(nil,kArmSearch+kARMNoUI,
- TempAlias,thecount,@TheSpec,WasChanged,nil,nil));
- FailErr(io);
-
- if TheSpec.ParID=1 then targetIsFolder:=true {this is a volume!}
- else
- with mycpb do begin {is this a directory?}
- ioNamePtr:=@s2; s2:=TheSpec.name;
- iovrefnum:=TheSpec.vrefnum;
- ioDrDirID:=TheSpec.ParID;
- ioFDirIndex:=0;
- FailErr(PBGetCatInfo(@mycpb,false));
- targetIsFolder:=(BitTst(@ioFlAttrib,3));
- end;
- CloseResFile(refnum);
- end;
-
- {--------------------------------------------------------------------------
-
- GetAFolder
-
- Some simple CustomGetFile hacking to select a folder.
-
- --------------------------------------------------------------------------}
- var
- MyTempReply:StandardFileReply;
- MyLastName:str31;
-
- Function MyDlgHook(item:integer; theDialog:DialogPtr; p:ptr):integer;
- VAR dtype:integer; ditem:handle;dbox:rect;
- s,s2:str255;
- io:OSErr;
-
- Begin
- if ResType(WindowPeek(TheDialog)^.refCon)<>'stdf' then begin
- MyDlgHook:=item;
- exit(MyDlgHook);
- end;
- if (item=sfHookFirstCall) then MyLastName:='';
-
- if MyLastName<>MyTempReply.sfFile.name then begin
- {update the button}
- GetIndString(s,1000,1);
- GetDItem(TheDialog,10,dtype,ditem,dbox);
- if MyTempReply.sfFile.name<>'' then begin
- s:=concat(s,'"',MyTempReply.sfFile.name,'"');
- HiliteControl(controlhandle(ditem),0);
- SetCTitle(controlhandle(ditem),s);
- end
- else begin
- GetIndString(s2,1000,2);
- s:=concat(s,s2);
- HiliteControl(controlhandle(ditem),255);
- SetCTitle(controlhandle(ditem),s);
- end;
- MyLastName:=MyTempReply.sfFile.name;
- end;
-
- if item=10 then item:=1;
- MyDlgHook:=item;
- end;
-
- FUNCTION AddFileFilter(PB: CInfoPBPtr; p:ptr): BOOLEAN;
- var i:integer; flag:boolean;
-
- Begin
- with pB^ do
- if BitTst(@pb^.ioFLAttrib,3) then AddFileFilter:=false
- else AddFileFilter:=true;
- end;
-
- Function GetAFolder(VAR thespec:FSSpec):boolean;
- VAR where:point; i,i2,count:integer; MyFile2:SFTypeList; targetIsFolder, wasAliased:boolean;
-
- begin
- GetAFolder:=false;
- where.h:=-1; where.v:=-1;
- MyTempReply.sfFile.name:='';
-
- CustomGetFile(@AddFileFilter,-1,MyFile2,MyTempReply,1000,where,@MyDlgHook,nil,nil,nil,nil);
-
- GetAFolder:=MyTempReply.sfgood;
- if MyTempReply.sfgood then begin
- thespec:=MyTempReply.sfFile;
- if ResolveAliasFile(theSpec, true, targetIsFolder, wasAliased)=NoErr then
- if not targetIsFolder then GetAFolder:=false;
- end;
- end;
-
- {--------------------------------------------------------------------------
-
- 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 custom icon if present, or DeskTop Manager
- if no custom icon) and plots it.
-
- Not part of the layer stuff, used by our UpdateEvent handler.
-
- --------------------------------------------------------------------------}
- Procedure PlotFileIcon(thename:str63; thevref:integer; thedir:longint; therect:rect);
- var TheSpec:FSSpec;
- fndrInfo: FInfo;
-
- Procedure HandleCustomIcon;
- var refnum:integer; h:handle;
- Procedure TryBAndW;
- begin
- h:=Get1Resource('ICN#',-16455);
- if h<>nil then begin
- hlock(h);
- PlotBWPtr(32,therect,pointer(h^));
- end;
- end;
- Procedure TryColor;
- begin
- h:=Get1Resource('icl8',-16455);
- if h=nil then TryBAndW
- else begin
- hlock(h);
- PlotColorPtr(8,32,therect,pointer(h^),0);
- end;
- end;
-
- begin
- refnum:=FSpOpenResFile(TheSpec,0);
- if refnum<>-1 then begin
- if ColorRectDepth(therect)>2 then TryColor else TryBAndW;
- CloseResFile(refnum);
- if h<>nil then exit(PlotFileIcon);
- end;
- end;
-
- Procedure HandleSpecialIcon(whichicon:integer);
- var h:handle;
- Procedure TryBAndWSpecial;
- begin
- h:=GetResource('ICN#',whichicon); {Get the icon to the folder out of the system file}
- if h<>nil then begin
- hlock(h);
- PlotBWPtr(32,therect,pointer(h^));
- hunlock(h);
- end;
- end;
- Procedure TryColorSpecial;
- begin
- h:=GetResource('icl8',whichicon); {Get the icon to the folder out of the system file}
- if h<>nil then begin
- hlock(h);
- PlotColorPtr(8,32,therect,pointer(h^),0);
- hunlock(h);
- end
- else TryBAndWSpecial;
- end;
- begin
- if ColorRectDepth(therect)>2 then TryColorSpecial else TryBAndWSpecial;
- exit(PlotFileIcon);
- end;
-
- Procedure HandleSpecialAlias;
- var targetIsFolder, wasAliased:boolean;
- begin
- targetIsFolder:=false;
- if SilentResolveAliasFile(theSpec, true, targetIsFolder, wasAliased)=NoErr then begin
- if not targetIsFolder then begin
- if FSpGetFInfo(TheSpec,fndrInfo)<>NoErr then exit(PlotFileIcon);
- if bitand(fndrInfo.fdFlags,1024)<>0 then HandleCustomIcon; {target has a custom icon}
- exit(handleSpecialAlias);
- end;
- {We've got a folder or volume here, do something clever with it!}
- TheSpec.name:=concat(TheSpec.name,':Icon_');
- TheSpec.name[length(TheSpec.name)]:=chr(13);
- HandleCustomIcon; {try to open and draw the special icon!}
- end;
- {Check for various special folder types}
- if fndrInfo.fdtype='faam' then HandleSpecialIcon(-3982)
- else if fndrInfo.fdtype='fadr' then HandleSpecialIcon(-3979)
- else if fndrInfo.fdtype='fact' then HandleSpecialIcon(-3976)
- else if fndrInfo.fdtype='faet' then HandleSpecialIcon(-3978)
- else if fndrInfo.fdtype='faex' then HandleSpecialIcon(-3973)
- else if fndrInfo.fdtype='famn' then HandleSpecialIcon(-3978)
- else if fndrInfo.fdtype='fapf' then HandleSpecialIcon(-3974)
- else if fndrInfo.fdtype='fapn' then HandleSpecialIcon(-3975)
- else if fndrInfo.fdtype='fash' then HandleSpecialIcon(-3978)
- else if fndrInfo.fdtype='fast' then HandleSpecialIcon(-3981)
- else if fndrInfo.fdtype='fasy' then HandleSpecialIcon(-3983)
- else if fndrInfo.fdtype='trsh' then HandleSpecialIcon(-3993)
- else if fndrInfo.fdtype='fdrp' then HandleSpecialIcon(-3999)
- else if fndrInfo.fdtype='srvr' then HandleSpecialIcon(-3978)
- else if fndrInfo.fdtype='flpy' then HandleSpecialIcon(-3998)
- else if fndrInfo.fdtype='hdsk' then HandleSpecialIcon(-3998)
- else if targetIsFolder then HandleSpecialIcon(-3999);
- end;
-
- Procedure HandleDTMan;
- var myDTPB: DTPBRec;
- io:OSErr;
-
- Procedure TryBAndWDT;
- begin
- myDTPB.ioDTReqCount:=kLargeIconSize;
- myDTPB.ioIconType:=kLargeIcon;
- io:=PBDTGetIcon(@myDTPB,false);
- if io=NoErr then begin
- with storage^ do
- PlotBWPtr(32,therect,@TempIcon);
- exit(PlotFileIcon);
- end;
- end;
-
- Procedure TryColorDT;
- begin
- myDTPB.ioDTReqCount:=kLarge8BitIconSize;
- myDTPB.ioIconType:=kLarge8BitIcon;
- io:=PBDTGetIcon(@myDTPB,false);
- if io=NoErr then begin
- with storage^ do
- PlotColorPtr(8,32,therect,@TempIcon,0);
- exit(PlotFileIcon);
- end
- else TryBAndWDT;
- end;
-
- Procedure TryMultiple;
- var vindex,tempref:integer;
- mypb:paramBlockRec;
- vname:str63;
- io:OSErr;
- 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:=fndrInfo.fdCreator;
- ioFileType:=fndrInfo.fdType;
- end;
- if ColorRectDepth(therect)>2 then TryColorDT else TryBAndWDT;
- end;
- end;
- vindex:=vindex+1;
- until io<>NoErr;
- end;
-
- begin
- with storage^,myDTPB do begin
- ioDTRefNum:=PalletteDTMan;
- ioTagInfo:=0;
- ioDTBuffer:=@TempIcon;
- ioFileCreator:=fndrInfo.fdCreator;
- ioFileType:=fndrInfo.fdType;
- end;
- if ColorRectDepth(therect)>2 then TryColorDT else TryBAndWDT;
- TryMultiple;
- end;
-
- begin
- with therect do begin
- bottom:=top+32;
- left:=(left+right-32) div 2;
- right:=left+32;
- end;
- framerect(therect);
-
- TheSpec.name:=thename;
- TheSpec.Vrefnum:=thevref;
- TheSpec.ParID:=thedir;
- if FSpGetFInfo(TheSpec,fndrInfo)=NoErr then begin
- if bitand(fndrInfo.fdFlags,1024)<>0 then HandleCustomIcon; {the file itself has a custom icon}
- if bitand(fndrInfo.fdFlags,$00080000)<>0 then HandleSpecialAlias;
- end;
-
- HandleDTMan;
-
- if fndrInfo.fdType='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; therect:rect;
- s2:str255;
- io:OSErr;
- index,thecount:integer;
- thechar:char;
- begin
- thewindow:=storage^.StoredPalletteWindow;
- if thewindow<>nil then begin
- beginupdate(thewindow);
- setport(thewindow);
- with storage^ do begin {Start getting the count of files}
- if IAmZoomed then
- for index:=1 to PalletteIcons do begin
- s2:=TheName[index];
- therect:=thewindow^.portrect;
- with therect do begin
- left:=(index-1)*MyItemWidth;
- right:=left+MyItemWidth;
- PlotFileIcon(s2,PalletteVref,PalletteDirID,therect);
- {if index<11 then begin
- TextFont(0); TextSize(0);
- if index<10 then thechar:=chr(ord('0')+index)
- else thechar:='0';
- moveto(left,top+32); drawchar(thechar);
- end;}
- top:=thewindow^.portrect.top+32;
- bottom:=thewindow^.portrect.bottom;
- TextFont(applFont);
- TextSize(9);
- TextBox(POINTER(ORD(@s2)+1),LENGTH(s2),therect,teJustCenter);
- end;
- end;
- end;
- endupdate(thewindow);
- end;
- end;
-
- {--------------------------------------------------------------------------
-
- OpenPalletteWindow
- Creates the window. We find our icons to deal with, and thus
- calculates the window's bounds. Then, just create it by calling
- NewServiceWindow with kCurrentProcess for the "component". This means
- that no component owns it.
-
- --------------------------------------------------------------------------}
- Function OpenPalletteWindow(TheSpec:FSSpec):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;
- begin
- OpenPalletteWindow:=NoErr;
- with mycpb,storage^ do begin {Get the DirID, and the number of files}
- ioNamePtr:=@s2; s2:=TheSpec.name;
- iovrefnum:=TheSpec.vrefnum;
- ioDrDirID:=TheSpec.ParID;
- ioFDirIndex:=0;
- cio(PBGetCatInfo(@mycpb,false));
- if BitTst(@ioFlAttrib,3)=false then cio(-100);
- PalletteVref:=iovrefnum;
- PalletteDirID:=ioDrDirID;
- PalletteName:=TheSpec.name;
- PalletteDTMan:=FSDTManRefNum(PalletteVref);
-
- NumIcons:=ioDrNmFls; {let's find the first 10 visible files/folders}
- thecount:=0;
- index:=1;
- while (index<=NumIcons) and (thecount<MaxNumberIcons) do begin
- ioNamePtr:=@s2; s2:='';
- iovrefnum:=PalletteVref;
- ioDrDirID:=PalletteDirID;
- ioFDirIndex:=index;
- io:=PBGetCatInfo(@mycpb,false);
- if io=NoErr then
- if BitTst(@ioFlAttrib,3)=false then
- if bitand(ioFlFndrInfo.fdFlags,fInvisible)=0 then begin
- thecount:=thecount+1;
- TheName[thecount]:=s2;
- end;
- index:=index+1;
- end;
- PalletteIcons:=thecount;
- end;
- if storage^.StoredPalletteWindow<>nil then CloseThePallette;
- storage^.IAmZoomed:=true;
- with therect do begin
- bottom:=storage^.BottomLeft.v; left:=storage^.BottomLeft.h;
- if (storage^.PalletteIcons>0) then begin
- top:=bottom-MyItemHeight;
- right:=left+(storage^.PalletteIcons*MyItemWidth);
- end
- else begin
- right:=left+150;
- top:=bottom-1;
- end;
- end;
- cio(NewServiceWindow(nil, therect,storage^.PalletteName,true,zoomNoGrow,pointer(-1),true,
- componentInstance(kCurrentProcess),thewindow));
- storage^.StoredPalletteWindow:=thewindow;
- HiliteWindow(thewindow,true);
- SavePrefs;
- end;
-
- {--------------------------------------------------------------------------
-
- ZoomThePallette
- Flip from big window to little window
-
- --------------------------------------------------------------------------}
- Procedure ZoomThePallette;
- var io:OSErr;
- thewindow:windowptr;
- therect:rect;
- begin
- with storage^ do
- if StoredPalletteWindow<>nil then begin
- IAmZoomed:=not IAmZoomed;
- io:=CloseServiceWindow(StoredPalletteWindow);
- with therect do begin
- bottom:=storage^.BottomLeft.v; left:=storage^.BottomLeft.h;
- if (PalletteIcons>0) and (IAmZoomed) then begin
- top:=bottom-MyItemHeight;
- right:=left+(storage^.PalletteIcons*MyItemWidth);
- end
- else begin
- right:=left+150;
- top:=bottom-1;
- end;
- end;
- io:=(NewServiceWindow(nil, therect,PalletteName,true,zoomNoGrow,pointer(-1),true,
- componentInstance(kCurrentProcess),thewindow));
- StoredPalletteWindow:=thewindow;
- HiliteWindow(thewindow,true);
- end;
- 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 launch it here. We
- might have been able to do it from the frontmost app, but this is
- safer. Also, we know we're in an Apple Event aware app, so we can
- send the AppleEvents cleanly.
-
- --------------------------------------------------------------------------}
- Procedure LayerIdleProc(var doneflag:boolean);
-
- Procedure HandleAction(which:integer);
- var io:OSErr;
- begin
-
- with storage^ do begin {Send AppleEvent to Finder to open the file}
- io:=TellFinderOpen(TheName[which],PalletteVref,PalletteDirID);
- end;
- end;
-
- begin
- case storage^.WhatToDo of
- kClosePallette:doneFlag:=true; {Quit the pLayer}
- kZoomPallette:ZoomThePallette;
- otherwise
- if storage^.WhatToDo>0 then
- HandleAction(storage^.WhatToDo);
- 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 pLayer. 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.
-
- --------------------------------------------------------------------------}
- Function myGNEFilter (result:integer; var event:EventRecord):integer;
- var tempwindow:windowptr; typefind:integer;
- Procedure KillEvent;
- begin
- event.what:=nullEvent;
- end;
-
- Procedure HandleDrag;
- var tempport:Grafptr;
- dragrect:rect;
- begin
- SetRect(dragRect,-32767,-32767,32767,32767);
- DragWindow(tempWindow,event.where,dragRect);
- Getport(tempport);
- Setport(tempwindow);
- with storage^.BottomLeft do begin
- h:=tempwindow^.portrect.left;
- v:=tempwindow^.portrect.bottom;
- end;
- LocalToGlobal(storage^.BottomLeft);
- Setport(tempport);
- KillEvent;
- SavePrefs;
- end;
-
- Procedure HandleClick;
- var tempport:Grafptr;
- ThePoint:point;
- AmIn:Boolean;
- TheRect:rect;
- WhichItem:integer;
- begin
- KillEvent;
- Getport(tempport);
- Setport(tempwindow);
- with storage^ do
- if IAmZoomed then 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;
- inZoomIn,inZoomOut: begin
- if TrackBox(tempWindow,event.where,typeFind) then
- SetWhatToDo(kZoomPallette);
- KillEvent;
- end;
- inContent: HandleClick;
- END;
- end;
- end;
-
- nullEvent: begin
- tempwindow:=storage^.StoredPalletteWindow;
- if tempwindow<>nil then
- if not EmptyRgn(windowpeek(tempwindow)^.updateRgn) then DrawTheWindow;
- 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^.BottomLeft do begin
- v:=screenbits.bounds.bottom-10;
- h:=screenbits.bounds.left+20;
- end;
-
- if io=NoErr then HookUp;
- InitLayer:=io;
- end;
-
- {--------------------------------------------------------------------------
-
- HandleNew
- Have the user select a folder, and if found, open the pallette to it.
-
- --------------------------------------------------------------------------}
- Procedure HandleNew;
- var TheSpec:FSSpec; io:OSErr;
- begin
- if GetAFolder(TheSpec) then io:=OpenPalletteWindow(TheSpec);
- end;
-
- {--------------------------------------------------------------------------
-
- HandleSave;
- Save a reference to this pallette
-
- --------------------------------------------------------------------------}
- Procedure HandleSave;
- VAR MyReply:StandardFileReply;
- io:OSErr;
-
- begin
- StandardPutFile('Save Pallette reference as:','',MyReply);
- if MyReply.sfgood then begin
- io:=SaveThePallette(MyReply.sfFile);
- end;
- end;
-
- {--------------------------------------------------------------------------
-
- HandleOpen;
- Open a previously saved reference
-
- --------------------------------------------------------------------------}
- Procedure HandleOpen;
- VAR MyReply:StandardFileReply;
- MyFile2:SFTypeList;
- io:OSErr;
-
- begin
- MyFile2[0]:='pall';
- StandardGetFile(nil,1,MyFile2,MyReply);
- if MyReply.sfgood then begin
- io:=ReadThePallette(MyReply.sfFile);
- if io=NoErr then io:=OpenPalletteWindow(MyReply.sfFile);
- end;
- end;
-
- {--------------------------------------------------------------------------
-
- DoOpenFile;
- In Response to an AppleEvent, open the (first) file passed)
-
- --------------------------------------------------------------------------}
- Procedure DoOpenFile(TheSpec:FSSpec);
- var io:OSErr;
- begin
- io:=ReadThePallette(TheSpec);
- if io=NoErr then io:=OpenPalletteWindow(TheSpec);
- end;
-
- {--------------------------------------------------------------------------
-
- DoOpenApp;
- In Response to an AppleEvent, open the prefs folder. If no such
- luck, select the folder.
-
- --------------------------------------------------------------------------}
- Procedure DoOpenApp(AllowUserInteraction:Boolean);
- var TheSpec:FSSpec;
- io:OSErr;
- begin
- {Try to open our Prefs folder}
- GetPrefsFileSpec(TheSpec);
- io:=ReadThePallette(TheSpec);
- if io=NoErr then io:=OpenPalletteWindow(TheSpec);
-
- if (io<>NoErr) and AllowUserInteraction then HandleNew;
-
- end;
-
- END.
-