home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
bbs
/
pibterm
/
pibt3sp3
/
pibvt52.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-10-04
|
31KB
|
722 lines
(*----------------------------------------------------------------------*)
(* VT52.PAS --- Emulate Dec VT52 for PIBTERM *)
(*----------------------------------------------------------------------*)
(* *)
(* Author: Philip R. Burns *)
(* Date: October, 1984 (Version 1.0) *)
(* June, 1985 (Version 2.0) *)
(* July, 1985 (Version 2.1) *)
(* *)
(* Systems: For MS-DOS on IBM PCs and close compatibles only. *)
(* Note: I have checked these on Zenith 151s under *)
(* MSDOS 2.1 and IBM PCs under PCDOS 2.0. *)
(* *)
(* History: Original with me. *)
(* *)
(* Greg Ryan provided the original form of the code to *)
(* execute EXEC PC BBS commands. *)
(* *)
(* Suggestions for improvements or corrections are welcome. *)
(* Please leave messages on Gene Plantz's BBS (312) 882 4145 *)
(* or Ron Fox's BBS (312) 940 6496. *)
(* *)
(* IF you use this code in your own programs, please be nice *)
(* and give proper credit. *)
(* *)
(*----------------------------------------------------------------------*)
(* *)
(* Routines: *)
(* *)
(* Scroll *)
(* Get_Async_Integer *)
(* Do_CompuServe_B_Transfer *)
(* Emulate_VT52 *)
(* Convert_VT52_Kbd *)
(* Convert_VT52_Comm *)
(* Exec_PC_Commands *)
(* *)
(*----------------------------------------------------------------------*)
(* *)
(* Remarks: *)
(* *)
(* The VT52 keypad is mapped onto the function keys as follows: *)
(* *)
(* The left half of the keypad --> function keys F1 through F10. *)
(* The right half of the keypad --> function keys Shift F1 thru *)
(* Shift F10. *)
(* *)
(* For convenience, the arrow keys can also be used to generate *)
(* the same codes as the arrows from the function keys. *)
(* *)
(* For those VT52 keypad keys which are double-sized, two adjacent *)
(* function keys will send the same codes. *)
(* *)
(* Note that the function keys are always in keypad application *)
(* mode. Numeric codes can be sent using the regular PC keypad. *)
(* *)
(*----------------------------------------------------------------------*)
(*----------------------------------------------------------------------*)
(* Emulate_VT52 -- Controls VT52 emulation *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Emulate_VT52;
(*----------------------------------------------------------------------*)
(* *)
(* Routine: Emulate_VT52 *)
(* *)
(* Purpose: Controls VT52 terminal emulation *)
(* *)
(* Calling Sequence: *)
(* *)
(* Emulate_VT52; No arguments *)
(* *)
(* Calls: *)
(* *)
(* Convert_VT52_kbd Maps PC input to VT52 codes *)
(* Convert_VT52_Comm Maps received VT52 codes to PC *)
(* *)
(* Called by: PIBTERM *)
(* *)
(* Remarks: *)
(* *)
(* (1) The graphics characters produced in graphics mode are *)
(* VT100 graphics characters. This is what many VT100s *)
(* and compatibles produce in VT52 mode. *)
(* *)
(* (2) Tab positions on the VT52 are located in fixed positions. *)
(* Those are the positions used here. Some VT52-like *)
(* terminals allow user-settable tabs. Those are not *)
(* implemented here. *)
(* *)
(*----------------------------------------------------------------------*)
CONST
ON = TRUE (* Convenient synonym for switches *);
OFF = FALSE (* Likewise *);
VAR
Comm_Ch : CHAR (* Character read from comm port *);
Kbd_Ch : CHAR (* Character read from keyboard *);
VT52_Graphics_Mode : BOOLEAN (* TRUE if VT52 graphics mode on *);
VT52_KeyPad : BOOLEAN (* TRUE if alternate keypad in use *);
Done : BOOLEAN (* TRUE to stop VT52 emulation *);
B : BOOLEAN (* General purpose flag *);
Graph_Ch : BYTE (* Graphics character *);
Itab : BYTE (* Tab stop *);
Tabcol : BYTE (* Tab column *);
Curcol : BYTE (* Current column in display *);
Auto_Print_Mode : BOOLEAN (* IF auto print mode in effect *);
Printer_Ctrl_Mode : BOOLEAN (* IF printer controller mode on *);
Print_Line : STRING[80] (* Line to print if print mode on *);
CONST
Graphics_Chars: ARRAY[ 95 .. 126 ] Of BYTE
= ( 32, 4, 177, 9, 12, 13, 10, 248, 241,
10, 10, 217, 191, 218, 192, 197, 196, 196,
196, 196, 95, 195, 180, 193, 194, 179, 243,
242, 227, 168, 156, 250 );
Number_VT52_Tabs = 16;
VT52_Tabs: ARRAY[ 1 .. Number_VT52_Tabs ] Of BYTE
= ( 9, 17, 25, 33, 41, 49, 57, 65, 73, 74, 75, 76, 77,
78, 79, 80 );
(*----------------------------------------------------------------------*)
(* Scroll --- Scroll section of screen *)
(*----------------------------------------------------------------------*)
PROCEDURE Scroll ( Y1, Y2, X1, X2, Nlines : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Scroll *)
(* *)
(* Purpose: Scrolls portion of screen. *)
(* *)
(* Calling sequence: *)
(* *)
(* Scroll( Y1, Y2, X1, X2, Nlines : INTEGER ); *)
(* *)
(* (X1,Y1); (X2,Y2) --- corners of region to scroll *)
(* Nlines --- number of lines to scroll *)
(* *)
(* Calls: INTR *)
(* *)
(* Remarks: *)
(* *)
(* The indicated portion of the screen is scrolled up or down. *)
(* If Nlines > 0, then the screen is scrolled up. If Nlines < 0, *)
(* the screen is scrolled down. Setting Nlines to zero blanks *)
(* the entire region. *)
(* *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Reg: Regpack;
BEGIN (* Scroll *)
Reg.Cl := Y1;
Reg.Ch := X1;
Reg.Dl := Y2;
Reg.Dh := X2;
Reg.Bx := 0;
IF Nlines >= 0 THEN
Reg.Ax := $0600 OR Nlines
ELSE
Reg.Ax := $0700 OR ABS( Nlines );
INTR( $10 , Reg );
END (* Scroll *);
(*----------------------------------------------------------------------*)
(* Get_Async_Integer --- get integer in biased VT52 form *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Async_Integer( VAR Integr: INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Async_Integer *)
(* *)
(* Purpose: Gets integer in biased VT52 form from COM port *)
(* *)
(* Calling sequence: *)
(* *)
(* Get_Async_Integer( Var Integr: INTEGER ); *)
(* *)
(* Integr: Returned integer value *)
(* *)
(* Calls: None *)
(* *)
(* Called by: Convert_VT52_Kbd *)
(* Convert_VT52_Comm *)
(* *)
(* Remarks: *)
(* *)
(* The screen positions on the VT52 are expressed in excess 31 *)
(* notation. That is, the value 31 is added to each row and *)
(* column value. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
C : INTEGER;
BEGIN (* Get_Async_Integer *)
Async_Receive_With_TimeOut( 1 , C );
IF C = TimeOut THEN
Integr := 0
ELSE
Integr := C - 31;
END (* Get_Async_Integer *);
(*----------------------------------------------------------------------*)
(* Exec_PC_Commands --- Process EXEC PC BBS commands *)
(*----------------------------------------------------------------------*)
PROCEDURE Exec_PC_Commands;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Exec_PC_Commands *)
(* *)
(* Purpose: Process Exec PC BBS special escape code commands *)
(* *)
(* Calling Sequence: *)
(* *)
(* Exec_PC_Commands; *)
(* *)
(* Calls: *)
(* *)
(* Async_Send *)
(* Async_Receive *)
(* PibDownLoad *)
(* *)
(*----------------------------------------------------------------------*)
VAR
X: INTEGER;
Y: INTEGER;
Ch: CHAR;
C: INTEGER;
BEGIN (* Exec_PC_Commands *)
(* Get next character after Exec PC flag *)
Async_Receive_With_TimeOut( 1 , C );
IF C <> TimeOut THEN
Ch := CHR( C )
ELSE
Ch := CHR( 0 );
(* Handle it *)
CASE Ch OF
'D' : BEGIN (* Auto-Download *)
FileName := '';
WRITE('Autodownloading ');
REPEAT
Async_Receive_With_TimeOut( 1 , C );
IF C <> TimeOut THEN
Ch := CHR( C )
ELSE
Ch := CHR( 0 );
IF NOT ( ORD( Ch ) IN [ACK,CAN] ) THEN
BEGIN
Async_Send( Ch ); (* echo 1 char at a time *)
FileName := FileName + Ch;
WRITE( Ch );
END;
UNTIL ORD(Ch) IN [ACK,CAN];
IF ORD( Ch ) = ACK THEN
BEGIN (* Filename echoed correctly *)
FOR X := 0 TO 18 DO
WRITELN;
IF POS( '=X' , FileName ) <> 0 THEN
DELETE( FileName , POS( '=X' , FileName ) , 2 );
FileName := TRIM( FileName );
PibDownload( Xmodem_Chk );
END;
END (* Auto_DownLoad *);
'2' : BEGIN (* Draw a Box at corners (Oldx,Oldy) and (NewX,NewY) *)
GoToXY( OldX , OldY );
WRITE( CHR(218) ); (* upper left corner *)
FOR X := ( OldX + 1 ) TO ( NewX - 1 ) DO
WRITE( CHR(196) ); (* horizontal line segment *)
WRITE( CHR(191) ); (* upper right corner *)
FOR Y := ( OldY + 1 ) TO ( NewY - 1 ) DO
BEGIN
GoToXY( OldX , Y );
WRITE( CHR(179) ); (* vertical line segment *)
GoToXY( NewX , y );
WRITE( CHR(179) );
END;
GoToXY( OldX , NewY );
WRITE( CHR(192) ); (* lower left corner *)
FOR X := ( OldX + 1 ) TO ( NewX - 1 ) DO
WRITE(CHR(196));
WRITE(CHR(217)); (* lower right corner *)
END;
ELSE;
END (* CASE *);
END (* Exec_PC_Commands *);
(*----------------------------------------------------------------------*)
(* Convert_VT52_Comm --- Process incoming VT52 escape sequences *)
(*----------------------------------------------------------------------*)
PROCEDURE Convert_VT52_Comm;
(*----------------------------------------------------------------------*)
(* *)
(* Routine: Convert_VT52_Comm *)
(* *)
(* Purpose: Executes incoming VT52 escape sequences *)
(* *)
(* *)
(* Calling Sequence: *)
(* *)
(* Convert_VT52_Comm; -- no parameters -- *)
(* *)
(* Calls: Exec_PC_Commands *)
(* Scroll *)
(* *)
(* Called by: Emulate_VT52 *)
(* *)
(* Remarks: *)
(* *)
(* This routine assumes that a CHR(27) (Escape) was just read. *)
(* The following character is assumed to be a VT52 code. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Ch: CHAR;
X: INTEGER;
Y: INTEGER;
Y2: INTEGER;
B: BOOLEAN;
C: INTEGER;
BEGIN (* Convert_VT52_Comm *)
Async_Receive_With_TimeOut( 1 , C );
IF C <> TimeOut THEN
Ch := CHR( C )
ELSE
Ch := CHR( 0 );
Ch := TrTab[ Ch ];
CASE Ch OF
'A': BEGIN (* Move cursor up *)
GoToXY( Wherex, Max( WhereY - 1 , 1 ) );
END;
'B': BEGIN (* Move cursor down *)
GoToXY( Wherex, Min( WhereY + 1 , 25 ) );
END;
'C': BEGIN (* Move cursor left *)
GoToXY( Max( Wherex - 1 , 1 ), WhereY );
END;
'D': BEGIN (* Move cursor right *)
GoToXY( Min( WhereX + 1 , 80 ), WhereY );
END;
'F': VT52_Graphics_Mode := TRUE;
'G': VT52_Graphics_Mode := FALSE;
'H': GoToXY( 1 , 1 );
'I': BEGIN
X := WhereX;
Y := WhereY - 1;
IF y > 0 THEN
GoToXY( X , Y )
ELSE
Scroll( 1, 25, 1, 80, -1 );
END;
'J': BEGIN (* Clear to END of Screen *)
X := WhereX;
Y := WhereY;
ClrEol;
FOR Y2 := ( Y + 1 ) To 25 DO
BEGIN
GoToXY( 1 , Y2 );
ClrEol;
END;
GoToXY( X , Y );
END;
'K': ClrEol (* Clear to END of Line *);
'L': ClrScr;
'O': IF Mahoney_On THEN Exec_PC_Commands;
'W': Printer_Ctrl_Mode := ON;
'X': Printer_Ctrl_Mode := OFF;
'Y': BEGIN (* Move to screen position *)
OldX := NewX;
OldY := NewY;
Get_Async_Integer( NewY );
Get_Async_Integer( NewX );
NewY := MAX( 1 , MIN( NewY , 25 ) );
NewX := MAX( 1 , MIN( NewX , 80 ) );
GoToXY( NewX, NewY );
END;
'Z': Async_Send_String( Chr(27) + '/Z' ) (* Identify *);
'=': VT52_Keypad := ON (* Enter keypad mode *);
'>': VT52_Keypad := OFF (* Exit keypad mode *);
']': Print_Screen;
'-': Auto_Print_Mode := OFF;
'^': Auto_Print_Mode := ON;
(* Indicate EXEC PC AutoDownload possible *)
^Q : IF Mahoney_On THEN Async_Send_String( 'EXECPC2' );
ELSE
;
END (* Case CH *);
END (* Convert_VT52_Comm *);
(*----------------------------------------------------------------------*)
(* Convert_VT52_Kbd -- Controls VT52 keyboard emulation *)
(*----------------------------------------------------------------------*)
PROCEDURE Convert_VT52_Kbd( VAR Done : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Routine: Convert_VT52_Kbd *)
(* *)
(* Purpose: Convert PC keyboard codes to VT52 escape sequences *)
(* *)
(* Calling Sequence: *)
(* *)
(* Convert_VT52_Kbd( Var Done: BOOLEAN ); *)
(* *)
(* Done --- set TRUE if ALtX encountered *)
(* *)
(* Calls: None *)
(* *)
(* Called by: Emulate_VT52 *)
(* *)
(* Remarks: *)
(* *)
(* A more efficient method of writing this routine would be to *)
(* use a simple replace via table lookup of the PC code by the *)
(* VT52 code. *)
(* *)
(*----------------------------------------------------------------------*)
CONST
Esc_Ch = ^[;
Esc_Ch_Q = ^['?';
VAR
X: INTEGER;
Y: INTEGER;
Ch: Char;
BEGIN (* Convert_VT52_Kbd *)
READ( Kbd , Ch );
CASE ORD( Ch ) OF
(* Arrows *)
72: Async_Send_String( Esc_Ch + 'A' ); (* Up Arrow *)
80: Async_Send_String( Esc_Ch + 'B' ); (* Down Arrow *)
77: Async_Send_String( Esc_Ch + 'C' ); (* Right Arrow *)
75: Async_Send_String( Esc_Ch + 'D' ); (* Left Arrow *)
(* VT52_Keypad *)
59: Async_Send_String( Esc_Ch + 'P' ); (* Blue *)
60: Async_Send_String( Esc_Ch + 'Q' ); (* Red *)
84: Async_Send_String( Esc_Ch + 'R' ); (* Gray *)
85: Async_Send_String( Esc_Ch + 'A' ); (* Up Arrow *)
61: Async_Send_String( Esc_Ch_Q + 'w' ); (* 7 *)
62: Async_Send_String( Esc_Ch_Q + 'x' ); (* 8 *)
86: Async_Send_String( Esc_Ch_Q + 'y' ); (* 9 *)
87: Async_Send_String( Esc_Ch_Q + 'B' ); (* Down Arrow *)
63: Async_Send_String( Esc_Ch_Q + 't' ); (* 4 *)
64: Async_Send_String( Esc_Ch_Q + 'u' ); (* 5 *)
88: Async_Send_String( Esc_Ch_Q + 'v' ); (* 6 *)
89: Async_Send_String( Esc_Ch_Q + 'C' ); (* Right Arrow *)
65: Async_Send_String( Esc_Ch_Q + 'q' ); (* 1 *)
66: Async_Send_String( Esc_Ch_Q + 'r' ); (* 2 *)
90: Async_Send_String( Esc_Ch_Q + 's' ); (* 3 *)
91: Async_Send_String( Esc_Ch_Q + 'D' ); (* Left Arrow *)
67: Async_Send_String( Esc_Ch_Q + 'p' ); (* 0 *)
68: Async_Send_String( Esc_Ch_Q + 'p' ); (* 0 *)
92: Async_Send_String( Esc_Ch_Q + 'n' ); (* Period *)
93: Async_Send_String( Esc_Ch_Q + 'M' ); (* Enter *)
(* Cursor Movement *)
79: Async_Send_String( Esc_Ch + 'K' ); (* Erase to EOL *)
117: Async_Send_String( Esc_Ch + 'J' ); (* Erase to EOS *)
71: Async_Send_String( Esc_Ch + 'H' ); (* Home cursor *)
ELSE
BEGIN
Process_Command( Ch, TRUE, PibTerm_Command );
IF PibTerm_Command <> Null_Command THEN
Execute_Command( PibTerm_Command, Done, FALSE );
END;
END (* Case CH *);
END (* Convert_VT52_Kbd *);
(*----------------------------------------------------------------------*)
BEGIN (* Emulate_VT52 *)
(* Indicate VT52 being simulated *)
Save_Screen( Saved_Screen );
Draw_Menu_Frame( 10, 10, 55, 15, Menu_Frame_Color,
Menu_Text_Color, '' );
WRITELN('Beginning VT52 Terminal Emulation');
DELAY( One_Second_Delay );
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
(* Initialize terminal state *)
Done := FALSE;
VT52_Keypad := OFF;
VT52_Graphics_Mode := OFF;
Auto_Print_Mode := OFF;
Printer_Ctrl_Mode := OFF;
Auto_Wrap_Mode := ON;
NewX := WhereX;
NewY := WhereY;
(* Loop over input until done *)
While ( NOT Done ) DO
BEGIN
IF KeyPressed THEN
BEGIN (* KeyPressed *)
READ( Kbd , Comm_Ch );
CASE ORD( Comm_Ch ) OF
ESC: IF KeyPressed THEN
Convert_VT52_Kbd( Done )
ELSE
BEGIN
IF Local_Echo THEN WRITE( Comm_Ch );
Async_Send( Comm_Ch );
END;
BS: BEGIN
Comm_Ch := BS_Char;
IF Local_Echo THEN Write( Comm_Ch );
Async_Send( Comm_Ch );
END;
DEL: BEGIN
Comm_Ch := Ctrl_BS_Char;
IF Local_Echo THEN Write( Comm_Ch );
Async_Send( Comm_Ch );
END;
ELSE
BEGIN
IF Local_Echo THEN Write( Comm_Ch );
Async_Send( Comm_Ch );
END;
END (* CASE ORD( Comm_Ch ) *);
END (* KeyPressed *);
IF ( Script_File_Mode AND ( NOT ( Done OR Really_Wait_String ) ) ) THEN
BEGIN
Get_Script_Command( PibTerm_Command );
Execute_Command ( PibTerm_Command , Done , TRUE );
END;
IF Async_Receive( Comm_Ch ) THEN
BEGIN (* Comm_Ch found *)
Async_Buffer_Full;
Comm_Ch := TrTab[ Comm_Ch ];
CASE ORD( Comm_Ch ) OF
ESC: Convert_VT52_Comm;
LF,
FF,
VT: BEGIN (* go down one line *)
Display_Character( CHR( LF ) );
IF Auto_Print_Mode THEN
BEGIN
Get_Screen_Text_Line( Print_Line, WhereY - 1,
1 );
WRITELN( Lst , Print_Line );
END;
END (* go down one line *);
HT: BEGIN (* Convert tabs to sequence of blanks *)
Curcol := WhereX;
Itab := 1;
WHILE( Curcol > VT52_Tabs[Itab] ) DO
Itab := Itab + 1;
Tabcol := VT52_Tabs[Itab];
FOR Itab := Curcol To ( Tabcol - 1 ) DO
WRITE(' ');
END (* Tabs *);
(* CompuServe B protocol request *)
ENQ: IF CompuServe_B_On THEN
B := Do_CompuServe_B_Transfer
ELSE
Display_Character( Comm_Ch );
ELSE
IF NOT VT52_Graphics_Mode THEN
Display_Character( Comm_Ch )
ELSE
BEGIN (* Graphics Mode *)
IF ORD( Comm_Ch ) IN [ 95 .. 126 ] THEN
BEGIN
Graph_Ch := Graphics_Chars[ ORD( Comm_Ch ) ];
Display_Character( CHR( Graph_Ch ) );
END
ELSE
Display_Character( Comm_Ch );
END (* Graphics Mode *);
END (* CASE ORD( Comm_Ch ) *);
END (* Comm_Ch found *);
END (* NOT Done *);
END (* Emulate_VT52 *);ə