language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/multiscope/formedit.mod
IMPLEMENTATION MODULE FormEdit;
(* Show lines on the screen for user input/editing. *)
(* V1.1, J. Andrea, Jun.9/93 -correct a backspace/delete problem
-add first time edit to blank option *)
(* V1.0, J. Andrea, Jun.3/93 *)
FROM ScreenIO IMPORT screen_rows, screen_cols,
ReadKey, PutString, Bell,
Clear, ClearEOL, Goto,
Normal, Green, Yellow;
FROM Strings IMPORT Assign, Length;
CONST
max_string = 80;
next = 1;
last = 2;
TYPE
LineInfo = RECORD
on :BOOLEAN;
prompt, default, result :ARRAY [1..max_string+1] OF CHAR;
size, len :CARDINAL; (* max_size, and current size *)
col :CARDINAL; (* prompt column *)
point :ARRAY [1..2] OF CARDINAL;
first_edit :BOOLEAN; (* first time touched *)
END;
VAR
lines :ARRAY [1..max_lines] OF LineInfo;
message :ARRAY [0..80] OF CHAR;
error :BOOLEAN;
ordinary_key, shift_key, control_key, alt_key, function_key, arrow_key,
special_key :BOOLEAN;
key_value :CHAR;
(* ---------------------------------------- *)
PROCEDURE Key;
BEGIN
ReadKey( key_value,
shift_key, control_key, alt_key, function_key, arrow_key,
special_key );
ordinary_key := NOT ( control_key OR alt_key OR function_key OR
arrow_key OR special_key );
END Key;
(* ---------------------------------------- *)
PROCEDURE ShowHelp;
BEGIN
Clear; Normal;
PutString( 'F1 :show this help', 1, 10 );
PutString( 'ESC :redraw editing screen', 2, 10 );
PutString( 'arrow :move to item to be corrected', 4, 10 );
PutString( 'Home :move to beginning of line', 5, 10 );
PutString( 'End :move to end of line', 6, 10 );
PutString( 'Return:same as down arrow', 7, 10 );
PutString( 'Insert :open a space', 9, 10 );
PutString( 'Delete :delete current character', 10, 10 );
PutString( 'Backspace :delete previous character', 11, 10 );
PutString( 'F8 :reset line to original value', 13, 10 );
PutString( 'PageUp :move to first line', 15, 10 );
PutString( 'PageDown :move to last line', 16, 10 );
PutString( 'corrections :type to replace current character', 18, 10 );
PutString( ' typing is always in overwrite mode', 19, 10 );
PutString( 'F12 :finished editing', 21, 10 );
PutString( '-- hit any key to continue --', 25, 20 );
Key;
END ShowHelp;
(* ------------------------------------------------------ *)
PROCEDURE SetDefault( x :CARDINAL );
BEGIN
(* save the default as the first value *)
Assign( lines[x].default, lines[x].result );
lines[x].len := Length( lines[x].result );
END SetDefault;
(* ------------------------------------------- *)
PROCEDURE SetLine( line_number :CARDINAL;
prompt_string, default_string :ARRAY OF CHAR;
number_of_chars :CARDINAL;
VAR done :BOOLEAN );
BEGIN
error := FALSE;
done := TRUE;
IF ( line_number = 0 ) OR ( line_number > max_lines ) THEN
done := FALSE;
error := TRUE;
message := 'Line number out of range';
ELSE
IF number_of_chars = 0 THEN
done := FALSE;
error := TRUE;
message := 'Size of data item cannot be zero';
ELSIF number_of_chars >= screen_cols THEN
done := FALSE;
error := TRUE;
message := 'Size of data item too large';
ELSE
lines[line_number].size := number_of_chars;
END;
Assign( prompt_string, lines[line_number].prompt );
Assign( default_string, lines[line_number].default );
SetDefault( line_number );
lines[line_number].on := done;
lines[line_number].first_edit := TRUE;
END;
END SetLine;
(* ------------------------------------------- *)
PROCEDURE DoEditing( initial_edit, display_column :CARDINAL;
first_edit_blank :BOOLEAN );
VAR
very_first, very_last :CARDINAL;
current_line, current_pos :CARDINAL;
still_editing :BOOLEAN;
n_on :CARDINAL;
(* ---------------------------------------- *)
PROCEDURE Mark( on :BOOLEAN );
(* Make the current line green, or not *)
VAR
x, i, n :CARDINAL;
BEGIN
x := current_line;
IF ( x # 0 ) & lines[x].on THEN
Goto( x, display_column ); ClearEOL;
IF on THEN
Green;
ELSE
Yellow;
END;
(* show the item *)
PutString( lines[x].result, x, display_column );
IF on THEN
n := lines[x].len + 1;
i := display_column + n - 1;
(* and show how big it can be with underlines *)
WHILE ( n <= lines[x].size ) & ( i < screen_cols ) DO
PutString( '_', x, i );
n := n + 1;
i := i + 1;
END;
END;
PutCursor;
END;
END Mark;
(* -------------------------------------------- *)
PROCEDURE PutCursor;
BEGIN
Goto( current_line, current_pos + display_column - 1 );
END PutCursor;
(* --------------------------------------------- *)
PROCEDURE Display;
VAR
i, j, k :CARDINAL;
BEGIN
Clear;
Green;
PutString( 'F1 :help', screen_rows, 72 );
Normal;
FOR i := very_first TO very_last DO
IF lines[i].on THEN
k := lines[i].col;
IF k = 0 THEN
(* special case for a prompt that is too long,
show only enough as needed *)
FOR j := 0 TO display_column - 1 DO
PutString( lines[i].prompt[j], i, j+1 );
END;
ELSE
PutString( lines[i].prompt, i, k-1 );
END;
Yellow;
PutString( lines[i].result, i, display_column );
Normal;
END;
END;
Mark( TRUE );
PutCursor;
END Display;
(* ------------------------------------------------------ *)
PROCEDURE LineMove( forward :BOOLEAN );
(* Move the next line as defined by the arrow keys *)
VAR
direction, x :CARDINAL;
BEGIN
(* since we plan to move, turn off the pointer on the current item *)
Mark( FALSE );
IF forward THEN
direction := next;
ELSE
direction := last;
END;
x := lines[current_line].point[direction];
(* so set it and mark it *)
current_line := x;
Mark( TRUE );
EditEnd( TRUE );
END LineMove;
PROCEDURE LineEnd( bottom :BOOLEAN );
(* Move to the first or last line *)
BEGIN
Mark( FALSE );
IF bottom THEN
current_line := very_last;
ELSE
current_line := very_first;
END;
Mark( TRUE );
EditEnd( TRUE );
END LineEnd;
(* ----------------------------------------------------------- *)
PROCEDURE EditMove( forward :BOOLEAN );
(* Move on the current line *)
BEGIN
IF forward THEN
IF current_pos # lines[current_line].size THEN
current_pos := current_pos + 1;
END;
ELSE
IF current_pos # 1 THEN
current_pos := current_pos - 1;
END;
END;
PutCursor;
END EditMove;
PROCEDURE EditEnd( forward :BOOLEAN );
(* Move to the beginning or end of the current line *)
BEGIN
IF forward THEN
current_pos := lines[current_line].len;
IF current_pos = 0 THEN
(* if the line is blank, then just go to the first position *)
current_pos := 1;
END;
ELSE
current_pos := 1;
END;
PutCursor;
END EditEnd;
(* ------------------------------------------------ *)
PROCEDURE Delete( forward :BOOLEAN );
(* Delete the current character (FORWARD), or else delete the previous *)
VAR
i, k, n, m :CARDINAL;
BEGIN
n := lines[current_line].len;
IF n # 0 THEN
lines[current_line].first_edit := FALSE;
IF forward THEN
m := n;
ELSE
(* for back spacing, cursor may be one past last valid character *)
m := n + 1;
END;
IF current_pos <= m THEN
(* otherwise, cursor is past the end of the string, so just move cursor *)
IF forward THEN
(* delete the current item *)
k := current_pos;
ELSE
k := current_pos - 1;
END;
IF k # 0 THEN
(* shrink the current string *)
FOR i := k TO n - 1 DO
lines[current_line].result[i] :=
lines[current_line].result[i+1];
END;
lines[current_line].result[n] := 0C;
lines[current_line].len := n - 1;
END;
END;
(* move backwards *)
EditMove( FALSE );
Mark( TRUE );
PutCursor;
END;
END Delete;
(* ------------------------------------------------- *)
PROCEDURE Replace( ch :CHAR );
(* Replace the current character with whats passed in *)
VAR
n, i :CARDINAL;
BEGIN
n := lines[current_line].len;
lines[current_line].first_edit := FALSE;
IF current_pos > n THEN
(* its been placed beyond the current end, so fill the rest with spaces *)
FOR i := n + 1 TO current_pos DO
lines[current_line].result[i] := ' ';
END;
(* save this new position as the length *)
lines[current_line].len := current_pos;
(* put a null char after it *)
lines[current_line].result[current_pos+1] := 0C;
END;
(* and put the wanted character there *)
lines[current_line].result[current_pos] := ch;
(* skip on to the next character *)
current_pos := current_pos + 1;
(* but don't try to go past the end *)
IF current_pos > lines[current_line].size THEN
current_pos := current_pos - 1
END;
Mark( TRUE );
END Replace;
(* ------------------------------------------------------ *)
PROCEDURE Insert( ch :CHAR );
(* Insert the given character at the current position, push the other
characters down one space. *)
VAR
i, j, n, x :CARDINAL;
BEGIN
x := current_line;
n := lines[x].len;
lines[x].first_edit := FALSE;
IF current_pos > n THEN
(* can only insert if there's something there *)
(* otherwise, just put in a space *)
Replace( ' ' );
(* but move back to that same position again *)
EditMove( FALSE );
ELSE
(* pull the existing characters after this one back one level *)
j := n + 1;
FOR i := current_pos TO n DO
lines[x].result[j] := lines[x].result[j-1];
j := j - 1;
END;
(* put a new 'space' at the new location *)
lines[x].result[current_pos] := ' ';
i := lines[x].size;
IF n = i THEN
(* the line was already at its maximum size *)
n := i;
ELSE
(* otherwise, just count up one more character *)
n := n + 1;
END;
lines[x].len := n;
lines[x].result[n+1] := 0C;
Mark( TRUE );
END;
END Insert;
(* ------------------------------------------------------------ *)
PROCEDURE SetupDisplay;
(* Determine the loctions of things on the screen, and the pointers
from one line to the other for easy arrow motion. *)
VAR
len, i :CARDINAL;
BEGIN
very_first := 0;
very_last := 0;
n_on := 0; (* How many are turned on *)
(* determine the pointers *)
FOR i := 1 TO max_lines DO
IF lines[i].on THEN
n_on := n_on + 1;
IF very_first = 0 THEN
(* this is the first line, so save its value *)
very_first := i;
END;
IF very_last # 0 THEN
(* the one after the last one is this one *)
lines[very_last].point[next] := i;
END;
(* save the value of the previous one, this is ok even if its
the first, because the first and last will be reset later *)
lines[i].point[last] := very_last;
(* save this one as the last one, for the next one it will count
as the previous one. And it will be the very last at the end of
the loop *)
very_last := i;
(* determine where the columns should go *)
(* try to show as much as the prompt as possible *)
len := Length( lines[i].prompt );
IF len >= display_column THEN
(* not all of the prompt can be displayed *)
(* set a special value for the column *)
lines[i].col := 0;
ELSE
(* determine how far back the start should be *)
lines[i].col := display_column - len;
END;
END;
END;
(* and finish up the pointers for the first and last so that they wrap *)
lines[very_first].point[last] := very_last;
lines[very_last].point[next] := very_first;
END SetupDisplay;
BEGIN
error := FALSE;
IF display_column = 0 THEN display_column := 1 END;
IF display_column > screen_cols THEN display_column := screen_cols - 1 END;
SetupDisplay;
IF n_on # 0 THEN
IF initial_edit = 0 THEN initial_edit := very_first END;
IF initial_edit > very_last THEN initial_edit := very_last END;
IF NOT lines[initial_edit].on THEN initial_edit := very_first END;
current_line := initial_edit;
EditEnd( TRUE );
Display;
still_editing := TRUE;
REPEAT
Key;
IF arrow_key THEN
IF key_value = '^' THEN (* up *)
LineMove( FALSE );
ELSIF key_value = 'v' THEN (* down *)
LineMove( TRUE );
ELSIF key_value = '<' THEN (* left *)
EditMove( FALSE );
ELSE (* right *)
EditMove( TRUE );
END;
ELSIF special_key THEN
IF key_value = 'h' THEN (* home *)
EditEnd( FALSE );
ELSIF key_value = 'e' THEN (* end *)
EditEnd( TRUE );
ELSIF key_value = 'd' THEN (* delete *)
Delete( TRUE );
ELSIF key_value = 'i' THEN (* insert *)
Insert( ' ' );
ELSIF key_value = '^' THEN (* page up *)
LineEnd( FALSE );
ELSIF key_value = 'v' THEN (* page down *)
LineEnd( TRUE );
END;
ELSIF function_key THEN
IF key_value = '<' THEN (* f12 *)
still_editing := FALSE;
ELSIF key_value = '8' THEN (* f8 *)
SetDefault( current_line );
Mark( TRUE );
EditEnd( TRUE );
ELSIF key_value = '1' THEN (* f1 *)
ShowHelp;
Display;
ELSE
Bell;
END;
ELSIF control_key THEN
IF key_value = '[' THEN (* esc *)
Display;
ELSIF key_value = 'h' THEN (* backspace *)
Delete( FALSE );
ELSIF key_value = 'm' THEN (* return *)
LineMove( TRUE );
ELSE
Bell;
END;
ELSIF ordinary_key THEN
IF first_edit_blank & lines[current_line].first_edit THEN
(* set this item to all blank for this first edit *)
lines[current_line].len := 0;
current_pos := 1;
END;
IF shift_key THEN key_value := CAP( key_value ) END;
Replace( key_value );
ELSE
Bell;
END;
UNTIL NOT still_editing;
Normal; Clear;
END;
END DoEditing;
(* ------------------------------------------- *)
PROCEDURE GetLine( line_number :CARDINAL;
VAR answer :ARRAY OF CHAR;
VAR done :BOOLEAN );
(* Return the value for the specified line. *)
BEGIN
error := FALSE;
done := TRUE;
IF ( line_number = 0 ) OR ( line_number > max_lines ) THEN
done := FALSE;
error := TRUE;
message := 'Line number out of range';
ELSE
IF lines[line_number].on THEN
Assign( lines[line_number].result, answer );
ELSE
done := FALSE;
error := TRUE;
message := 'Line not set';
END;
END;
END GetLine;
(* ------------------------------------------- *)
PROCEDURE ResetLine( line_number :CARDINAL );
VAR
i :CARDINAL;
BEGIN
error := FALSE;
IF line_number = 0 THEN
FOR i := 1 TO max_lines DO
lines[i].on := FALSE;
END;
ELSE
IF ( line_number > 0 ) & ( line_number <= max_lines ) THEN
lines[line_number].on := FALSE;
END;
END;
END ResetLine;
(* ------------------------------------------- *)
PROCEDURE GetMessage( VAR problem :BOOLEAN; VAR string :ARRAY OF CHAR );
BEGIN
IF error THEN
Assign( message, string );
ELSE
string[0] := 0C;
END;
END GetMessage;
BEGIN
error := FALSE;
ResetLine( 0 );
END FormEdit.