home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
bbs
/
pibterm
/
pibt3sp1
/
displayc.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-09-09
|
10KB
|
278 lines
(*----------------------------------------------------------------------*)
(* Display_Character --- show character received from port *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Character;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Display_Character *)
(* *)
(* Purpose: Displays character received from comm. port on *)
(* screen/printer/capture file. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Display_Character( Ch : CHAR ); *)
(* *)
(* Ch --- Character received from Comm. port. *)
(* *)
(* Calls: Async_Receive *)
(* Send_Function_Key *)
(* Min *)
(* Update_Review_Pointers *)
(* TimeOfDay *)
(* TimeDiff *)
(* *)
(* Remarks: *)
(* *)
(* This routine strips out certain characters which *)
(* should not be displayed, implements the XON/XOFF protocol *)
(* in a simple-minded manner, performs output wrap, and saves *)
(* output line in the review the review buffer. *)
(* *)
(*----------------------------------------------------------------------*)
(* STRUCTURED *) CONST
CR_Ch : CHAR = ^M;
LF_Ch : CHAR = ^J;
BL_Ch : CHAR = ' ';
VAR
I : INTEGER;
L : INTEGER;
Xpos : INTEGER;
Ypos : INTEGER;
(*----------------------------------------------------------------------*)
(* Update_Review_Pointers --- Update review buffer pointers *)
(*----------------------------------------------------------------------*)
PROCEDURE Update_Review_Pointers;
BEGIN (* Update_Review_Pointers *)
(* Point to next slot in review buffer *)
Review_Head := Review_Head + 1;
IF Review_Head > Max_Review_Length THEN
Review_Head := 1;
(* If we wrapped into last line, *)
(* update last line pointer *)
IF Review_Head = Review_Tail THEN
BEGIN
Review_Tail := Review_Tail + 1;
IF Review_Tail > Max_Review_Length THEN
Review_Tail := 1;
END;
IF Review_Tail = 0 THEN
Review_Tail := 1;
Review_Buffer^[Review_Head] := COPY( Review_Line, 1,
MIN( LENGTH( Review_Line ) , 80 ) );
Review_Line := '';
END (* Update_Review_Pointers *);
(*----------------------------------------------------------------------*)
BEGIN (* Display_Character *)
(* Get current cursor position *)
Xpos := WhereX;
Ypos := WhereY;
(* Select display depending on *)
(* character. *)
CASE ORD( Ch ) OF
NUL : ; (* Strip Nulls *)
DEL : ; (* Strip Deletes *)
XON : ; (* Strip unattached XONs *)
XOFF : BEGIN (* Handle XOFF *)
(* Wait for XON *)
REPEAT
DELAY( Tenth_Of_A_Second_Delay );
WHILE( NOT ( Async_Receive( Ch ) OR KeyPressed ) ) DO;
UNTIL( ( Ch = CHR( XON ) ) OR KeyPressed );
END (* Handle XOFF *);
BELL : IF Not Silent_Mode THEN
WRITE( Ch );
HT : BEGIN
L := 9 - WhereX MOD 8;
FOR I := 1 TO L DO
BEGIN
WRITE( BL_Ch );
IF Review_On THEN
Review_Line := Review_Line + ' ';
END;
IF Capture_On THEN
FOR I := 1 TO L DO
WRITE( Capture_File , BL_Ch );
IF Printer_On THEN
FOR I := 1 TO L DO
WRITE( Lst , BL_Ch );
END;
FF : BEGIN
ClrScr;
IF Capture_On THEN
WRITE( Capture_File, Ch );
IF Printer_On THEN
WRITE( Lst , Ch );
END;
CR : IF Add_LF THEN
BEGIN
WRITE( CR_Ch, LF_Ch );
Last_Column_Hit := FALSE;
IF Capture_On THEN
WRITELN( Capture_File );
IF Printer_On THEN
WRITE( Lst , CR_Ch , LF_Ch );
IF Review_On THEN
Update_Review_Pointers;
END
ELSE
BEGIN
WRITE( CR_Ch );
Last_Column_Hit := FALSE;
IF Printer_On THEN
WRITE( Lst , CR_Ch );
END;
LF : IF NOT Add_LF THEN
BEGIN
WRITE( LF_Ch );
IF Capture_On THEN
WRITELN( Capture_File );
IF Printer_On THEN
WRITE( Lst , LF_Ch );
IF Review_On THEN
Update_Review_Pointers;
END;
ELSE
BEGIN
(* Remember if last column hit *)
(* so we can wrap properly. *)
IF ( Xpos = Max_Screen_Col ) THEN
IF Last_Column_Hit THEN
BEGIN
IF Auto_Wrap_Mode THEN
BEGIN
WRITELN;
WRITE( Ch );
Last_Column_Hit := FALSE;
END
ELSE
BEGIN
WRITE( Ch );
GoToXY( Xpos, Ypos );
END
END
ELSE
BEGIN
WRITE( Ch );
GoToXY( Xpos , Ypos );
Last_Column_Hit := TRUE;
END
ELSE
BEGIN
WRITE( Ch );
Last_Column_Hit := FALSE;
END;
IF Review_On THEN
IF LENGTH( Review_Line ) < 80 THEN
Review_Line := Review_Line + Ch;
IF Capture_On THEN
WRITE( Capture_File, Ch );
IF Printer_On THEN
WRITE( Lst , Ch );
END;
END (* CASE *);
(* Check for WAIT string *)
IF WaitString_Mode THEN
BEGIN
IF ( NOT ( ORD( Ch ) IN [NUL,DEL,XON,XOFF] ) ) THEN
BEGIN
(* Add in new character and *)
(* check if wait string present *)
L := LENGTH( Script_Wait_Save );
IF L < LENGTH( Script_Wait_Text ) THEN
Script_Wait_Save := Script_Wait_Save + Ch
ELSE
Script_Wait_Save := COPY( Script_Wait_Save, 2, L - 1 ) + Ch;
IF ( Script_Wait_Text = Script_Wait_Save ) THEN
BEGIN
Script_Wait_Save := '';
Script_Wait_Found := TRUE;
WaitString_Mode := FALSE;
Really_Wait_String := FALSE;
Send_Function_Key( Script_Wait_Reply_Text );
END;
END;
(* Check if wait time exhausted *)
IF WaitString_Mode THEN
IF ( TimeDiff( Script_Wait_Start , TimeOfDay ) > Script_Wait_Time )
THEN
BEGIN
Script_Wait_Save := '';
Script_Wait_Found := FALSE;
WaitString_Mode := FALSE;
Really_Wait_String := FALSE;
IF ( Script_Wait_Failure > 0 ) THEN
Script_Buffer_Pos := Script_Wait_Failure - 1;
END;
END;
(* Check for WHEN string *)
IF When_Mode THEN
BEGIN
IF ( NOT ( ORD( Ch ) IN [NUL,DEL,XON,XOFF] ) ) THEN
BEGIN
L := LENGTH( Script_When_Save );
IF L < LENGTH( Script_When_Text ) THEN
Script_When_Save := Script_When_Save + Ch
ELSE
Script_When_Save := COPY( Script_When_Save, 2, L - 1 ) + Ch;
IF ( Script_When_Text = Script_When_Save ) THEN
BEGIN
Script_When_Save := '';
Send_Function_Key( Script_When_Reply_Text );
END;
END;
END;
END (* Display_Character *);
ə