home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GEMini Atari
/
GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso
/
files
/
bbs
/
pibterm
/
pibt3sp4
/
setinptk.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-09-05
|
26KB
|
678 lines
(*----------------------------------------------------------------------*)
(* Set_Input_Keys --- Set Input Key Values *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Set_Input_Keys( File_Name : AnyStr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Set_Input_Keys *)
(* *)
(* Purpose: Set values of function keys and keypad keys *)
(* *)
(* Calling Sequence: *)
(* *)
(* Set_Input_Keys( File_Name : AnyStr ); *)
(* *)
(* If not null is file name to read key definitions from. *)
(* *)
(* Calls: *)
(* Menu_Display_Choices *)
(* Menu_Get_Choices *)
(* Read_Key_Defs_From_File; *)
(* Get_Key_Defs_From_Keyboard; *)
(* Write_Key_Defs_To_File; *)
(* *)
(* Remarks: *)
(* *)
(* This whole section of code should be reworked to use *)
(* full-screen editing at some point. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Input_Key_File : TEXT;
Input_Key_File_Name : AnyStr;
Key_Name : STRING[3];
Key_Text : AnyStr;
Section_No : INTEGER;
Key_Def_Text : AnyStr;
Key_Number : INTEGER;
L_Text : INTEGER;
I : INTEGER;
J : INTEGER;
Input_Key_Menu : Menu_Type;
Done : BOOLEAN;
Key_Type : INTEGER;
(*----------------------------------------------------------------------*)
(* Process_Function_Key_Definition --- Process Function Key Definition *)
(*----------------------------------------------------------------------*)
PROCEDURE Process_Key_Definition;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Process_Key_Definition *)
(* *)
(* Purpose: Process and store key definition string *)
(* *)
(* Calling Sequence: *)
(* *)
(* Process_Key_Definition; *)
(* *)
(* On entry, Key_Text should have the key definition text *)
(* as read from a file. *)
(* *)
(*----------------------------------------------------------------------*)
(* STRUCTURED *) CONST
Keypad_Nos: ARRAY[0..10] OF BYTE
= ( 9, 7, 4, 8, 2, 0, 3, 5, 1, 6, 10 );
BEGIN (* Process_Key_Definition *)
L_Text := LENGTH( Key_Text );
(* Get key name *)
Key_Name := COPY( Key_Text, 1, 2 );
IF Key_Text[3] <> '=' THEN
Key_Name := Key_Name + Key_Text[3];
(* Choose section *)
CASE UpCase( Key_Name[1] ) OF
'F': Section_No := 1;
'S': Section_No := 2;
'C': IF UpCase( Key_Name[2] ) = 'K' THEN
Section_No := 7
ELSE
Section_No := 3;
'A': IF UpCase( Key_Name[2] ) = 'K' THEN
Section_No := 6
ELSE
Section_No := 4;
'K': Section_No := 5;
ELSE
Section_No := 0;
END (* Case *);
(* Key text initially null *)
Key_Def_Text := '';
(* Get key number *)
I := 2;
Key_Number := 0;
WHILE ( I <= L_Text ) AND ( Key_Text[I] <> '=' ) DO
BEGIN
CASE Key_Text[I] OF
'0'..'9': Key_Number := Key_Number * 10 + ORD(Key_Text[I]) - ORD('0');
'.' : Key_Number := 10;
END (* Case *);
I := I + 1;
END;
(* Skip past '=' sign *)
IF Key_Text[I] = '=' THEN I := I + 1;
(* Get key text *)
IF ( L_Text - I + 1 ) > 0 THEN
Key_Def_Text := Read_Ctrls( COPY( Key_Text, I, L_Text - I + 1 ) );
(* Insert key text in function key *)
(* or keypad key. *)
IF Section_No IN [1..4] THEN
BEGIN
IF ( Key_Number > 0 ) AND ( Key_Number < 11 ) THEN
Function_Keys[ Section_No , Key_Number ] := Key_Def_Text;
END
ELSE IF Section_No IN [5..7] THEN
BEGIN
IF ( Key_Number >= 0 ) AND ( Key_Number < 11 ) THEN
Keypad_Keys[ Section_No - 4 , Keypad_Nos[ Key_Number ] ]
:= Key_Def_Text;
END;
END (* Process_Key_Definition *);
(*----------------------------------------------------------------------*)
(* Read_Key_Defs_From_File --- get key definitions from file *)
(*----------------------------------------------------------------------*)
PROCEDURE Read_Key_Defs_From_File;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Read_Key_Defs_From_File *)
(* *)
(* Purpose: Reads function key and keypad key values from file *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Key_Defs_From_File; *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Read_Key_Defs_From_File *)
(* Announce input key definition *)
Save_Screen( Saved_Screen );
Draw_Menu_Frame( 10, 10, 65, 15, Menu_Frame_Color,
Menu_Text_Color, 'Read Input Key Definitions' );
(* Prompt for file with definitions *)
(* if not already specified *)
Input_Key_File_Name := File_Name;
WRITELN;
WRITE('File with definitions? ');
IF LENGTH( Input_Key_File_Name ) <= 0 THEN
READLN( Input_Key_File_Name )
ELSE
BEGIN
WRITE( Input_Key_File_Name );
DELAY( One_Second_Delay );
END;
(* Assume .FNC if type not given *)
IF ( POS( '.', Input_Key_File_Name ) = 0 ) THEN
Input_Key_File_Name := Input_Key_File_Name + '.FNC';
(* Attach file with definitions *)
ASSIGN( Input_Key_File , Input_Key_File_Name );
(*$I-*)
RESET ( Input_Key_File );
(*$I+*)
(* See if openable *)
IF IoResult <> 0 THEN
BEGIN (* File bad *)
WRITELN;
WRITELN('*** File ',Input_Key_File_Name,' can''t be found.');
DELAY( Two_Second_Delay );
END (* File bad *)
ELSE
BEGIN (* File OK, read definitions *)
REPEAT
Key_Text := ' ';
(* Read key definition *)
READLN( Input_Key_File , Key_Text );
(* Process it *)
Process_Key_Definition;
UNTIL( EOF( Input_Key_File ) );
(* Indicate definitions finished *)
WRITELN('Function key definitions loaded.');
DELAY( Two_Second_Delay );
CLOSE( Input_Key_File );
END (* File OK, read definitions *);
(* Restore previous screen *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
END (* Read_Key_Defs_From_File *);
(*----------------------------------------------------------------------*)
(* Get_Key_Defs_From_Keyboard --- get key defs. from keyboard *)
(*----------------------------------------------------------------------*)
PROCEDURE Get_Key_Defs_From_Keyboard;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Key_Defs_From_Keyboard *)
(* *)
(* Purpose: Read function and keypad key values from keyboard *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Key_Defs_From_Keyboard; *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Local_Save : Saved_Screen_Ptr;
Page_No : INTEGER;
Key_Menu : Menu_Type;
Key_Type : INTEGER;
Defs_Done : BOOLEAN;
(*----------------------------------------------------------------------*)
(* Display_Key_Defs --- Display current key definitions *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Key_Defs( Key_Type : INTEGER );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Display_Key_Defs *)
(* *)
(* Purpose: Display portion of current key definitions *)
(* *)
(* Calling Sequence: *)
(* *)
(* Display_Key_Defs( Key_Type: INTEGER ); *)
(* *)
(* Key_Type --- Key type to display. *)
(* = 1: F1 through F10 *)
(* = 2: Shift F1 through Shift F10 *)
(* = 3: Ctrl F1 through Ctrl F10 *)
(* = 4: Alt F1 through Alt F10 *)
(* = 5: Keypad keys *)
(* = 6: Alt keypad keys *)
(* = 7: Ctrl keypad keys *)
(* *)
(*----------------------------------------------------------------------*)
(* STRUCTURED *) CONST
Long_Key_Names : ARRAY[1..10] OF STRING[7] =
( 'Up', 'Left', 'Right', 'Down',
'Home', 'PgUp', 'End', 'PgDn', 'Ins', 'Del' );
VAR
I : INTEGER;
J : INTEGER;
Key_Prefix : STRING[10];
Defs_Done : BOOLEAN;
BEGIN (* Display_Key_Defs *)
GoToXY( 1 , 1 );
(* Display title *)
WRITELN(' # -Key Name- ',
'------------------------Definition-------------------------- ');
WRITELN(' ');
CASE Key_Type OF
1: Key_Prefix := 'F';
2: Key_Prefix := 'Shift F';
3: Key_Prefix := 'Ctrl F';
4: Key_Prefix := 'Alt F';
5: Key_Prefix := '';
6: Key_Prefix := 'Alt ';
7: Key_Prefix := 'Ctrl ';
ELSE;
END (* Case *);
IF Key_Type IN [1..4] THEN
FOR I := 1 TO 10 DO
BEGIN
GoToXY( 1 , I + 3 );
ClrEol;
WRITE( I:2,' ',Key_Prefix , I );
GoToXY( 15 , I + 3 );
WRITE( Function_Keys[ Key_Type , I ] );
END
ELSE
FOR I := 1 TO 10 DO
BEGIN
GoToXY( 1 , I + 3 );
ClrEol;
WRITE( I:2,' ',Key_Prefix , Long_Key_Names[I] );
GoToXY( 15 , I + 3 );
WRITE( Keypad_Keys[ Key_Type - 4 , I ] );
END;
FOR I := 14 TO 19 DO
BEGIN
GoToXY( 1 , I );
ClrEol;
END;
END (* Display_Key_Defs *);
(*----------------------------------------------------------------------*)
(* Update_Key_Defs --- Update key definitions *)
(*----------------------------------------------------------------------*)
PROCEDURE Update_Key_Defs( Key_Type: INTEGER; VAR Defs_Done : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Update_Key_Defs *)
(* *)
(* Purpose: Update key definitions *)
(* *)
(* Calling Sequence: *)
(* *)
(* Update_Key_Defs( Key_Type: INTEGER; VAR Defs_Done: BOOLEAN ); *)
(* *)
(* Key_Type --- Key type to define. *)
(* = 1: F1 through F10 *)
(* = 2: Shift F1 through Shift F10 *)
(* = 3: Ctrl F1 through Ctrl F10 *)
(* = 4: Alt F1 through Alt F10 *)
(* = 5: Keypad keys *)
(* = 6: Alt keypad keys *)
(* = 7: Ctrl keypad keys *)
(* *)
(* Defs_Done --- TRUE if definitions complete. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Key_No : INTEGER;
Key_No_Str : STRING[10];
OK_Number : BOOLEAN;
I : INTEGER;
BEGIN (* Update_Key_Defs *)
(* Not through with definitions yet *)
Defs_Done := FALSE;
(* Get number of key to change *)
REPEAT
(* Assume good key number found *)
OK_Number := TRUE;
(* Clear any previous error *)
GoToXY( 1 , 17 );
ClrEol;
GoToXY( 1 , 16 );
WRITE(' Enter key number to redefine or <CR> to quit: ');
ClrEol;
READLN( Key_No_Str );
Defs_Done := ( LENGTH( Key_No_Str ) = 0 );
Key_No := 0;
IF ( NOT Defs_Done ) THEN
BEGIN
FOR I := 1 TO LENGTH( Key_No_Str ) DO
IF Key_No_Str[I] IN ['0'..'9'] THEN
Key_No := Key_No * 10 + ORD(Key_No_Str[I]) - ORD('0')
ELSE
OK_Number := FALSE;
OK_Number := OK_Number AND ( Key_No > 0 ) AND ( Key_No < 11 );
END;
IF ( NOT OK_Number ) THEN
BEGIN
GoToXY( 1 , 17 );
WRITE(' *** Bad key number, try again.');
ClrEol;
DELAY( 1000 );
END;
UNTIL ( OK_Number OR Defs_Done );
(* If no number entered, quit; *)
(* else, pick up definition. *)
IF ( NOT Defs_Done ) THEN
BEGIN
GoToXY( 1 , 17 );
WRITELN(' Enter new key definition ...');
WRITE(' -->');
ClrEol;
READLN( Key_Text );
(* Store new key definition *)
IF Key_Type IN [1..4] THEN
Function_Keys[Key_Type,Key_No] := Read_Ctrls( Key_Text )
ELSE
Keypad_Keys[Key_Type - 4, Key_No] := Read_Ctrls( Key_Text );
END;
END (* Update_Key_Defs *);
(*----------------------------------------------------------------------*)
BEGIN (* Get_Key_Defs_From_Keyboard *)
(* Save screen *)
Save_Screen( Local_Save );
(* Get back whole screen as window *)
(* for key display *)
Window( 1, 1, 80, 25 );
ClrScr;
Draw_Menu_Frame( 1, 2, 80, 23, Menu_Frame_Color,
Menu_Text_Color, 'Input key definition' );
Window( 2, 3, 78, 22 );
(* Set up menu *)
Key_Menu.Menu_Size := 8;
Key_Menu.Menu_Row := 11;
Key_Menu.Menu_Column := 15;
Key_Menu.Menu_Tcolor := Menu_Text_Color;
Key_Menu.Menu_Bcolor := BackGround_Color;
Key_Menu.Menu_Fcolor := Menu_Frame_Color;
Key_Menu.Menu_Width := 0;
Key_Menu.Menu_Height := 0;
Key_Menu.Menu_Default := 1;
FOR I := 1 TO 8 DO
WITH Key_Menu.Menu_Entries[I] DO
BEGIN
Menu_Item_Row := I;
Menu_Item_Column := 2;
CASE I Of
1: Menu_Item_Text:= '1) Function keys 1 to 10';
2: Menu_Item_Text:= '2) Shifted function keys';
3: Menu_Item_Text:= '3) Ctrl + function keys';
4: Menu_Item_Text:= '4) Alt + function keys';
5: Menu_Item_Text:= '5) Keypad keys';
6: Menu_Item_Text:= '6) Alt + keypad keys';
7: Menu_Item_Text:= '7) Ctrl + keypad keys';
8: Menu_Item_Text:= '8) Quit';
END (* CASE *);
END;
Key_Menu.Menu_Title := 'Select keys to define:';
(* Loop until quit chosen *)
Done := FALSE;
REPEAT
(* Display menu of choices *)
Menu_Display_Choices( Key_Menu );
Key_Type := Menu_Get_Choice( Key_Menu , Erase_Menu );
(* Do requested operation *)
IF Key_Type <> 8 THEN
REPEAT
Display_Key_Defs( Key_Type );
Update_Key_Defs( Key_Type , Defs_Done );
UNTIL( Defs_Done )
ELSE
Done := TRUE;
UNTIL Done;
(* Restore previous screen *)
Restore_Screen( Local_Save );
Reset_Global_Colors;
END (* Get_Key_Defs_From_Keyboard *);
(*----------------------------------------------------------------------*)
(* Write_Key_Defs_To_File --- write revised key definitions to file *)
(*----------------------------------------------------------------------*)
PROCEDURE Write_Key_Defs_To_File;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Write_Key_Defs_To_File *)
(* *)
(* Purpose: Write updated function key and keypad key values *)
(* *)
(* Calling Sequence: *)
(* *)
(* Write_Key_Defs_To_File; *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Local_Save : Saved_Screen_Ptr;
BEGIN (* Write_Key_Defs_To_File *)
(* Indicate write to file *)
Save_Screen( Local_Save );
Draw_Menu_Frame( 10, 10, 75, 13, Menu_Frame_Color,
Menu_Text_Color, 'Write Function Key Definitions' );
(* Get name of file to write to *)
GoToXY( 2 , 1 );
WRITE('Enter file name to write definitions to (CR to exit): ');
ClrEol;
READLN( Input_Key_File_Name );
(* Assume .FNC if type not given *)
IF ( POS( '.', Input_Key_File_Name ) = 0 ) THEN
Input_Key_File_Name := Input_Key_File_Name + '.FNC';
(* Ensure file can be opened *)
IF LENGTH( Input_Key_File_Name ) > 0 THEN
BEGIN
ASSIGN( Input_Key_File , Input_Key_File_Name );
(*$I-*)
REWRITE( Input_Key_File );
(*$I+*)
IF IoResult <> 0 THEN
BEGIN (* File bad *)
GoToXY( 2 , 2 );
WRITE('*** File ',Input_Key_File_Name,' can''t be opened.');
ClrEol;
DELAY( Two_Second_Delay );
END (* File bad *)
ELSE
BEGIN (* File OK, definitions written *)
(* Write out function keys *)
FOR I := 1 TO 4 DO
FOR J := 1 TO 10 DO
IF LENGTH( Function_Keys[I,J] ) > 0 THEN
WRITELN( Input_Key_File, COPY( 'FSCA', I, 1 ),
J:2, '=', Write_Ctrls(Function_Keys[I,J]) );
(* Write out keypad keys *)
FOR I := 1 TO 3 DO
FOR J := 1 TO 10 DO
IF LENGTH( Keypad_Keys[I,J] ) > 0 THEN
WRITELN( Input_Key_File,
Keypad_Key_Names[I,J], '=',
Write_Ctrls(Keypad_Keys[I,J]) );
CLOSE( Input_Key_File );
GoToXY( 2 , 2 );
WRITE('Function key definitions written to ',
Input_Key_File_Name );
ClrEol;
DELAY( Two_Second_Delay );
END (* File OK, definitions written *);
END;
(* Restore previous screen *)
Restore_Screen( Local_Save );
END (* Write_Key_Defs_To_File *);
(*----------------------------------------------------------------------*)
BEGIN (* Set_Input_Keys *)
(* If file name specified, get keys *)
(* from specified file. *)
IF LENGTH( File_Name ) > 0 THEN
BEGIN
Read_Key_Defs_From_File;
EXIT;
END;
(* Set up menu *)
Input_Key_Menu.Menu_Size := 4;
Input_Key_Menu.Menu_Row := 11;
Input_Key_Menu.Menu_Column := 15;
Input_Key_Menu.Menu_Tcolor := Menu_Text_Color;
Input_Key_Menu.Menu_Bcolor := BackGround_Color;
Input_Key_Menu.Menu_Fcolor := Menu_Frame_Color;
Input_Key_Menu.Menu_Width := 0;
Input_Key_Menu.Menu_Height := 0;
Input_Key_Menu.Menu_Default := 1;
FOR I := 1 TO 4 DO
WITH Input_Key_Menu.Menu_Entries[I] DO
BEGIN
Menu_Item_Row := I;
Menu_Item_Column := 2;
CASE I Of
1: Menu_Item_Text:= 'R)ead definitions from file';
2: Menu_Item_Text:= 'E)nter definitions from keyboard';
3: Menu_Item_Text:= 'W)rite definitions to file';
4: Menu_Item_Text:= 'Q)uit key definition';
END (* CASE *);
END;
Input_Key_Menu.Menu_Title := 'Choose Key Definition Method: ';
(* Loop until quit chosen *)
Done := FALSE;
REPEAT
(* Display menu of choices *)
Menu_Display_Choices( Input_Key_Menu );
Key_Type := Menu_Get_Choice( Input_Key_Menu , Erase_Menu );
(* Do requested operation *)
CASE Key_Type OF
1: Read_Key_Defs_From_File;
2: Get_Key_Defs_From_Keyboard;
3: Write_Key_Defs_To_File;
4: Done := TRUE;
END (* CASE *);
UNTIL Done;
END (* Set_Input_Keys *);ə