home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
bbs
/
pibterm
/
pibt3sp1
/
editalin.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-07-18
|
16KB
|
426 lines
(*--------------------------------------------------------------------------*)
(* Edit_A_Line --- Edit line on screen and resend to host *)
(*--------------------------------------------------------------------------*)
OVERLAY PROCEDURE Edit_A_Line;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: Edit_A_Line *)
(* *)
(* Purpose: Edit line on screen and resend to host *)
(* *)
(* Calling Sequence: *)
(* *)
(* Edit_A_Line; *)
(* *)
(* Calls: EditString *)
(* Async_Send *)
(* Get_Screen_Text_Line *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
I : INTEGER;
S : AnyStr;
Ch : CHAR;
X : INTEGER;
Y : INTEGER;
Saved_Line : AnyStr;
Status_Line : INTEGER;
Old_Status : INTEGER;
Saved_X : BYTE;
Saved_Y : BYTE;
Saved_X_2 : BYTE;
Saved_Y_2 : BYTE;
(*--------------------------------------------------------------------------*)
(* Edit_Help --- display help about editing *)
(*--------------------------------------------------------------------------*)
PROCEDURE Edit_Help;
(*--------------------------------------------------------------------------*)
(* Dummy routine for the present *)
(*--------------------------------------------------------------------------*)
BEGIN (* Edit_Help *)
;
END (* Edit_Help *);
(*--------------------------------------------------------------------------*)
(* Edit_String -- Edit a string using Wordstar commands *)
(*--------------------------------------------------------------------------*)
FUNCTION Edit_String( VAR In_Str : AnyStr;
Buffer_Len : INTEGER;
Start_X : INTEGER;
X : INTEGER;
Y : INTEGER;
Force_Case : BOOLEAN;
Status_Line : INTEGER ) : CHAR;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: Edit_String *)
(* *)
(* Purpose: Provides for editing a string using Wordstar commands. *)
(* *)
(* Callling Sequence: *)
(* *)
(* Edited_String = Edit_String( VAR In_Str : AnyStr; *)
(* Buffer_Len : INTEGER; *)
(* Start_X : INTEGER; *)
(* X : INTEGER; *)
(* Y : INTEGER; *)
(* Force_Case : BOOLEAN; *)
(* Status_Line: INTEGER ) : CHAR; *)
(* *)
(* In_Str --- String to be edited *)
(* Buffer_Len --- Maximum length allowed for In_Str *)
(* Start_X --- Column to display string *)
(* X --- Initial edit column *)
(* Y --- Row to display string *)
(* Force_Case --- TRUE to force input to upper case *)
(* Status_Line --- Display edit status on this line if > 0; *)
(* else no status line display. *)
(* *)
(* Calls: DUPL *)
(* GoToXY *)
(* UpCase *)
(* KeyPressed *)
(* COPY *)
(* INSERT *)
(* DELETE *)
(* Edit_Help *)
(* *)
(* Remarks: *)
(* *)
(* In addition to strict WordStar commands, the keys on the keypad *)
(* can also be used. *)
(* *)
(* Insert mode is on by default. *)
(* *)
(*--------------------------------------------------------------------------*)
Var
Insert_Mode : BOOLEAN (* TRUE = insert mode, FALSE = overwrite *);
Done : BOOLEAN (* TRUE if editing finished *);
Current_Char : CHAR (* Current input editing character *);
Escape : BOOLEAN (* TRUE if escape sequence read *);
Current : CHAR (* Current input character *);
In_string : AnyStr (* Working copy of string to be edited *);
(*--------------------------------------------------------------------------*)
PROCEDURE Update_Status_Line;
VAR
SaveX: INTEGER;
SaveY: INTEGER;
BEGIN (* Update_Status_Line *)
TextColor ( Global_BackGround_Color );
TextBackGround( Global_ForeGround_Color );
SaveX := WhereX;
SaveY := WhereY;
GoToXY( 1 , Status_Line );
WRITE(' Line ',Y:3,' Column ',X:3);
IF Insert_Mode THEN
WRITE(' Insert ')
ELSE
WRITE(' Overwrite');
TextColor ( Global_ForeGround_Color );
TextBackGround( Global_BackGround_Color );
ClrEol;
GoToXY( SaveX, SaveY );
END (* Update_Status_Line *);
(*--------------------------------------------------------------------------*)
BEGIN (* Edit_String *)
(* Initialize *)
Done := FALSE;
Insert_Mode := TRUE;
(* Display the string to be edited *)
In_String := In_str;
GoToXY( Start_X , Y );
WRITE( In_String );
GoToXY( X , Y );
(* Display status line if requested *)
IF Status_Line > 0 THEN
Update_Status_Line;
REPEAT (* Begin main edit/input loop *)
IF ( X - Start_X ) = Buffer_Len THEN
Current_Char := ^M (* Terminate input if buffer is full *)
ELSE
READ( Kbd , Current_Char ); (* Get a character *)
IF Force_Case THEN (* Force upper case if requested *)
Current_Char := UPCASE( Current_Char );
REPEAT
Escape := FALSE;
CASE Current_Char of (* Act on the current input *)
^[ : IF KeyPressed THEN
BEGIN
READ( Kbd , Current_Char );
Escape := TRUE;
(* Translate escape sequences to *)
(* WordStar commands *)
CASE Current_Char OF
'H' : BEGIN
Current_Char := ^W;
Done := TRUE;
Escape := FALSE;
END;
'P' : BEGIN
Current_Char := ^X;
Done := TRUE;
Escape := FALSE;
END;
'K' : Current_Char := ^S;
'M' : Current_Char := ^D;
'S' : Current_Char := ^G;
'R' : Current_Char := ^V;
'O' : Current_Char := ^F;
'G' : Current_Char := ^A;
'<' : Current_Char := ^R;
's' : Current_Char := ^A;
't' : Current_Char := ^F;
';' : BEGIN
Edit_Help;
Current_Char := ^@;
END;
'D' : BEGIN
Done := TRUE;
Escape := FALSE;
End;
'I' : BEGIN
Done := TRUE;
Escape := FALSE;
End;
'Q' : BEGIN
Done := TRUE;
Escape := FALSE;
End;
END (* CASE *);
END (* Escape found *);
^W : BEGIN
Done := TRUE;
Escape := FALSE;
END;
^X : BEGIN
Done := TRUE;
Escape := FALSE;
END;
(* Move to end of string *)
^F : X := Start_X + LENGTH(In_string);
(* Move to beginning of string *)
^A : X := Start_X;
^R : BEGIN
In_string := In_str;
GoToXY( Start_X , Y );
WRITE( In_string );
END;
(* Toggle Insert/Overwrite Mode *)
^V : Insert_Mode := NOT Insert_Mode;
(* Non-destructive backspace *)
^S : IF X > Start_X THEN
X := X - 1;
(* Destructive backspace *)
^H,#127 : IF X > Start_X THEN
BEGIN
DELETE( In_String, X - Start_X, 1 );
GoToXY( Start_X , Y );
WRITE( In_String , ' ' );
X := X - 1;
END;
(* Move 1 column to right *)
^D : IF (X - Start_X) < Buffer_Len THEN
IF (X - Start_X) < LENGTH( In_String ) THEN
X := X + 1;
(* Delete character under cursor *)
^G : BEGIN
DELETE( In_String, X - Start_X + 1, 1 );
GoToXY( Start_X , Y );
WRITE( In_String, ' ' );
END;
^M : Done := TRUE;
^J : Done := TRUE;
' '..'~' : IF ( X - Start_X ) >= LENGTH( In_String ) THEN
BEGIN
In_String := In_String + Current_Char;
GoToXY( X , Y );
WRITE( Current_Char );
IF ( X - Start_X ) < Buffer_Len THEN
X := X + 1;
END
ELSE (* Ordinary character *)
(* If insert mode ... *)
IF Insert_Mode THEN
BEGIN
INSERT( Current_Char, In_String,
X - Start_X + 1 );
In_String := COPY( In_String, 1, Buffer_Len );
GoToXY( Start_X, Y );
WRITE( In_String );
IF ( X - Start_X ) < Buffer_Len THEN
X := X + 1;
GoToXY( X , Y );
END
ELSE
BEGIN (* If Overwrite mode ... *)
In_String[ X - Start_X + 1 ] := Current_Char;
GoToXY( X , Y );
WRITE( Current_Char );
IF ( X - Start_X ) < Buffer_Len THEN
X := X + 1;
END;
ELSE
END (* CASE *);
UNTIL ( NOT Escape );
GoToXY( X , Y );
IF Status_Line > 0 THEN
Update_Status_Line;
UNTIL Done;
Edit_String := Current_Char; (* Return the terminator *)
In_str := In_string; (* Return updated string *)
END (* Edit_String *);
(*--------------------------------------------------------------------------*)
BEGIN (* Edit_A_Line *)
(* Tell host to stop sending *)
Async_Send( CHR( XOFF ) );
X := 1;
Y := WhereY;
Saved_X := WhereX;
Saved_Y := Y;
IF Y <> 1 THEN
Old_Status := 1
ELSE
Old_Status := 25;
Get_Screen_Text_Line( Saved_Line, Old_Status, 1 );
REPEAT
IF Y <> 1 THEN
Status_Line := 1
ELSE
Status_Line := 25;
IF Status_Line <> Old_Status THEN
BEGIN
Saved_X_2 := WhereX;
Saved_Y_2 := WhereY;
GoToXY( 1 , Old_Status );
WRITE( TRIM( Saved_Line ) );
ClrEol;
Old_Status := Status_Line;
Get_Screen_Text_Line( Saved_Line, Status_Line, 1 );
GoToXY( Saved_X_2, Saved_Y_2 );
END;
Get_Screen_Text_Line( S, Y, 1 );
S := Trim( S );
Ch := Edit_String( S, 255, 1, X, Y, FALSE, Status_Line );
CASE Ch OF
^W: IF ( Y > 1 ) THEN Y := Y - 1;
^X: IF ( Y < 25 ) THEN Y := Y + 1;
ELSE ;
END (* CASE *);
UNTIL ( Ch = CHR( CR ) );
GoToXY( 1 , Status_Line );
WRITE( TRIM( Saved_Line ) );
ClrEol;
GoToXY( Saved_X , Saved_Y );
Async_Send( CHR( XON ) );
Async_Send_String( Trim( S ) + CHR( CR ) );
END (* Edit_A_Line *);
ə