home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-09-27 | 43.3 KB | 1,735 lines | [TEXT/MPS ] |
- {------------------------------------------------------------------------------
- #
- # Apple Products Presents
- #
- # S U R F E R ----- A CommToolbox Sample Application
- # by Alex Kazim
- # SURFERPLUS
- # by Mary Chan
- #
- # Based on the MacDTS Simple Sample Application
- #
- # SurferPlus.p - Pascal Source
- #
- # Copyright © 1988-9 Apple Computer, Inc.
- # All rights reserved.
- #
- # Versions: Sample 1.0 08/88
- # Sample 1.01 11/88
- #
- # Surfer 1.0 10/89
- # SurferPlus 1.0 9/17
- ------------------------------------------------------------------------------}
-
- {
- MODIFICATION HISTORY
- 8/16/90 MC • added scroll back proc
-
- 9/26/89 kaz • changed case on constants to match documentation
- • Fixed error handling to only call xxEvent() if the
- target of the event is a tool window
- • Initializes gBuffer according to sizes[cmDataIn]
- after the CMNew call
-
- 10/1/89 kaz • TermGetConnEnvirons() and FTGetConnEnvirons() were
- merged into one routine: ToolGetConnEnvirons()
- • IsAppWindow() uses GetWRefCon instead of looking
- at the windowrecord refcon field.
- • Moved DiposePtr(gBuffer) to CloseWindow
- • HLock/HUnlock all the tool handles
- • Took out alerts to let the tools handle it themselves
-
- 10/4/89 kaz • Was forgetting to clear gStartFT after a receive
- 9/90 MC • scroll back cache and selection support
-
- }
-
- PROGRAM Sample;
-
- USES
- MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
- CTBUtils, FTIntf,CMIntf,TMIntf, CRMIntf;
-
- CONST
- _WaitNextEvent = $A860;
- _UnimplementedToolTrap = $A89F;
- _CommToolboxTrap = $8B;
- _UnimplementedOSTrap = $9F;
-
- kSysEnvironsVersion = 1;
-
- kOSEvent = app4Evt; { event used by MultiFinder }
- kSuspendResumeMessage = 1; { high byte of suspend/resume event message}
- kResumeMask = 1; { bit of message field for resume vs. suspend}
-
- kMinHeap = 150 * 1024;
- kMinSpace = 10 * 1024;
- kBufferSize = 1 * 1024; { Data Storage Size = 1K }
-
- kExtremeNeg = -32768;
- kExtremePos = 32767 - 1; { required for old region bug }
-
- kDefaultTermTool = 'VT102'; { what tools we want first }
- kDefaultFTTool = 'Text';
- kDefaultConnTool = 'Serial';
-
- rMenuBar = 128; { application's menu bar }
- rAboutAlert = 128; { about alert }
- rUserAlert = 129; { error user alert }
- rWindow = 128; { application's window }
-
- mApple = 128; {Apple menu}
- iAbout = 1;
-
- mFile = 129; {File menu}
- iNew = 1;
- iOpen = 2;
- iClose = 4;
- iSendFile = 9;
- iReceiveFile = 10;
- iQuit = 15;
-
- mEdit = 130; {Edit menu}
- iUndo = 1;
- iCut = 3;
- iCopy = 4;
- iPaste = 5;
- iClear = 6;
-
- mSettings = 131; {Settings menu}
- iConnection = 1;
- iFileTransfer = 2;
- iTerminal = 3;
-
- kDITop = $0050;
- kDILeft = $0070;
-
-
- VERTSCROLLID = 128; { vertical scroll bar resource ID }
- HORISCROLLID = 129; { horizontal scroll bar resource ID }
-
- MAXCACHECOL = 132; { cache column }
- MINCACHECOL = 80;
- MAXCACHELINE = 24; { cache row }
- CACHESIZE = 24*132; { total cache size }
- GROWMINHLIMIT = 50; { size window limit }
- GROWMINVLIMIT = 50; { size window limit }
-
-
- VAR
- gHasWaitNextEvent : BOOLEAN; {set up by Initialize}
- gInBackground : BOOLEAN; {maintained by Initialize and DoEvent }
-
- gStopped : BOOLEAN; {maintained by Initialize and SetLight }
-
- gConn : ConnHandle;
- gFT : FTHandle;
-
- gBuffer : Ptr; { Data Storage for Reads/Writes }
-
- gFTSearchRefNum : LONGINT; { Auto-Initiate File Transfers }
- gStartFT : BOOLEAN; { Auto-start }
- gWasFT : BOOLEAN; { In progress }
-
- {$Z+}
- _GTERM : TermHandle; { Tool Handles: Single Session }
- _MYDATAHANDLE : Handle;
- _MYDATASIZE : LONGINT;
- _VERTSCROLLHDL : ControlHandle;
- _HORISCROLLHDL : ControlHandle;
- _TERMVISRECT : Rect;
- _UPDATERGN : RgnHandle; { preallocated update rgn hdl for scrolling }
- _CACHEDESTRECT : Rect; { cache destination rect }
- _MYDATAHDL : Handle; { preallocate handle for TMPaint }
- _GROWRECT : Rect; { size window limit }
- _PORTRECT : Rect; { current window PORTRECT }
- _BLANKLINE : PACKED ARRAY[MINCACHECOL..MAXCACHECOL] OF CHAR;
- _OLDRGN : RgnHandle;
- _NEWRGN : RgnHandle;
- _SAVECLIP : RgnHandle;
- {$Z-}
-
- PROCEDURE AlertUser(msg: Str255; fatal: BOOLEAN); FORWARD;
- PROCEDURE Terminate; FORWARD;
- FUNCTION MyCacheProc( refcon : LONGINT; theTermData : TermDataBlock ) : LONGINT; EXTERNAL;
- FUNCTION MyClickProc( refcon : LONGINT ) : LONGINT; EXTERNAL;
- PROCEDURE HandleMouseDown ( window : WindowPtr; VAR event : EventRecord); C;EXTERNAL;
- PROCEDURE DoSizeWindow( window : WindowPtr; VAR event : EventRecord);C;EXTERNAL;
- PROCEDURE UpdateCache( _UPDATERGN: RgnHandle);C;EXTERNAL;
- PROCEDURE SetVScrollMax;C;EXTERNAL;
- PROCEDURE CheckTermEnv( GetIt: Boolean);C;EXTERNAL;
- PROCEDURE DeSelection;C;EXTERNAL;
- PROCEDURE CacheActivate( theWindow: WindowPtr; becomingActive : Boolean);C;EXTERNAL;
-
- { ******************************************************************
- * TrapAvailable - Checks to see if a given trap is implemented
- *
- * tNumber - trap number
- * tType - type of trap
- *
- * returns - true if it exists
- *
- ********************************************************************* }
- {$S Initialize}
- FUNCTION TrapAvailable(tNumber: INTEGER; tType: TrapType): BOOLEAN;
- VAR
- unImplemented : INTEGER;
-
- BEGIN
- IF tType = OSTrap THEN
- unImplemented := _UnimplementedOSTrap
- ELSE
- unImplemented := _UnimplementedToolTrap;
-
- TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(unImplemented);
- END; {TrapAvailable}
-
-
- { ******************************************************************
- * TermSendProc - Sends the data out the connection
- *
- * thePtr - the data to send
- * theSize - bytes to send
- * refcon - terminal tool refcon
- * flags - connection flags
- *
- * returns - bytes sent
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION TermSendProc(thePtr: Ptr;theSize: LONGINT;
- refcon: LONGINT;flags: INTEGER): LONGINT;
- VAR
- theErr : CMErr;
-
- BEGIN
- TermSendProc := 0; { Assume the worst }
-
- IF gConn <> NIL THEN BEGIN
-
- { DO NOT check to see if the conn is first open before sending }
- { as the tool might be directly interpreting the data }
-
- theErr := CMWrite(gConn,thePtr,theSize,
- cmData,FALSE,NIL,0,flags);
-
- IF (theErr = noErr) THEN
- TermSendProc := theSize; { If ok, we sent all }
-
- END; { Good Connection }
-
- END; { TermSendProc }
-
-
-
- { ******************************************************************
- * TermRecvProc - Gets the data from the connection and sends
- * it to the terminal tool.
- *
- * NOTE - This is NOT a callback proc, but does
- * resemble the functionality.
- *
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE TermRecvProc;
- VAR
- theErr : CMErr; { Any errors }
- status : CMStatFlags; { For the conn tool }
- sizes : CMBufferSizes;
- flags : INTEGER;
- err : TMErr;
-
- BEGIN
- IF (gConn <> NIL) AND (_GTERM <> NIL) THEN BEGIN
-
- { Get the state of the connection }
- theErr := CMStatus(gConn, sizes, status);
-
- IF (theErr = noErr) THEN BEGIN
-
- { Route the data if we have any }
- IF (BAND(status, cmStatusOpen + cmStatusDataAvail) <> 0) AND
- (sizes[cmDataIn] <> 0) THEN BEGIN
-
- { Don't overflow my buffer }
- IF sizes[cmDataIn] > kBufferSize THEN
- sizes[cmDataIn] := kBufferSize;
-
- { Tell the tool to get the data }
- theErr := CMRead(gConn, gBuffer, sizes[cmDataIn],
- cmData, FALSE,NIL,0,flags);
-
- { Send data to the terminal }
- IF (theErr = noErr) THEN
- BEGIN
- sizes[cmDataIn] := TMStream(_GTERM,gBuffer,
- sizes[cmDataIn],flags);
- CheckTermEnv( FALSE);
-
- END;
-
- END; { sizes <> 0 }
-
- END; { Good Status }
-
- IF (theErr <> noErr) THEN
- ; { Connection tool will alert the user on an error }
-
- END; { Good term & conn }
-
- END; { TermRecvProc }
-
-
-
- { ******************************************************************
- * ToolGetConnEnvirons - Gets the connection environs for
- * the FT or Term tool
- *
- * refCon - the tool refcon
- * theEnvirons - the environment
- *
- * returns - an environment error
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION ToolGetConnEnvirons(refCon: LONGINT;
- VAR theEnvirons: ConnEnvironRec): OSErr;
- BEGIN
- ToolGetConnEnvirons := envNotPresent; { pessimism }
-
- { Version is set by the tool }
- IF (gConn <> NIL) THEN
- ToolGetConnEnvirons := CMGetConnEnvirons(gConn,theEnvirons);
-
- END; { TermGetConnEnvirons }
-
-
-
- { ******************************************************************
- * FTSendProc - Sends data during a file transfer
- *
- * thePtr - data to send
- * theSize - bytes to send
- * refcon - the FTtool refcon
- * channel - which channel to use
- * flags - connection flags
- *
- * returns - bytes sent
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION FTSendProc(thePtr: Ptr;theSize: LONGINT;refcon: LONGINT;
- channel: CMChannel;flags: INTEGER) : LONGINT;
- VAR
- theErr : CMErr;
-
- BEGIN
- FTSendProc := 0; { Assume the worst }
-
- IF gConn <> NIL THEN BEGIN
- { Send the data }
- theErr := CMWrite(gConn,thePtr,theSize,channel,
- FALSE, NIL, 0, flags);
- IF (theErr = noErr) THEN
- FTSendProc := theSize; { if ok, we sent all }
-
- END; { Good Connection }
-
- END; { FTSendProc }
-
-
-
- { ******************************************************************
- * FTReceiveProc - Gets data during a file transfer
- *
- * thePtr - place for data
- * theSize - bytes to get
- * refcon - the FTtool refcon
- * channel - which channel to use
- * flags - connection flags
- *
- * returns - bytes gotten
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION FTReceiveProc(thePtr: Ptr;theSize: LONGINT;refcon: LONGINT;
- channel: CMChannel;VAR flags: INTEGER): LONGINT;
- VAR
- theErr : CMErr;
-
- BEGIN
- FTReceiveProc := 0; { Assume the worst }
-
- IF gConn <> NIL THEN BEGIN
- { Read all the data }
- theErr := CMRead(gConn,thePtr,theSize,
- channel,FALSE,NIL,0,flags);
- IF (theErr = noErr) THEN
- FTReceiveProc := theSize; { if ok, we got all }
-
- END; { Good Connection }
-
- END; { FTReceiveProc }
-
-
- { ******************************************************************
- * AutoRecCallback - Sets the file transfer flag if a auto-
- * receive string was found.
- *
- * theConn - which connection tool found it
- * data - ptr to last character in the match
- * refNum - which search was found
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE AutoRecCallback(theConn: ConnHandle; data: Ptr; refNum: LONGINT);
- BEGIN
- { We can't call FTStart() or CMRemoveSearch() here as }
- { this proc might be called from Interrupt level }
-
- IF (gFTSearchRefNum = refNum) THEN
- gStartFT := TRUE; { Set the flag to call FTStart in Idle }
- END; { AutoRecCallBack }
-
-
-
- { ******************************************************************
- * AddFTSearch - Checks to see if the file transfer has an
- * auto-receive string, and adds a search to
- * find it.
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE AddFTSearch;
- VAR
- tempStr : Str255; { the string to look for }
-
- BEGIN
- IF (gFT <> NIL) AND (gConn <> NIL) THEN BEGIN
- tempStr := gFT^^.AutoRec; { Do I need to add a search }
-
- IF (tempStr <> '') THEN BEGIN
- gFTSearchRefNum := CMAddSearch(gConn,tempStr,cmSearchSevenBit,
- @AutoRecCallback);
- IF gFTSearchRefNum = -1 THEN BEGIN
- AlertUser('Couldn''t add stream search',FALSE);
- gFTSearchRefNum := 0;
- END;
- END; { can autoreceive }
-
- END; { good FT and Conn }
-
- END; { AddFTSearch }
-
-
-
- { ******************************************************************
- * DoSend - Initiates a File Transfer send from the menu command
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE DoSend;
- VAR
- theReply : SFReply; { File Info }
- where : Point; { Top Left of File dialog }
- numTypes : INTEGER; { File Types to display }
- typeList : SFTypeList;
- anyErr : FTErr; { Error handler }
-
- BEGIN
- IF gFT <> NIL THEN BEGIN
- SetPt(where, 100, 100);
-
- { If the FT tool can only send Text files, then }
- { only display text files, else display all types }
-
- { Check to see if Text Only flag is set }
- IF BAND(gFT^^.attributes, ftTextOnly) <> 0 THEN BEGIN
- typeList[0] := 'TEXT';
- numTypes := 1;
- END
- ELSE
- numTypes := -1;
-
- SFGetFile(where, 'File to Send', NIL, numTypes,
- typeList, NIL, theReply);
-
- { Did the user hit OK or Cancel }
- IF theReply.good THEN BEGIN
- { Transfer the file TO the remote }
- anyErr := FTStart(gFT,ftTransmitting,theReply);
-
- IF (anyErr <> noErr) THEN
- ; { File Transfer tool will alert user on an error }
-
- END; { Good file }
- END; { Good FTHandle }
-
- END; { DoSend }
-
-
- { ******************************************************************
- * DoReceive - Initiates a File Transfer receive from the menu
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE DoReceive;
- VAR
- theReply : SFReply; { File Info }
- anyErr : OSErr; { Errors on Start }
-
- BEGIN
- IF gFT <> NIL THEN BEGIN
-
- { Let the FT tool use its own default file info }
- theReply.vRefNum := 0;
- theReply.fName := '';
-
- gStartFT := FALSE; { Shut the flag down }
-
- { We remove the search temporarily in case it comes }
- { across during the transfer. Will be re-added in the }
- { idle loop once the transfer is completed }
-
- IF gConn <> NIL THEN
- IF (gFT^^.autoRec <> '') AND (gFTSearchRefNum <> 0) THEN BEGIN
- CMRemoveSearch(gConn, gFTSearchRefNum);
- gFTSearchRefNum := 0; { We found it already }
- END;
-
- { Start receiving the file }
- { The rest gets transferred in the Idle loop }
-
- anyErr := FTStart(gFT,ftReceiving,theReply);
-
- IF (anyErr <> noErr) THEN
- ; { File Transfer tool will alert user on an error }
-
- END; { Good Handle }
-
- END; { DoReceive }
-
-
- { ******************************************************************
- * IsDAWindow - Checks to see if a window belongs to a desk acc.
- *
- * window - the culprit
- *
- * returns - true if it's a DA
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION IsDAWindow(window: WindowPtr): BOOLEAN;
-
- {Check if a window belongs to a desk accessory.}
-
- BEGIN
- IF window = NIL THEN
- IsDAWindow := FALSE
- ELSE {DA windows have negative windowKinds}
- IsDAWindow := WindowPeek(window)^.windowKind < 0;
- END; {IsDAWindow}
-
-
-
- { ******************************************************************
- * IsAppWindow - Checks to see if a window belongs to our app
- *
- * window - the culprit
- *
- * returns - true if it's an app window
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION IsAppWindow(window: WindowPtr): BOOLEAN;
- VAR
- theRefCon : LONGINT;
-
- BEGIN
- { Check the userkind and the refcon for tool windows}
- IF window = NIL THEN
- IsAppWindow := FALSE
- ELSE BEGIN
- theRefCon := GetWRefCon(window);
- WITH WindowPeek(window)^ DO
- IsAppWindow := ((windowKind >= userKind) | (windowKind = dialogKind)) &
- (_GTERM <> TermHandle(theRefCon)) &
- (gConn <> ConnHandle(theRefCon)) &
- (gFT <> FTHandle(theRefCon));
- END;
- END; {IsAppWindow}
-
-
-
- { ******************************************************************
- * AlertUser - Informs the user of any errors
- *
- * msg - The string to display
- * fatal - Exit if this is a fatal error
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE AlertUser(msg: Str255; fatal: BOOLEAN);
- VAR
- itemHit : INTEGER;
-
- BEGIN
- SetCursor(arrow);
-
- ParamText(msg,'','','');
- itemHit := Alert(rUserAlert, NIL);
-
- IF fatal THEN
- Terminate;
- END; { AlertUser }
-
-
-
- { ******************************************************************
- * OpenConnection - Initiates a connection
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE OpenConnection;
- VAR
- theErr : CMErr;
- sizes : CMBufferSizes; { Connection Tool data }
- status : CMStatFlags;
-
- BEGIN
- IF (gConn <> NIL) THEN BEGIN
-
- { Get connection info }
- theErr := CMStatus(gConn, sizes, status);
-
- { If it isn't already open, then open it }
- IF (theErr = noErr) THEN
- IF BAND(status, cmStatusOpen + cmStatusOpening) = 0 THEN
- theErr := CMOpen(gConn, FALSE, NIL, -1);
-
- IF (theErr <> noErr) THEN
- ; { Conn tool will alert user on an error }
- END;
- END; {OpenConnection}
-
-
-
- { ******************************************************************
- * CloseConnection - Kills a connection
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE CloseConnection;
- VAR
- theErr : CMErr;
- sizes : CMBufferSizes; { Connection Tool data }
- status : CMStatFlags;
-
- BEGIN
- { Kill the current connection }
- IF (gConn <> NIL) THEN BEGIN
- theErr := CMStatus(gConn, sizes, status);
-
- { If it's open, then close it }
- IF (theErr = noErr) THEN
- IF BAND(status, cmStatusOpen + cmStatusOpening) <> 0 THEN
- theErr := CMClose(gConn, FALSE, NIL, 0, TRUE);
-
- IF (theErr <> noErr) THEN
- ; { Conn tool will alert user on an error }
- END;
-
- END; {CloseConnection}
-
-
-
- { ******************************************************************
- * DoCloseWindow - Closes the window
- *
- * window - the culprit
- *
- * returns - always returns true
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION DoCloseWindow(window: WindowPtr): BOOLEAN;
- BEGIN
- DoCloseWindow := TRUE;
-
- IF IsDAWindow(window) THEN
- CloseDeskAcc(WindowPeek(window)^.windowKind)
- ELSE IF IsAppWindow(window) THEN BEGIN
-
- CloseConnection; { Stop what we're doin' }
-
- IF _GTERM <> NIL THEN BEGIN { Dispose of all the tools }
- HUnlock(Handle(_GTERM));
- TMDispose(_GTERM);
- END;
-
- IF gFT <> NIL THEN BEGIN
- HUnlock(Handle(gFT));
- FTDispose(gFT);
- END;
-
- IF (gConn <> NIL) THEN BEGIN
- HUnlock(Handle(gConn));
- CMDispose(gConn);
- END;
-
- IF (gBuffer <> NIL) THEN { Clean up our buffer }
- DisposPtr(gBuffer);
-
- { dispose the cache data handle }
- DisposHandle( _MYDATAHANDLE );
- DisposHandle( _MYDATAHDL );
- { dispose the update region }
- DisposeRgn( _UPDATERGN );
- { dispose the selectin region }
- DisposeRgn( _OLDRGN );
- DisposeRgn( _NEWRGN );
- DisposeRgn( _SAVECLIP );
-
- DisposeWindow(window);
- END; { App Window }
-
- END; {DoCloseWindow}
-
-
- { ******************************************************************
- * FindToolID - Tries to get the default tool proc id,
- * otherwise, gets the first one it finds.
- *
- * toolClass - What kind of tool: term, ft, conn
- *
- * returns - the tool proc id or -1 if not found
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION FindToolID(toolClass: OSType): INTEGER;
- VAR
- toolName : Str255; { tool file name }
- anyErr : OSErr;
- procID : INTEGER; { tool fref number }
-
- BEGIN
- procID := -1; { Unknown tool }
-
- IF (toolClass = ClassTM) THEN BEGIN
- { If it can't get the default, get the 1st }
- toolName := kDefaultTermTool;
- procID := TMGetProcID(toolName);
-
- IF (procID = -1) THEN BEGIN
- anyErr := CRMGetIndToolName(toolClass,1,toolName);
- IF (anyErr = noErr) THEN
- procID := TMGetProcID(toolName);
- END;
-
- END { ClassTM}
-
- ELSE IF (toolClass = ClassCM) THEN BEGIN
- { If it can't get the default, get the 1st }
- toolName := kDefaultConnTool;
- procID := CMGetProcID(toolName);
-
- IF (procID = -1) THEN BEGIN
- anyErr := CRMGetIndToolName(toolClass,1,toolName);
- IF (anyErr = noErr) THEN
- procID := CMGetProcID(toolName);
- END;
-
- END { ClassCM}
-
- ELSE IF (toolClass = ClassFT) THEN BEGIN
- { If it can't get the default, get the 1st }
- toolName := kDefaultFTTool;
- procID := FTGetProcID(toolName);
-
- IF (procID = -1) THEN BEGIN
- anyErr := CRMGetIndToolName(toolClass,1,toolName);
- IF (anyErr = noErr) THEN
- procID := FTGetProcID(toolName);
- END;
-
- END; { ClassFT}
-
- FindToolID := procID;
-
- END; {FindToolID}
-
-
- { ******************************************************************
- * DoNewWindow - Gets the window and creates the session
- *
- * window - the culprit
- *
- * returns - always returns true
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION DoNewWindow: BOOLEAN;
- VAR
- window : WindowPtr; { the window to create }
- theRect : Rect; { for the terminal bounds }
- procID : INTEGER; { tool's ref number }
- sizes : CMBufferSizes; { requested size of the buffers }
- err : TMErr;
-
- BEGIN
- { Get window }
- window := GetNewWindow(rWindow, NIL, WindowPtr(-1));
-
- SetPort(window);
-
- { TERMINAL TOOL }
- procID := FindToolID(ClassTM);
- IF (procID = -1) THEN
- AlertUser('No terminal tools found',TRUE);
-
-
- { surfer 1.1 changes starts }
- _HORISCROLLHDL := GetNewControl( HORISCROLLID, window);
- _VERTSCROLLHDL := GetNewControl( VERTSCROLLID, window);
-
- theRect := window^.PORTRECT;
- With theRect Do BEGIN
- SetRect( _PORTRECT, left, top, right, bottom );
- right := right - 15;
- bottom := bottom - 15;
- END;
-
- { No cache, breakproc, or clikloop }
- _GTERM := TMNew(theRect,theRect,TMSaveBeforeClear,procID,window,
- @TermSendProc,@MyCacheProc,NIL,@MyClickProc,@ToolGetConnEnvirons,0,0);
-
- { surfer 1.1 changes ends }
-
- IF _GTERM = NIL THEN
- AlertUser('Can''t create a terminal tool',TRUE);
-
- { start surfer 1.1 changes }
-
- _OLDRGN := NewRgn;
- _NEWRGN := NewRgn;
- _SAVECLIP := NewRgn;
-
- SetRect( _GROWRECT, GROWMINHLIMIT, GROWMINVLIMIT,
- screenBits.bounds.right, screenBits.bounds.bottom );
- SetRect( _CACHEDESTRECT, _GTERM^^.termRect.left, 0, 0, 0 );
-
- { get new environment }
- CheckTermEnv( TRUE );
- With _GTERM^^.termRect Do BEGIN
- SetRect( _TERMVISRECT, left, top, right, bottom );
- END;
-
- { preallocate the update region for scrolling}
- _UPDATERGN := NewRgn;
- { preallocate handle for TMPaint }
- _MYDATAHDL := NewHandle(MAXCACHECOL);
-
- { end surfer 1.1 changes }
-
- HLock(Handle(_GTERM));
-
- { CONNECTION TOOL }
- procID := FindToolID(ClassCM);
- IF (procID = -1) THEN
- AlertUser('No connection tools found',TRUE);
-
- sizes[cmDataIn] := kBufferSize; { Just the data channel please }
- sizes[cmDataOut] := kBufferSize;
- sizes[cmCntlIn] := 0;
- sizes[cmCntlOut] := 0;
- sizes[cmAttnIn] := 0;
- sizes[cmAttnOut] := 0;
-
- gConn := CMNew(procID, cmData, sizes, 0, 0);
- IF gConn = NIL THEN
- AlertUser('Can''t create a connection tool',TRUE);
-
- HLock(Handle(gConn));
-
- { Allocate space for the read/writes using the number }
- { returned by the connection tool }
-
- gBuffer := NewPtr(sizes[cmDataIn]);
- IF MemError <> noErr THEN
- AlertUser('Out of memory, eh',TRUE);
-
- { FILE TRANSFER TOOL }
- procID := FindToolID(ClassFT);
- IF (procID = -1) THEN
- AlertUser('No file transfer tools found',FALSE);
-
- { No read/write proc. Let the tool use its own }
- gFT := FTNew(procID,0,@FTsendProc,@FTreceiveProc,NIL,NIL,
- @ToolGetConnEnvirons,window,0,0);
- IF gFT = NIL THEN
- AlertUser('Can''t create a file transfer tool',TRUE);
-
- HLock(Handle(gFT));
-
- gWasFT := FALSE; { FT in progress }
- gStartFT := FALSE; { Auto-received string found }
- gFTSearchRefNum := 0; { Clear the search refnum }
-
- AddFTSearch; { Look for the auto-receive string }
-
- DoNewWindow := TRUE;
-
- END; {DoNewWindow}
-
-
-
- { ******************************************************************
- * Initialize - Inits the various toolbox stuff
- *
- ********************************************************************* }
-
- {$S Initialize}
- PROCEDURE Initialize;
-
- VAR
- menuBar : Handle;
- window : WindowPtr;
- ignoreError : OSErr;
- total, contig : LongInt;
- ignoreResult : BOOLEAN;
- event : EventRecord;
- count : INTEGER;
- TerraMac : SysEnvRec; {set up by Initialize}
- err : INTEGER;
- i : INTEGER;
-
- BEGIN
- { Do we have Multifinder? }
- gHasWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
- gInBackground := FALSE;
-
- { Standard Fare }
- InitGraf(@thePort);
- InitFonts;
- InitWindows;
- InitMenus;
- TEInit;
- InitDialogs(NIL);
- InitCursor;
-
- { Bring us to the front }
- FOR count := 1 TO 3 DO
- ignoreResult := GetNextEvent(everyEvent, event);
-
- { Does CommToolbox Exist }
- IF NOT TrapAvailable(_CommToolboxTrap, OSTrap) THEN
- AlertUser('ACK!! No CommToolbox',TRUE);
-
- { Check for System 6.0 or better, 64K ROM }
- ignoreError := SysEnvirons(kSysEnvironsVersion, TerraMac);
-
- WITH TerraMac DO
- IF (systemVersion < $0600) OR (machineType < 0) THEN
- AlertUser('Need System 6.0 or better',TRUE);
-
- { Check various memory configs }
- IF ORD(GetApplLimit) - ORD(ApplicZone) < kMinHeap THEN
- AlertUser('Out of Memory, eh',TRUE);
-
- PurgeSpace(total, contig);
- IF total < kMinSpace THEN
- AlertUser('Out of Memory, eh',TRUE);
-
- { Load up the Communications Toolbox }
- { Must Initialize CRM & CTBUtilities first }
- err := InitCTBUtilities;
- err := InitCRM;
-
- err := InitTM;
- IF err = TMNoTools THEN
- AlertUser('No terminal tools found',TRUE);
-
- err := InitCM; { initializes the Connection Manager }
- IF err = CMNoTools THEN
- AlertUser('No connection tools found',TRUE);
-
- err := InitFT; { initializes the File Transfer Manager }
- IF err = FTNoTools THEN
- AlertUser('No file transfer tools found',FALSE);
-
- _GTERM := NIL;
- gConn := NIL;
- gFT := NIL;
- gFTSearchRefNum := 0;
-
- { allocate a handle for copying text }
- _MYDATAHANDLE := NewHandle( CACHESIZE );
-
- { init _BLANKLINE to all blanks }
- for i:= MINCACHECOL TO MAXCACHECOL DO
- _BLANKLINE[i] := ' ';
-
- IF NOT DoNewWindow THEN
- AlertUser('Can''t create a session',TRUE);
-
- menuBar := GetNewMBar(rMenuBar); {read menus into menu bar}
- IF menuBar = NIL THEN
- AlertUser('Can''t get the menu bar',TRUE);
- SetMenuBar(menuBar); {install menus}
- DisposHandle(menuBar);
-
- AddResMenu(GetMHandle(mApple), 'DRVR'); {add DA names to Apple menu}
- DrawMenuBar;
-
- gStopped := TRUE;
- END; {Initialize}
-
-
- { ******************************************************************
- * Terminate - Cleans up and exits
- *
- ********************************************************************* }
-
- {$S Main}
- PROCEDURE Terminate;
- VAR
- aWindow : WindowPtr; { the window to shut }
- closed : BOOLEAN; { Are we done, yet }
-
- BEGIN
- { Close all the open windows }
- closed := TRUE;
-
- aWindow := FrontWindow;
-
- REPEAT
- IF (aWindow <> NIL) THEN
- IF IsAppWindow(aWindow) THEN
- closed := DoCloseWindow(aWindow);
-
- { Try the next window }
- IF (aWindow <> NIL) THEN
- aWindow := WindowPtr(WindowPeek(aWindow)^.nextWindow);
-
- UNTIL (NOT closed) | (aWindow = NIL);
-
- IF closed THEN
- ExitToShell; {exit if no cancellation}
- END; {Terminate}
-
-
-
- { ******************************************************************
- * AdjustMenus - Enables & Disables items based on current state
- *
- ********************************************************************* }
-
- {$S Main}
- PROCEDURE AdjustMenus;
- VAR
- window : WindowPtr; { whose in front }
- menu : MenuHandle; { the menu to manipulate }
- theErr : CMErr;
- sizes : CMBufferSizes; { Connection tool data }
- status : CMStatFlags;
-
- BEGIN
- window := FrontWindow;
-
- menu := GetMHandle(mFile);
- IF (menu = NIL) THEN
- AlertUser('Can''t get menu resource', TRUE);
-
- IF (gConn <> NIL) THEN BEGIN
- theErr := CMStatus(gConn,sizes,status);
- IF (theErr = noErr) THEN BEGIN
- IF NOT IsDAWindow(window) THEN BEGIN
- SetItem(menu,iOpen,'Open Connection');
- SetItem(menu,iClose,'Close Connection');
-
- { Let the menu show the proper state of the union }
- IF BAND(status, cmStatusOpen + cmStatusOpening) = 0 THEN BEGIN
- EnableItem(menu, iOpen);
- DisableItem(menu, iClose);
- END
- ELSE BEGIN
- DisableItem(menu, iOpen);
- EnableItem(menu, iClose);
- END;
-
- { Check state of the FT tool to Enable send/receive }
- DisableItem(menu,iSendFile);
- DisableItem(menu,iReceiveFile);
-
- IF (gFT <> NIL) THEN BEGIN
- IF BAND(gFT^^.attributes,ftSendDisable) = 0 THEN
- EnableItem(menu,iSendFile);
-
- IF BAND(gFT^^.attributes,ftReceiveDisable) = 0 THEN
- EnableItem(menu,iReceiveFile);
- END;
- END
- ELSE BEGIN
- { Set for desk accesories }
- SetItem(menu,iOpen,'Open');
- SetItem(menu,iClose,'Close');
- DisableItem(menu, iOpen);
- EnableItem(menu,iClose);
- DisableItem(menu,iSendFile);
- DisableItem(menu,iReceiveFile);
- END;
-
- END; { good status }
- END; { good connection }
-
-
- menu := GetMHandle(mEdit);
- IF (menu = NIL) THEN
- AlertUser('Can''t get menu resource', TRUE);
-
- IF IsDAWindow(window) THEN BEGIN { DAs might use this menu }
- EnableItem(menu, iUndo);
- EnableItem(menu, iCut);
- EnableItem(menu, iCopy);
- EnableItem(menu, iPaste);
- EnableItem(menu, iClear);
- END ELSE BEGIN { but we don't use it yet }
- DisableItem(menu, iUndo);
- DisableItem(menu, iCut);
- DisableItem(menu, iCopy);
- DisableItem(menu, iClear);
- DisableItem(menu, iPaste);
- END;
-
- menu := GetMHandle(mSettings);
- IF (menu = NIL) THEN
- AlertUser('Can''t get menu resource', TRUE);
-
- IF NOT IsDAWindow(window) THEN BEGIN { Enable if we're front }
- EnableItem(menu, iConnection);
- EnableItem(menu, iFileTransfer);
- EnableItem(menu, iTerminal);
- END ELSE BEGIN
- DisableItem(menu, iConnection);
- DisableItem(menu, iFileTransfer);
- DisableItem(menu, iTerminal);
- END;
-
- END; {AdjustMenus}
-
-
- { ******************************************************************
- * DoToolMenu - Tries to give the menu to the tool
- *
- * menuID - the menu info from DoMenuCommand
- * menuItem
- *
- * returns - TRUE if a tool handled the menu
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION DoToolMenu(menuID, menuItem: INTEGER): BOOLEAN;
- BEGIN
- DoToolMenu := FALSE;
-
- IF _GTERM <> NIL THEN
- IF TMMenu(_GTERM, menuID, menuItem) THEN BEGIN
- DoToolMenu := TRUE;
- Exit(DoToolMenu);
- END;
-
- IF gConn <> NIL THEN
- IF CMMenu(gConn, menuID, menuItem) THEN BEGIN
- DoToolMenu := TRUE;
- Exit(DoToolMenu);
- END;
-
- IF gFT <> NIL THEN
- IF FTMenu(gFT, menuID, menuItem) THEN
- DoToolMenu := TRUE;
-
- END; {DoToolMenu}
-
-
-
- { ******************************************************************
- * DoMenuCommand - Executes a menu command
- *
- * menuResult - the menu id and item number
- *
- ********************************************************************* }
-
- {$S Main}
- PROCEDURE DoMenuCommand(menuResult: LONGINT);
- VAR
- menuID : INTEGER; { resource ID of the selected menu }
- menuItem : INTEGER; { item number of the selected menu }
- itemHit : INTEGER; { for the alert }
- daName : Str255; { for opening desk accesories }
- daRefNum : INTEGER;
- handledByDA : BOOLEAN; { DA edit menu handling }
- ignore : BOOLEAN;
- where : Point; { For choose dialog }
- result : INTEGER;
-
- BEGIN
- menuID := HiWrd(menuResult); {use built-ins (for efficiency)...}
- menuItem := LoWrd(menuResult); {to get menu item number and menu number}
-
- { First see if the menu belonged to a tool }
-
- IF NOT DoToolMenu(menuID,menuItem) THEN
- CASE menuID OF
- mApple:
- CASE menuItem OF
- iAbout: {bring up alert for About}
- itemHit := Alert(rAboutAlert, NIL);
- OTHERWISE BEGIN {all non-About items in this menu are DAs}
- GetItem(GetMHandle(mApple), menuItem, daName);
- daRefNum := OpenDeskAcc(daName);
- END;
- END; { case }
-
- mFile:
- CASE menuItem OF
- iOpen:
- IF NOT IsDAWindow(FrontWindow) THEN
- OpenConnection;
-
- iClose:
- IF IsDAWindow(FrontWindow) THEN
- ignore := DoCloseWindow(FrontWindow)
- ELSE
- CloseConnection;
-
- iSendFile:
- IF NOT IsDAWindow(FrontWindow) THEN
- DoSend;
-
- iReceiveFile:
- IF NOT IsDAWindow(FrontWindow) THEN
- DoReceive;
-
- iQuit:
- Terminate;
- END; { case }
-
- mEdit: {call SystemEdit for DA editing & MultiFinder}
- handledByDA := SystemEdit(menuItem-1); {since we don't do any editing}
-
- mSettings:
- CASE menuItem OF
- iConnection:
- IF gConn <> NIL THEN BEGIN
- HUnlock(Handle(gConn));
-
- SetPt(where,10,40);
- result := CMChoose(gConn, where, NIL);
-
- CASE result OF
- chooseDisaster,
- chooseFailed:
- AlertUser('Connection choose failed',(result = chooseDisaster));
- chooseOKMajor:
- AddFTSearch;
- END;
-
- HLock(Handle(gConn));
- END; { good conn }
-
- iFileTransfer:
- IF (gFT <> NIL) THEN BEGIN
- HUnlock(Handle(gFT));
-
- SetPt(where,10,40);
- result := FTChoose(gFT, where, NIL);
-
- CASE result OF
- chooseDisaster,
- chooseFailed:
- AlertUser('File Transfer choose failed',
- (result = chooseDisaster));
- chooseOKMinor,
- chooseOKMajor: BEGIN
- { Get rid of the old search }
- IF (gFTSearchRefNum <> 0) AND (gConn <> NIL) THEN
- CMRemoveSearch(gConn,gFTSearchRefNum);
- gFTSearchRefNum := 0;
-
- AddFTSearch; { Add the new FT tool search }
- END;
- END;
-
- HLock(Handle(gFT));
- END; { good ft }
-
- iTerminal:
- IF (_GTERM <> NIL) THEN BEGIN
- HLock(Handle(_GTERM));
-
- SetPt(where,10,40);
- result := TMChoose(_GTERM, where, NIL);
-
- IF (result < 0) THEN
- AlertUser('Terminal choose failed',(result = chooseDisaster))
- ELSE IF (result = chooseOKMinor) OR (result = chooseOKMajor) THEN
- { validate termenvironment if anything has changed in TMChoose }
- CheckTermEnv( TRUE );
-
- HUnlock(Handle(_GTERM));
- END; { good term }
-
- END; { case menuitem }
-
- END; { case menuid }
-
- HiliteMenu(0); {unhighlight what MenuSelect (or MenuKey) hilited}
- END; {DoMenuCommand}
-
-
- { ******************************************************************
- * DoUpdate - Updates the window
- *
- * window - target of teh update
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE DoUpdate(window: WindowPtr);
- VAR
- savedClip : RgnHandle; { saved info for reset later }
- savedPort : GrafPtr;
-
- BEGIN
- IF IsAppWindow(window) THEN BEGIN
- GetPort(savedPort);
- SetPort(window);
-
- { Clip to the window content }
- savedClip := NewRgn;
- GetClip(savedClip);
- ClipRect(window^.PORTRECT);
-
- BeginUpdate(window);
- { update the cache area }
-
- { update the cache area }
- UpdateCache( window^.visRgn );
-
- IF _GTERM <> NIL THEN { Update the terminal tool }
- TMUpdate(_GTERM, window^.visRgn);
-
- { update the scroll bar area }
- DrawControls(window);
- { update the grow box }
- DrawGrowIcon( window );
- EndUpdate(window);
-
- SetClip(savedClip);
- DisposeRgn(savedClip);
-
- SetPort(savedPort);
- END;
- END; {DoUpdate}
-
-
- { ******************************************************************
- * DoResume - Suspends/Resumes the window
- *
- * becomingActive - Resume or Suspend
- *
- ********************************************************************* }
-
- {$S Main}
- PROCEDURE DoResume(becomingActive: BOOLEAN);
- VAR
- theWindow : WindowPtr;
- savedPort : GrafPtr;
-
- BEGIN
- { Since the front window could be a tool window, we need }
- { to find the app window by walking the list so we can }
- { send resume messages to the tools }
-
- GetPort(savedPort);
-
- theWindow := FrontWindow;
-
- WHILE (theWindow <> NIL) DO BEGIN
- IF IsAppWindow(theWindow) THEN BEGIN
- SetPort(theWindow);
-
- CacheActivate( theWindow, becomingActive );
- { Tools need to adjust their menus, text selection, etc }
- IF _GTERM <> NIL THEN
- TMResume(_GTERM, becomingActive);
-
- IF gConn <> NIL THEN
- CMResume(gConn, becomingActive);
-
- IF gFT <> NIL THEN
- FTResume(gFT, becomingActive);
- END; { app window }
-
- { Try the next window }
- theWindow := WindowPtr(WindowPeek(theWindow)^.nextWindow);
- END;
-
- SetPort(savedPort);
-
- END; {DoResume}
-
-
- { ******************************************************************
- * DoActivate - (De)Activates the window
- *
- * window - target of the update
- * becomingActive - Activate or Deactivate
- *
- ********************************************************************* }
-
- {$S Main}
- PROCEDURE DoActivate(window: WindowPtr; becomingActive: BOOLEAN);
- BEGIN
- IF IsAppWindow(window) THEN BEGIN
- SetPort(window);
-
- { adjust the selection in the cache area }
- CacheActivate( window, becomingActive );
- { Tools need to adjust their menus, text selection, etc }
- IF _GTERM <> NIL THEN
- TMActivate(_GTERM, becomingActive);
-
- IF gConn <> NIL THEN
- CMActivate(gConn, becomingActive);
-
- IF gFT <> NIL THEN
- FTActivate(gFT, becomingActive);
- END;
-
- END; {DoActivate}
-
-
- { ******************************************************************
- * AdjustCursor - Updates mouse cursor depending on location
- *
- * mouse - the location of the mouse (global coords)
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE AdjustCursor(mouse: Point);
- VAR
- window : WindowPtr;
-
- BEGIN
- window := FrontWindow; { Adjust only if front }
-
- IF (NOT gInBackground) AND (IsAppWindow(window)) THEN BEGIN
- GlobalToLocal(mouse);
-
- { If it's outside the content, set to arrow }
- { otherwise the terminal tool will handle it }
-
- IF (_GTERM <> NIL) THEN
- IF NOT PtInRect(mouse,_GTERM^^.viewRect) THEN
- InitCursor;
-
- END; { app window }
-
- END; {AdjustCursor}
-
-
- { ******************************************************************
- * DoToolEvent - Tries to pass the event to a tool if the
- * window is a tool window
- *
- * event - the event received
- *
- * returns - True if the tool handled it
- *
- ********************************************************************* }
- {$S Main}
- FUNCTION DoToolEvent(event: EventRecord; window: WindowPtr): BOOLEAN;
- BEGIN
- IF (window <> NIL) THEN BEGIN
- DoToolEvent := TRUE;
-
- IF (gFT <> NIL) AND
- (gFT = FTHandle(GetWRefCon(window))) THEN
- FTEvent(gFT, event)
- ELSE IF (gConn <> NIL) AND
- (gConn = ConnHandle(GetWRefCon(window))) THEN
- CMEvent(gConn, event)
- ELSE IF (_GTERM <> NIL) AND
- (_GTERM = TermHandle(GetWRefCon(window))) THEN
- TMEvent(_GTERM, event)
- ELSE
- DoToolEvent := FALSE;
- END
- ELSE
- DoToolEvent := FALSE;
-
- END; {DoToolEvent}
-
-
-
- { ******************************************************************
- * DoEvent - Updates mouse cursor depending on location
- *
- * event - the event to handle
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE DoEvent(event: EventRecord);
- VAR
- part, { where the mouse click was }
- err : INTEGER;
- window : WindowPtr; { the click's window }
- key : CHAR; { the letter typed }
- aPoint : Point; { for the dialog top left }
- result : LONGINT; { result from MenuKey }
- processed : BOOLEAN; { Did the App handle it }
- locmouse : Point; { local mouse location }
-
- BEGIN
- CASE event.what OF
- mouseDown: BEGIN
- part := FindWindow(event.where, window);
-
- CASE part OF
- inMenuBar: BEGIN {process the menu command}
- AdjustMenus;
- DoMenuCommand(MenuSelect(event.where));
- END;
-
- inSysWindow: {let the system handle the mouseDown}
- SystemClick(event, window);
-
- inContent:
- { The terminal tool needs to handle selections }
- IF NOT DoToolEvent(event,window) THEN BEGIN
- IF window <> FrontWindow THEN
- SelectWindow(window)
- ELSE IF (_GTERM <> NIL) THEN
- BEGIN
- { surfer 1.1 changes starts }
- HandleMouseDown( window, event );
- { surfer 1.1 changes ends }
- END;
- END;
-
- inDrag: {pass screenBits.bounds to get all gDevices}
- IF NOT DoToolEvent(event,window) THEN
- DragWindow(window, event.where, screenBits.bounds);
-
- { surfer 1.1 changes starts }
- inGrow:
- IF NOT DoToolEvent(event,window) THEN
- DoSizeWindow( window, event);
-
- { surfer 1.1 changes ends }
-
- inZoomIn, inZoomOut,
- inGoAway:
- IF DoToolEvent(event,window) THEN ;
- END; { Case Mousedown }
-
- END; { Mousedown }
-
- keyDown, autoKey: BEGIN {check for menukey equivalents}
- window := FrontWindow;
-
- { Get the key }
- key := CHR(BAnd(event.message, charCodeMask));
- processed := FALSE;
-
- { The terminal tool might be mapping the cmd key }
- { so if menukey fails, send it to the tool }
-
- IF BAND(event.modifiers, cmdKey) <> 0 THEN BEGIN
- AdjustMenus; {enable/disable/check menu items properly}
- result := MenuKey(key);
- IF result <> 0 THEN BEGIN
- processed := TRUE;
- DoMenuCommand(result)
- END;
- END;
-
- IF (_GTERM <> NIL) AND NOT processed THEN
- IF NOT DoToolEvent(event,window) THEN
- BEGIN
- DeSelection;
- TMKey(_GTERM, event);
- CheckTermEnv( FALSE );
- END;
- END;
-
- activateEvt: BEGIN
- window := WindowPtr(event.message);
-
- IF NOT DoToolEvent(event,window) THEN
- DoActivate(window, BAND(event.modifiers, activeFlag) <> 0);
- END;
-
- updateEvt: BEGIN
- window := WindowPtr(event.message);
-
- IF NOT DoToolEvent(event,window) THEN
- DoUpdate(window);
- END;
-
- diskEvt:
- IF HiWrd(event.message) <> noErr THEN BEGIN
- SetPt(aPoint, kDILeft, kDITop);
- err := DIBadMount(aPoint, event.message);
- END;
-
- kOSEvent:
- { Send to frontmost tool window AND all tools }
- { as this is an application-wide event }
-
- CASE BAnd(BRotL(event.message, 8),$FF) OF {high byte of message}
- kSuspendResumeMessage: BEGIN
- IF NOT DoToolEvent(event,FrontWindow) THEN
- ;
-
- gInBackground := BAnd(event.message, kResumeMask) = 0;
- DoResume(NOT gInBackground);
- END;
- END;
- END;
- END; {DoEvent}
-
-
- { ******************************************************************
- * DoIdle - Idles all the tools
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE DoIdle;
- VAR
- theWindow : WindowPtr; { The target to idle }
- doFT : BOOLEAN; { route data to FT Tool }
- doTM : BOOLEAN; { route data to Term Tool }
- savedPort : GrafPtr; { for later reset }
-
- BEGIN
- GetPort(savedPort); { Save for later }
- theWindow := FrontWindow; { Gimme the first one }
-
- { Give idle time for the window }
- WHILE (theWindow <> NIL) DO BEGIN
- IF IsAppWindow(theWindow) THEN BEGIN
- SetPort(theWindow); { Focus on it }
-
- IF gConn <> NIL THEN { Give time to the connection }
- CMIdle(gConn);
-
- doFT := FALSE; { Send data to FT tool }
- doTM := TRUE; { Send data to terminal tool }
-
- IF gFT <> NIL THEN BEGIN
- { Is there a file transfer in progress ?? }
- IF BAND(gFT^^.flags, ftIsFTMode) <> 0 THEN BEGIN
- doFT := TRUE;
- gWasFT := TRUE;
-
- { If the FT tool uses my connection then }
- { don't route data to the terminal tool }
-
- IF BAND(gFT^^.attributes, ftSameCircuit) <> 0 THEN
- doTM := FALSE;
- END { In progress }
-
- ELSE BEGIN
- IF gWasFT THEN BEGIN
- { FT no longer in progress }
- gWasFT := FALSE;
-
- { FT tool will alert the user }
- IF BAND(gFT^^.flags, FTSucc) = 0 THEN
- ;
-
- { The old search was removed for the transfer }
- { so we need to re-add it here }
- AddFTSearch;
- END;
-
- { AutoReceive string was received ? }
- IF gStartFT THEN
- DoReceive;
- END; { No FT in progress }
-
- IF doFT THEN { Give time to FT tool }
- FTExec(gFT);
-
- END; { Good FT Handle }
-
- IF _GTERM <> NIL THEN BEGIN
- { Send data to terminal }
- IF doTM THEN BEGIN
- TMIdle(_GTERM); { So it can blink its cursor, etc }
-
- TermRecvProc; { Send Data to the terminal }
- END; { Send data to terminal }
-
- END; { Good Terminal }
-
- END; { App Window }
-
- { Try the next window }
- theWindow := WindowPtr(WindowPeek(theWindow)^.nextWindow);
-
- END; { while each window }
-
- SetPort(savedPort); { Back to the way it was }
-
- END; { DoIdle }
-
-
- { ******************************************************************
- * EventLoop - The main event loop
- *
- ********************************************************************* }
- {$S Main}
- PROCEDURE EventLoop;
- VAR
- gotEvent : BOOLEAN;
- event : EventRecord;
-
- BEGIN
- REPEAT
- DoIdle;
-
- IF gHasWaitNextEvent THEN { put us 'asleep' forever under MultiFinder }
- gotEvent := WaitNextEvent(everyEvent, event, 0, NIL)
- ELSE BEGIN
- SystemTask; { must be called if using GetNextEvent }
- gotEvent := GetNextEvent(everyEvent, event);
- END;
-
- IF gotEvent THEN BEGIN
- AdjustCursor(event.where); {make sure we have the right cursor}
- DoEvent(event);
- END;
-
- AdjustCursor(event.where);
- UNTIL FALSE; {loop forever; we quit through an ExitToShell}
- END; {EventLoop}
-
-
- PROCEDURE _DataInit; EXTERNAL;
-
-
- {$S Main}
- BEGIN
- UnloadSeg(@_DataInit); { note that _DataInit must not be in Main! }
-
- MaxApplZone; { expand the heap so code segments load at the top }
-
- Initialize; { initialize the program }
- UnloadSeg(@Initialize); { note that Initialize must not be in Main! }
-
- EventLoop; { call the main event loop }
- END.
-