module KermitScreen; {=============================} exports {=====================================} imports KermitGlobals from KermitGlobals; const MessageWindow = 1; MainWindow = 2; TermWindow = 3; ProgrWindow = 4; StatusWindow = 5; KermitFont = 'sys:Boot>Fix13N.Kst'; type WinType = MessageWindow..StatusWindow; procedure PutMessage( ErrMsg : String ); procedure PutChr( Ch : Char ); procedure BackSpace( Ch : Char ); procedure SwitchWindow( ToWindow : WinType ); procedure CurrentWindow( Var InWindow : WinType ); procedure InitScreen; procedure CleanupScreen; procedure InitTermScreen; procedure CleanupTermScreen; procedure InitProgress; procedure ShowSRFile( Send : boolean; var Fname1, Fname2 : PString ); procedure ShowPackNum; {==============================} private {===================================} imports PopUp from PopUp; imports Screen from Screen; imports System from System; imports IOUtils from IOUtils; const MaxHeight = 1023; { Number of Pixels } CWinHeight = 90; CWinBegY = MaxHeight - CWinHeight; SWinHeight = 130; SWinBegY = 0; PWinHeight = SWinHeight; PWinBegY = SWinBegY; TWinHeight = 400; TWinBegY = SWinHeight; MWinBegY = TWinBegY + TWinHeight; MWinHeight = CWinBegY - MWinBegY; FullWidth = 768; SWinWidth = 300; SWinBegX = FullWidth - SWinWidth; PWinWidth = FullWidth - SWinWidth; PWinBegX = 0; PTopM = 20; PLeftM = 10; Frame = 5; var CurrFont : FontPtr; MessY, PackY, RetrY, File1Y, File2Y, LeadX, ValX, Fwidth, Fheight, FChars : integer; {=============================================================================} procedure SwitchWindow( ToWindow:WinType ); begin ChangeWindow( ToWindow ); end; {=============================================================================} procedure CurrentWindow( VAR InWindow:WinType ); var D1,D2,D3,D4 : integer; { Dummy variables for the window parameters } D5 : boolean; { in which we are not interested. } Win : WinRange; begin GetWindowParms( Win, D1, D2, D3, D4, D5 ); InWindow := Win; { Note the type conversion: Screen is not re-exported. } end; {=============================================================================} procedure PutMessage(ErrMsg:String); var SaveWin : WinType; begin CurrentWindow( SaveWin ); ChangeWindow( MessageWindow ); writeln(ErrMsg); ChangeWindow(SaveWin); end; { PutMessage } {=============================================================================} procedure PutChr( Ch : Char ); begin SPutChr( Ch ); end; {=============================================================================} procedure BackSpace( Ch : Char ); begin SBackSpace( Ch ); end; {=============================================================================} procedure InitProgress; var OldWin : WinType; OrgX, OrgY, Width, Height : integer; WindX : WinRange; HasTitle : boolean; begin CurrentWindow( OldWin ); SwitchWindow( ProgrWindow ); GetWindowParms( WindX, OrgX, OrgY, Width, Height, HasTitle ); CurrFont := GetFont; PutChr( FF ); FHeight := CurrFont^.Height; FWidth := CurrFont^.index[ord(' ')].Width; { Assume fixed width font } LeadX := OrgX + PLeftM; FChars := ((PWinWidth - LeadX - Frame) DIV FWidth) - 12; ValX := LeadX + 20*FWidth; MessY := OrgY + PTopM; PackY := MessY + 2*FHeight; RetrY := PackY + FHeight; File1Y := RetrY + round( 1.5*FHeight ); File2Y := File1Y + FHeight; SSetCursor( LeadX, MessY ); write( KermitMessage ); SSetCursor( LeadX, PackY ); write( 'Packet number : ' ); SSetCursor( LeadX, RetrY ); write( 'Retries : ' ); SwitchWindow( OldWin ); end; {=============================================================================} procedure ShowSRFile( Send : boolean; VAR Fname1, Fname2 : FNameType ); var OldWin : WinType; Test1,Test2 : PString; procedure OutFName( F : FNameType ); var SS : FNameType; L : Integer; begin if Length(F)>FChars then begin L := (FChars-5) DIV 2; SS := SubStr( F, 1, L ); write( SS, '.....' ); SS := SubStr( F, Length(F)-L, L ); write(SS); end else write(F); end; begin CurrentWindow( OldWin ); SwitchWindow( ProgrWindow ); CurrFont := GetFont; RasterOp( RXor, PWinWidth-LeadX-Frame, Trunc(FHeight*2.5), LeadX, File1Y-FHeight, SScreenW, SScreenP, LeadX, File1Y-FHeight, SScreenW, SScreenP ); SSetCursor( LeadX, File1Y ); if Send then write( 'Sending : ') else write( 'Receiving : '); OutFName( Fname1 ); Test1 := FName1; Test2 := FName2; if (Fname2<>'') and (Test1<>Test2) then begin SSetCursor( LeadX, File2Y ); write( 'Perq file : '); OutFName( Fname2 ); end; SwitchWindow( OldWin ); end; {=============================================================================} procedure ShowPackNum; var OldWin : WinType; begin CurrentWindow( OldWin ); SwitchWindow( ProgrWindow ); SSetCursor( ValX, PackY ); write( NN:4 ); SSetCursor( ValX, RetrY ); write( TotTry:4 ); SwitchWindow( OldWin ); end; {=============================================================================} procedure InitScreen; var f : fontPtr; begin ScreenReset; CreateWindow( MessageWindow, 0, { x-origin } CWinBegY, FullWidth, CWinHeight, 'Messages'); CreateWindow( MainWindow, 0, { x-origin } MWinBegY, FullWidth, MWinHeight, 'Kermit-Perq'); CreateWindow( TermWindow, 0, TWinBegY, FullWidth, TWinHeight, 'Remote Kermit'); CreateWindow( StatusWindow, SWinBegX, SWinBegY, SWinWidth, SWinHeight, 'Line parameters'); CreateWindow( ProgrWindow, PWinBegX, PWinBegY, PWinWidth, PWinHeight, 'Transmit progress'); ChangeWindow(TermWindow); f := ReadFont(KermitFont); if f=NIL then begin ChangeWindow(MainWindow); writeln('Can''t find font file ',KermitFont,' - aborted!'); raise ExitProgram; end; ChangeWindow(MainWindow); end { InitScreen }; {=============================================================================} procedure CleanupScreen; begin ScreenReset; end; {=============================================================================} procedure InitTermScreen; begin ChangeWindow( TermWindow ); IOCursorMode( TrackCursor ); SCurChr( '_' ); SCurOn; InitPopUp; end; {=============================================================================} procedure CleanupTermScreen; begin ChangeWindow( MainWindow ); end. {=============================================================================}