home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / edit / wpcrt.src < prev    next >
Encoding:
Text File  |  1988-05-03  |  192.9 KB  |  4,116 lines
  1. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2. --crtibm
  3. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  4.  
  5.   --$$$+ CRTIBM
  6.    
  7.   --
  8.   -- File 004
  9.   --
  10.   -- Editor Written By Robert S. Cymbalski
  11.   --                   Science Applications International Corporation
  12.   --                   Energy Systems Group
  13.   --                   Ada Software Development Project Team
  14.   --                   2280 U.S. Highway 19 North, Suite 120
  15.   --                   Clearwater, Florida  33575
  16.   --
  17.   -- Program Revised from text Copyright (c) 1984 , R.S.Cymbalski
  18.     
  19.   with string_library  ;
  20.   use  string_library  ;
  21.    
  22.   with basic_io_system ;
  23.   use  basic_io_system ;
  24.  
  25.   package crt_customization is
  26.     
  27.   package CRT is
  28.          
  29.     type SPECIAL_KEYS is ( KEY_ILLEGAL, KEY_CHARACTER, KEY_END_OF_TEXT, 
  30.                            KEY_ESCAPE, KEY_TAB_FORWARD, KEY_HOME,
  31.                            KEY_LINE_FEED , KEY_CARRIAGE_RETURN ,
  32.                            KEY_TAB_BACKWARD, KEY_BACKSPACE, KEY_UP, KEY_DOWN, 
  33.                            KEY_RIGHT, KEY_LEFT, KEY_DELETE, KEY_FUNCTION,
  34.                            KEY_ALTERNATE );
  35.     
  36.     type CRT_COLOR is (BLACK,RED,BLUE,GREEN,PURPLE,YELLOW,LIGHT_BLUE,WHITE);
  37.     type CHAR_ATTRIBUTES is (NORMAL, BLINK, UNDERLINE, OTHER_INTENSITY );
  38.     type CRT_CONTROL is (COLD_INIT, WARM_INIT, ERASE_ALL, ERASE_EOL,
  39.                          ERASE_EOS, INSERT_LINE, DELETE_LINE,REVERSE_VIDEO,
  40.                          CRT_HOME, CRT_UP, CRT_DOWN, CRT_RIGHT, CRT_LEFT,
  41.                          scroll_middle_screen_up , scroll_entire_screen_up ,
  42.                          scroll_partial_screen_up ,
  43.                          scroll_middle_screen_down , scroll_entire_screen_down ,
  44.                          scroll_partial_screen_down ,
  45.                          CURSOR_ON, CURSOR_OFF, EXTRA_DISPLAY_ON,
  46.                          EXTRA_DISPLAY_OFF, KEYBOARD_INPUT_ON, 
  47.                          KEYBOARD_INPUT_OFF, PROGRAM_TERMINATION );
  48.         
  49.     CRT_ATTRIBUTE_1 : CHAR_ATTRIBUTES := NORMAL ;
  50.     CRT_ATTRIBUTE_2 : CHAR_ATTRIBUTES := NORMAL ;
  51.     CRT_ATTRIBUTE_3 : CHAR_ATTRIBUTES := NORMAL ;
  52.         
  53.     CURRENT_CRT_COLOR : CRT_COLOR     := GREEN ; -- holds current color 
  54.     DEFAULT_CRT_COLOR : CRT_COLOR     := GREEN ; -- is standard I/O color
  55.     CURRENT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;
  56.     DEFAULT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;--standard background color
  57.         
  58.     NUM_KEY_TYPES : constant integer := 5 ;
  59.     NUM_KEYS_WITHIN_TYPE : constant integer := 16 ;
  60.     type type_of_key_change is record
  61.       KEY          : extended_character;
  62.       SPECIAL_MEANING: SPECIAL_KEYS ;
  63.       FINAL_KEY    : extended_character;
  64.       end record;
  65.     type ARRAY_TYPE_OF_KEY_CHANGE is 
  66.       array ( 1 .. NUM_KEYS_WITHIN_TYPE ) of type_of_key_change ;
  67.     type KEY_SET is record
  68.       LEAD_IN_LENGTH : INTEGER ;
  69.       LEAD_IN        : STRING(1 .. 5);
  70.       FOLLOW_REMOVE  : INTEGER ;
  71.       EACH_KEY       : ARRAY_TYPE_OF_KEY_CHANGE ;
  72.       end record;
  73.     type ALL_KEYS is array ( 1..NUM_KEY_TYPES ) of KEY_SET ;
  74.         
  75.     KEY_MAP : ALL_KEYS;
  76.     REAL_KEY_ON_INPUT : array ( 0..255 ) of extended_character ;
  77.     SPECIAL_MEANING_ON_INPUT : array ( 0..255 ) OF SPECIAL_KEYS ;
  78.        
  79.     -- Now, we need the CRT handler routines
  80.          
  81.     procedure GOTOXY(COL : in A_SCREEN_COLUMN_NUMBER; 
  82.                      LINE : in A_SCREEN_LINE_NUMBER);
  83.          
  84.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN;
  85.         
  86.     procedure DO_CRT( CONTROL : in CRT_CONTROL );
  87.         
  88.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  89.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  90.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL );
  91.           
  92.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  93.                             BACKGROUND_COLOR : in CRT_COLOR := black);
  94.          
  95.     procedure scroll_up_middle_screen (
  96.                         first_line_to_scroll      : a_screen_line_number ;
  97.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  98.      
  99.     procedure scroll_up_entire_screen (
  100.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  101.      
  102.     procedure scroll_up_partial_screen ( 
  103.                         first_line_to_scroll      : a_screen_line_number ;
  104.                         last_line_to_scroll       : a_screen_line_number ;
  105.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  106.      
  107.     procedure scroll_down_middle_screen (
  108.                         last_line_to_scroll       : a_screen_line_number ;
  109.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  110.      
  111.     procedure scroll_down_entire_screen (
  112.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  113.      
  114.     procedure scroll_down_partial_screen (
  115.                         first_line_to_scroll      : a_screen_line_number ;
  116.                         last_line_to_scroll       : a_screen_line_number ;
  117.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  118.      
  119.   end CRT ;
  120.        
  121.   package editor_customization is
  122.        
  123.     type crt_editor_command is ( up_command          , down_command        ,
  124.                                  right_command       , left_command        ,
  125.                                  
  126.                                 advance_character_command ,
  127.                                 advance_word_command      ,
  128.                                 advance_tab_command       ,
  129.                                 advance_line_command      ,
  130.                                 advance_paragraph_command ,
  131.                                 advance_page_command      ,
  132.                                 advance_infinity_command  ,
  133.                                  
  134.                                 forward_character_command  , 
  135.                                 backward_character_command ,
  136.                                 forward_word_command  , backward_word_command ,
  137.                                 forward_tab_command   , backward_tab_command  ,
  138.                                 forward_line_command  , backward_line_command ,
  139.                                 forward_paragraph_command  ,
  140.                                 backward_paragraph_command ,
  141.                                 forward_page_command  , backward_page_command ,
  142.                                  
  143.                                 home_command          ,
  144.                                 move_to_first_line_position_command ,
  145.                                 move_to_last_line_position_command  ,
  146.                                 jump_to_first_position_command ,
  147.                                 jump_to_last_position_command  ,
  148.                                  
  149.                                 jump_to_marked_position_command ,
  150.                                  
  151.                                 set_forward_direction ,
  152.                                 set_backward_direction ,
  153.                                      
  154.                                 shift_screen_right  , shift_screen_left   ,
  155.                                  
  156.                                 adjust_command        , 
  157.                                 copy_command          , 
  158.                                 start_deletion_command,
  159.                                 find_command          ,
  160.                                 help_command          ,
  161.                                 insert_command        ,
  162.                                 jump_command          , 
  163.                                 kill_command          , 
  164.                                 print_screen_command  , 
  165.                                 re_margin_command     ,
  166.                                 quit_command          , 
  167.                                 replace_command       , 
  168.                                 set_stuff_command     ,
  169.                                 verify_screen_command ,
  170.                                 enter_exchange_mode   ,
  171.                                 zap_command           , 
  172.                                  
  173.                                 accept_command        , 
  174.                                 reject_command        ,
  175.                                 word_processor_command,
  176.                                 digit_command         ,
  177.                                 infinity_command      ,
  178.                                 show_other_prompt_command ,
  179.                                 illegal_command    )  ;
  180.        
  181.     Main_Command_Prompt                : string (1..71) ;
  182.     Alternate_Command_Prompt           : string (1..71) ;
  183.     Adjust_Command_Prompt              : string (1..69) ; 
  184.     Copy_Command_Prompt                : string (1..46) ;
  185.     Delete_Command_Prompt              : string (1..69) ; 
  186.     Find_Command_Prompt                : string (1.. 7) ; 
  187.     Help_Command_Prompt                : string (1..29) ; 
  188.     Insert_Command_Prompt              : string (1..63) ; 
  189.     Jump_Command_Prompt                : string (1..55) ;
  190.     Kill_Command_Prompt                : string (1..78) ; 
  191.     Line_Printer_Command_Prompt        : string (1..66) ; 
  192.     Margin_Command_Prompt              : string (1.. 1) ; 
  193.     Quit_Command_Prompt                : string (1..20) ;
  194.     Replace_Command_Prompt             : string (1..10) ; 
  195.     Set_Command_Prompt                 : string (1..69) ; 
  196.     eXchange_Command_Prompt            : string (1..65) ;
  197.     Zap_Command_Prompt                 : string (1..47) ;
  198.     Enter_Input_File_Name_Prompt       : string (1..57) ;
  199.     Enter_Copied_In_File_Name_Prompt   : string (1..49) ; 
  200.       
  201.     procedure translate( ch            : in character          ;
  202.                          special       : in crt.special_keys   ;
  203.                          new_ch        : out character         ;
  204.                          edit_special  : out crt_editor_command ) ;
  205.         
  206.     max_wp_command_length : constant integer := 20 ;
  207.      
  208.     word_processor_command_string_length : integer ;
  209.        
  210.     word_processor_command_string : string ( 1 .. max_wp_command_length ) ;
  211.        
  212.   end;
  213.      
  214.   end crt_customization ;
  215.     
  216.   package body crt_customization is 
  217.     
  218.   package body CRT is
  219.          
  220.     procedure GOTOXY( COL : in A_SCREEN_COLUMN_NUMBER ; 
  221.                       LINE : in A_SCREEN_LINE_NUMBER ) is
  222.       A_COL, A_LINE : NATURAL;
  223.     begin
  224.       A_COL := COL ;
  225.       A_LINE := LINE ;
  226.       if A_COL > TOTAL_CRT_COL then
  227.         A_COL := TOTAL_CRT_COL ;
  228.       end if;
  229.       if A_LINE > TOTAL_CRT_LINE then
  230.         A_LINE := TOTAL_CRT_LINE ;
  231.       end if;
  232.       CRT_COL := A_COL ;
  233.       CRT_LINE := A_LINE ;
  234.       put_transparent(ASCII.ESC);
  235.       put_transparent("[");
  236.       put_transparent(A_LINE);
  237.       put_transparent(';');
  238.       put_transparent(A_COL);
  239.       put_transparent('H');
  240.     end;
  241.      
  242.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN is
  243.       ok : BOOLEAN ;
  244.     begin
  245.       case CONTROL is
  246.         when COLD_INIT          => ok := TRUE   ;  -- Required
  247.         when WARM_INIT          => ok := TRUE   ;  -- Required
  248.         when ERASE_ALL          => ok := TRUE   ;  -- Required
  249.         when ERASE_EOL          => ok := TRUE   ;
  250.         when ERASE_EOS          => ok := TRUE   ;
  251.         when INSERT_LINE        => ok := FALSE  ;
  252.         when DELETE_LINE        => ok := FALSE  ;
  253.         when CRT_HOME           => ok := TRUE   ;  -- Required
  254.         when CRT_UP             => ok := TRUE   ;
  255.         when CRT_DOWN           => ok := TRUE   ;
  256.         when CRT_RIGHT          => ok := TRUE   ;
  257.         when CRT_LEFT           => ok := TRUE   ;
  258.         when REVERSE_VIDEO      => ok := TRUE   ;
  259.         when scroll_middle_screen_up    => ok := false  ;
  260.         when scroll_entire_screen_up    => ok := true   ;  -- required
  261.         when scroll_partial_screen_up   => ok := false  ;
  262.         when scroll_middle_screen_down  => ok := false  ;
  263.         when scroll_entire_screen_down  => ok := false  ;
  264.         when scroll_partial_screen_down => ok := false  ;
  265.         when CURSOR_ON          => ok := FALSE   ;
  266.         when CURSOR_OFF         => ok := FALSE   ;
  267.         when EXTRA_DISPLAY_ON   => ok := FALSE   ;
  268.         when EXTRA_DISPLAY_OFF  => ok := FALSE   ;
  269.         when KEYBOARD_INPUT_ON  => ok := FALSE   ;
  270.         when KEYBOARD_INPUT_OFF => ok := FALSE   ;
  271.         when PROGRAM_TERMINATION=> ok := TRUE   ;  -- Required
  272.       end case;
  273.       return ok ;
  274.     end;
  275.          
  276.     procedure new_attributes(new_text_color , 
  277.                              new_background_color : crt_color;
  278.            new_crt_atr_1  , new_crt_atr_2 , new_crt_atr_3 : char_attributes) is
  279.       screen_color : crt_color ;
  280.          
  281.       procedure new_attr( atr : char_attributes ) is
  282.       begin
  283.         case atr is
  284.           when other_intensity => put_transparent("1;"); 
  285.           when blink           => put_transparent("5;");
  286.           when underline       => null ;
  287.           when normal          => null ; -- No need to do anything...
  288.         end case;
  289.       end;
  290.            
  291.     begin
  292.       -- First, turn off all old settings
  293.       put_transparent(ASCII.ESC);
  294.       put_transparent("[0m");
  295.       -- Now, remember the new settings
  296.       CRT_ATTRIBUTE_1 := new_crt_atr_1 ;
  297.       CRT_ATTRIBUTE_2 := new_crt_atr_2 ;
  298.       CRT_ATTRIBUTE_3 := new_crt_atr_3 ;
  299.       CURRENT_CRT_COLOR := new_text_color ;
  300.       CURRENT_BACKGROUND_COLOR := new_background_color ;
  301.       -- Now, do the new attribute settings
  302.       put_transparent(ASCII.ESC);
  303.       put_transparent("[");
  304.       new_attr(crt_attribute_1);
  305.       new_attr(crt_attribute_2);
  306.       new_attr(crt_attribute_3);
  307.       -- Now, see if this is reverse video...
  308.       if ( current_background_color /= black )
  309.       and ( current_crt_color = black ) then
  310.         put_transparent("7;");
  311.         screen_color := current_background_color;
  312.       else
  313.         screen_color := current_crt_color;
  314.       end if;
  315.       -- Finally, do the color settings
  316.       case screen_color is
  317.         when black      => put_transparent("30m");
  318.         when red        => put_transparent("31m");
  319.         when blue       => put_transparent("34m");
  320.         when purple     => put_transparent("35m"); -- magenta
  321.         when green      => put_transparent("32m");
  322.         when yellow     => put_transparent("33m");
  323.         when light_blue => put_transparent("36m"); -- cyan
  324.         when white      => put_transparent("37m");
  325.       end case ;
  326.     end;
  327.          
  328.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  329.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  330.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL ) is
  331.     begin
  332.       new_attributes( current_crt_color , current_background_color ,
  333.                       to , also , and_also );
  334.     end;
  335.          
  336.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  337.                             BACKGROUND_COLOR : in CRT_COLOR := black) is
  338.     begin
  339.       new_attributes( text_color , background_color ,
  340.                       crt_attribute_1 , crt_attribute_2 , crt_attribute_3 );
  341.     end;
  342.          
  343.     procedure KEYBOARD_INITIALIZE;
  344.          
  345.     procedure DO_CRT( CONTROL : in CRT_CONTROL ) is
  346.     begin
  347.       case CONTROL is
  348.         when COLD_INIT    => TOTAL_CRT_COL := 80 ;
  349.                              TOTAL_CRT_LINE:= 24 ;
  350.                              KEYBOARD_INITIALIZE;
  351.                              DO_CRT(WARM_INIT);
  352.         when WARM_INIT    => CHANGE_CRT( NORMAL ) ;
  353.                              CHANGE_COLOR( GREEN ) ;
  354.                              DO_CRT(ERASE_ALL);
  355.                              DO_CRT(CURSOR_ON);
  356.                              DO_CRT(EXTRA_DISPLAY_ON);
  357.                              DO_CRT(KEYBOARD_INPUT_ON);
  358.         when ERASE_ALL    => put_transparent(ASCII.ESC);
  359.                              put_transparent("[" & "2J");
  360.         when ERASE_EOL    => put_transparent(ASCII.ESC);
  361.                              put_transparent("[" & "k") ;
  362.         when ERASE_EOS    => put_transparent(ASCII.ESC);
  363.                              put_transparent("[" & "0J") ; -- ????? 
  364.         when INSERT_LINE  => null ;
  365.         when DELETE_LINE  => null ;
  366.         when CRT_HOME     => GOTOXY(1,1);
  367.         when CRT_UP       => if CRT_LINE > 1 then
  368.                                CRT_LINE := CRT_LINE - 1 ;
  369.                                put_transparent(ASCII.ESC);
  370.                                put_transparent("[" & "1A");
  371.                              -- else do nothing...
  372.                              end if ;
  373.         when CRT_DOWN     => if CRT_LINE < TOTAL_CRT_LINE then
  374.                                CRT_LINE := CRT_LINE + 1 ;
  375.                                put_transparent(ASCII.ESC);
  376.                                put_transparent("[" & "1B");
  377.                              -- else do nothing...
  378.                              end if ;
  379.         when CRT_RIGHT    => if CRT_COL < TOTAL_CRT_COL then
  380.                                CRT_COL := CRT_COL + 1 ;
  381.                                put_transparent(ASCII.ESC);
  382.                                put_transparent("[" & "1C");
  383.                              -- else do nothing...
  384.                              end if ;
  385.         when CRT_LEFT     => if CRT_COL > 1 then
  386.                                CRT_COL := CRT_COL - 1 ;
  387.                                put_transparent(ASCII.ESC);
  388.                                put_transparent("[" & "1D") ;
  389.                              -- Else, we do nothing...
  390.                              end if ;
  391.         when REVERSE_VIDEO=> null ;
  392.         when scroll_middle_screen_up    => null ;  -- handled separately 
  393.         when scroll_entire_screen_up    => scroll_up_entire_screen(1);
  394.         when scroll_partial_screen_up   => null ; -- handled separately 
  395.         when scroll_middle_screen_down  => null ;  -- handled separately 
  396.         when scroll_entire_screen_down  => scroll_down_entire_screen(1);
  397.         when scroll_partial_screen_down => null ; -- handled separately 
  398.         when CURSOR_ON          => null ;
  399.         when CURSOR_OFF         => null ;
  400.         when EXTRA_DISPLAY_ON   => null ;
  401.         when EXTRA_DISPLAY_OFF  => null ;
  402.         when KEYBOARD_INPUT_ON  => null ;
  403.         when KEYBOARD_INPUT_OFF => null ;
  404.         when PROGRAM_TERMINATION=> do_crt(warm_init)          ;
  405.                                    put(" Type A Key ") ;
  406.                                    terminate_basic_io_system  ;
  407.                                    do_crt(warm_init)          ;
  408.       end case;
  409.     end;
  410.          
  411.     procedure scroll_up_middle_screen (
  412.                         first_line_to_scroll      : a_screen_line_number ;
  413.                         number_of_lines_to_scroll : a_screen_line_number ) is
  414.     begin -- scroll_up_middle_screen 
  415.       null ;
  416.     end scroll_up_middle_screen ;
  417.      
  418.     procedure scroll_up_entire_screen (
  419.                         number_of_lines_to_scroll : a_screen_line_number ) is
  420.       lines_so_far : integer := 0 ;
  421.     begin -- scroll_up_entire_screen 
  422.       gotoxy(1,total_crt_line);
  423.       loop
  424.         put_transparent( ascii.lf ) ;
  425.         lines_so_far := lines_so_far + 1 ;
  426.       exit when lines_so_far >= number_of_lines_to_scroll ;
  427.       end loop ;
  428.     end scroll_up_entire_screen ;
  429.     
  430.     procedure scroll_up_partial_screen ( 
  431.                         first_line_to_scroll      : a_screen_line_number ;
  432.                         last_line_to_scroll       : a_screen_line_number ;
  433.                         number_of_lines_to_scroll : a_screen_line_number ) is
  434.     begin -- scroll_up_partial_screen 
  435.       null ;
  436.     end scroll_up_partial_screen ;
  437.     
  438.     procedure scroll_down_middle_screen (
  439.                         last_line_to_scroll       : a_screen_line_number ;
  440.                         number_of_lines_to_scroll : a_screen_line_number ) is
  441.     begin -- scroll_down_middle_screen 
  442.       null ;
  443.     end scroll_down_middle_screen ;
  444.     
  445.     procedure scroll_down_entire_screen (
  446.                         number_of_lines_to_scroll : a_screen_line_number ) is
  447.     begin -- scroll_down_entire_screen 
  448.       null ;
  449.     end scroll_down_entire_screen ;
  450.      
  451.     procedure scroll_down_partial_screen (
  452.                         first_line_to_scroll      : a_screen_line_number ;
  453.                         last_line_to_scroll       : a_screen_line_number ;
  454.                         number_of_lines_to_scroll : a_screen_line_number ) is
  455.     begin -- scroll_down_partial_screen
  456.       null ;
  457.     end scroll_down_partial_screen ;
  458.     
  459.     function CTRL( A_CHARACTER : in CHARACTER ) return INTEGER is
  460.     begin
  461.       return CHARACTER'POS(A_CHARACTER) mod 32;   -- Strip off high bits
  462.     end;
  463.          
  464.     procedure KEYBOARD_INITIALIZE is
  465.        
  466.       procedure set_em( place:integer; c_val: integer; new_key: special_keys) is
  467.       begin -- set_em
  468.         real_key_on_input        ( place ) := extended_character ( c_val ) ;
  469.         special_meaning_on_input ( place ) := new_key ;
  470.       end set_em ;
  471.        
  472.       procedure SET_KEY_MAPPINGS is
  473.       begin
  474.         -- First, do the normal mappings
  475.         for C_NUMBER in 0..255 loop
  476.           set_em ( c_number , c_number , key_character ) ;
  477.         end loop;
  478.         -- Then, change the characters which are to be treated specially...
  479.         set_em ( ctrl('A') , 0 , key_up              ) ;
  480.         set_em ( ctrl('B') , 0 , key_down            ) ;
  481.         set_em ( ctrl('F') , 0 , key_right           ) ;
  482.         set_em ( ctrl('D') , 0 , key_left            ) ;
  483.         set_em ( ctrl('E') , 0 , key_home            ) ;
  484.         --
  485.         set_em ( ctrl('V') , 0 , key_end_of_text     ) ;
  486.         set_em ( 27        , 0 , key_escape          ) ;
  487.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ; 
  488.         set_em ( ctrl('H') , 0 , key_backspace       ) ;
  489.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  490.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  491.         set_em ( 127       , 0 , key_delete          ) ;
  492.       end;
  493.            
  494.       procedure SET_MEMORY_FUNCTION_KEYS is
  495.       begin
  496.         put_transparent(ascii.esc)        ;
  497.         put_transparent("[0;72;01;p")     ; -- Cursor Up to control A
  498.         put_transparent(ascii.esc)        ;
  499.         put_transparent("[0;80;02;p")     ; -- Cursor Down to control B
  500.         put_transparent(ascii.esc)        ;
  501.         put_transparent("[0;77;06;p")     ; -- Cursor Right to control F
  502.         put_transparent(ascii.esc)        ;
  503.         put_transparent("[0;75;04;p")     ; -- Cursor Left to control D
  504.         put_transparent(ascii.esc)        ;
  505.         put_transparent("[0;71;05;p")     ; -- Home to control E
  506.         put_transparent(ascii.esc)        ;
  507.         put_transparent("[0;59;27;97;p")  ; -- F1 to a
  508.         put_transparent(ascii.esc)        ;
  509.         put_transparent("[0;60;27;98;p")  ; -- F2 to b
  510.         put_transparent(ascii.esc)        ;
  511.         put_transparent("[0;61;27;99;p")  ; -- F3 to c
  512.         put_transparent(ascii.esc)        ;
  513.         put_transparent("[0;62;27;100;p") ; -- F4 to d
  514.         put_transparent(ascii.esc)        ;
  515.         put_transparent("[0;63;27;101;p") ; -- F5 to e
  516.         put_transparent(ascii.esc)        ;
  517.         put_transparent("[0;64;27;102;p") ; -- F6 to f
  518.         put_transparent(ascii.esc)        ;
  519.         put_transparent("[0;65;27;103;p") ; -- F7 to g
  520.         put_transparent(ascii.esc)        ;
  521.         put_transparent("[0;66;27;104;p") ; -- F8 to h
  522.         put_transparent(ascii.esc)        ;
  523.         put_transparent("[0;67;27;105;p") ; -- F9 to i
  524.         put_transparent(ascii.esc)        ;
  525.         put_transparent("[0;68;27;106;p") ; -- F10 to j
  526.         put_transparent(ascii.esc)        ;
  527.         put_transparent("[0;73;27;107;p") ; -- Page Up to k
  528.         put_transparent(ascii.esc)        ;
  529.         put_transparent("[0;79;27;108;p") ; -- End to 1
  530.         put_transparent(ascii.esc)        ;
  531.         put_transparent("[0;81;27;109;p") ; -- Page Down to m
  532.         put_transparent(ascii.esc)        ;
  533.         put_transparent("[0;82;27;110;p") ; -- INS to n
  534.         put_transparent(ascii.esc)        ;
  535.         put_transparent("[0;83;27;111;p") ; -- DEL to o
  536.         put_transparent(ascii.esc)        ;
  537. end;
  538.  
  539.       procedure MAP_FUNCTION_KEYS is
  540.          
  541.         function make_key( in_character : in character ;
  542.                            out_meaning  : in special_keys ;    
  543.                            out_character: in integer ) 
  544.                                        return type_of_key_change is
  545.           t : type_of_key_change ;
  546.         begin
  547.           t.key := extended_character( CHARACTER'POS( in_character ) ) ;
  548.           t.special_meaning := out_meaning ;
  549.           t.final_key := extended_character( out_character ) ;
  550.           return t;
  551.         end;
  552.              
  553.       begin
  554.         -- Initialize to nothing...
  555.         for A_KEY_TYPE in 1..NUM_KEY_TYPES loop
  556.           KEY_MAP(A_KEY_TYPE).LEAD_IN_LENGTH := 0 ;
  557.           KEY_MAP(A_KEY_TYPE).LEAD_IN        := "     ";
  558.           KEY_MAP(A_KEY_TYPE).FOLLOW_REMOVE  := 0 ;
  559.           for A_SINGLE_KEY in 1..NUM_KEYS_WITHIN_TYPE loop
  560.             KEY_MAP(A_KEY_TYPE).EACH_KEY(A_SINGLE_KEY)   
  561.                             := make_key( CHARACTER'VAL(0) , key_illegal , 0 );
  562.           end loop;
  563.         end loop;
  564.         KEY_MAP(1).LEAD_IN_LENGTH := 0 ;
  565.         KEY_MAP(1).FOLLOW_REMOVE  := 0 ;
  566.         KEY_MAP(1).EACH_KEY(01) := make_key('a',key_function,1);
  567.         KEY_MAP(1).EACH_KEY(02) := make_key('b',key_function,2);
  568.         KEY_MAP(1).EACH_KEY(03) := make_key('c',key_function,3);
  569.         KEY_MAP(1).EACH_KEY(04) := make_key('d',key_function,4) ;
  570.         KEY_MAP(1).EACH_KEY(05) := make_key('e',key_function,5) ;
  571.         KEY_MAP(1).EACH_KEY(06) := make_key('e',key_function,6) ;
  572.         KEY_MAP(1).EACH_KEY(07) := make_key('e',key_function,7) ;
  573.         KEY_MAP(1).EACH_KEY(08) := make_key('e',key_function,8) ;
  574.         KEY_MAP(1).EACH_KEY(09) := make_key('e',key_function,9) ;
  575.         KEY_MAP(1).EACH_KEY(10) := make_key('e',key_function,10);
  576.         KEY_MAP(1).EACH_KEY(11) := make_key('f',key_function,11);
  577.         KEY_MAP(1).EACH_KEY(12) := make_key('g',key_function,12) ;
  578.         KEY_MAP(2).LEAD_IN_LENGTH := 0 ;
  579.         KEY_MAP(2).FOLLOW_REMOVE  := 0 ;
  580.         KEY_MAP(2).EACH_KEY(01) := make_key('m',key_function,13);
  581.         KEY_MAP(2).EACH_KEY(02) := make_key('n',key_function,14);
  582.         KEY_MAP(2).EACH_KEY(03) := make_key('o',key_function,15);
  583.         key_map(3).lead_in_length := 1 ;
  584.         key_map(3).lead_in(1)     := ascii.esc ;
  585.         key_map(3).follow_remove  := 0 ;
  586.         key_map(3).each_key(01)   := make_key(ascii.esc,key_escape,0);
  587.         -- The last maps <esc><esc> to a single escape 
  588.       end;
  589.           
  590.     begin  -- Keyboard_initialize
  591.       set_key_mappings ;               -- Set up the special 1 to 1 mappings
  592.       set_memory_function_keys ;       -- Initialize the memory for fn keys
  593.       map_function_keys ;              -- ready the memory map to read keys
  594.     end KEYBOARD_INITIALIZE;
  595.          
  596.   begin -- CRT 
  597.     -- CRT      by SAIC/Clearwater IBM PC PC-DOS Routines     07 Jan 85
  598.     do_crt(cold_init);
  599.     --
  600.   end CRT;
  601.      
  602.   package body editor_customization is
  603.      
  604.     maximum_function_keys : constant integer := 10 ;
  605.     maximum_alternate_keys: constant integer := 10 ;
  606.       
  607.     type command_pair is 
  608.            record
  609.              c       : character ;
  610.              command : crt_editor_command ;
  611.            end record ;
  612.              
  613.     function_key : array ( 1 .. maximum_function_keys ) of command_pair ;
  614.     alternate_key: array ( 1 .. maximum_alternate_keys) of command_pair ;
  615.      
  616.     type a_wp_command is 
  617.            record
  618.              len : integer ;
  619.              str : string ( 1 .. max_wp_command_length ) ;
  620.            end record ;
  621.             
  622.     word_processor_command_list : array ( 1 .. 10 ) of a_wp_command     ;
  623.       
  624.     Physical_Tran : array ( crt.special_keys ) of command_pair ;
  625.       
  626.     c_to_command : array ( 0 .. 255 ) of command_pair ;
  627.       
  628.     procedure set_c ( in_char     ,
  629.                       out_char    : in character ;
  630.                       out_meaning : in crt_editor_command ) is
  631.     begin -- set_c
  632.       c_to_command( character'pos( in_char ) ) := ( out_char , out_meaning) ;
  633.     end set_c ;
  634.       
  635.     procedure initialize_translate_tables is
  636.       
  637.     use crt ;
  638.       
  639.     begin -- initialize_translate_tables
  640.       -- First , make everything Illegal 
  641.       for indx in 1 .. maximum_function_keys loop
  642.         function_key ( indx ) := ( ascii.nul , illegal_command ) ;
  643.       end loop ;
  644.       for indx in 1 .. maximum_alternate_keys loop
  645.         alternate_key ( indx ) := ( ascii.nul , illegal_command ) ;
  646.       end loop ;
  647.       for indx in crt.special_keys'first .. crt.special_keys'last loop
  648.         Physical_Tran( indx ) := ( ascii.nul , illegal_command ) ;
  649.       end loop ;
  650.       for indx in 0 .. 255 loop
  651.         c_to_command ( indx ) := ( ascii.nul , illegal_command ) ;
  652.       end loop ;
  653.       function_key ( 1 ) := ( ascii.nul   , accept_command             ) ;
  654.       function_key ( 2 ) := ( ascii.nul   , reject_command             ) ;
  655.       function_key (11 ) := ( ascii.nul   , reject_command             ) ;
  656.       function_key (12 ) := ( ascii.nul   , advance_word_command       ) ;
  657.       function_key (13 ) := ( ascii.nul   , advance_line_command       ) ;
  658.       function_key (14 ) := ( ascii.nul   , accept_command             ) ;
  659.       function_key (15 ) := ( ascii.nul   , backward_line_command      ) ;
  660.       Physical_Tran ( key_end_of_text ) := ( ascii.nul , accept_command) ;
  661.       Physical_Tran ( key_escape      ) := ( ascii.nul , reject_command) ;
  662.       Physical_Tran ( key_line_feed   ) := ( ascii.nul , down_command  ) ;
  663.       Physical_Tran ( key_carriage_return):=(ascii.nul , advance_line_command);
  664.       Physical_Tran ( key_tab_forward ) := ( ascii.nul , advance_tab_command );
  665.       Physical_Tran ( key_home        ) := ( ascii.nul , home_command  ) ;
  666.       Physical_Tran ( key_backspace   ) := ( ascii.nul , 
  667.                                                   backward_character_command ) ;
  668.       Physical_Tran ( key_up          ) := ( ascii.nul , up_command    ) ;
  669.       Physical_Tran ( key_down        ) := ( ascii.nul , down_command  ) ;
  670.       Physical_Tran ( key_right       ) := ( ascii.nul , right_command ) ;
  671.       Physical_Tran ( key_left        ) := ( ascii.nul , left_command  ) ;
  672.       Physical_Tran ( key_delete      ) := ( ascii.nul , backward_line_command);
  673.       -- Max wp command length is 20 , so initialize to that length 
  674.       for posn in 1 .. 10 loop
  675.         alternate_key(posn) := ( character'val(posn), word_processor_command ) ;
  676.       end loop ;
  677.       word_processor_command_list( 1) :=  
  678.         (  8 , ascii.cr & ".add 1"         & ascii.cr & "            "    ) ;
  679.       word_processor_command_list( 2) :=  
  680.         (  7 , ascii.cr & ".bold "                    & "             "   ) ;
  681.       word_processor_command_list( 3) :=  
  682.         (  9 , ascii.cr & ".shadow "                  & "           "     ) ;
  683.       word_processor_command_list( 4) :=  
  684.         ( 11 , ascii.cr & ".end_page"      & ascii.cr & "         "       ) ;
  685.       word_processor_command_list( 5) :=  
  686.         (  4 ,            " on"            & ascii.cr & "                ") ;
  687.       word_processor_command_list( 6) :=  
  688.         (  5 ,            " off"           & ascii.cr & "               " ) ;
  689.       word_processor_command_list( 7) :=  
  690.         (  9 , ascii.cr & ".indent "                  & "           "     ) ;
  691.       word_processor_command_list( 8) :=  
  692.         ( 12 , ascii.cr & ".underline "               & "        "        ) ;
  693.       word_processor_command_list( 9) :=  
  694.         ( 14 , ascii.cr & ".ucontinuous "             & "      "          ) ;
  695.       word_processor_command_list(10) :=  
  696.         (  1 , ascii.cr                           & "                   " ) ;
  697.         -- the last is the soft carriage return 
  698.       -- key_character is handled next
  699.       set_c ( 'A' , 'A' , adjust_command               ) ;
  700.       set_c ( 'B' , 'B' , move_to_first_line_position_command   ) ;
  701.       set_c ( 'C' , 'C' , copy_command                 ) ;
  702.       set_c ( 'D' , 'D' , start_deletion_command       ) ;
  703.       set_c ( 'E' , 'E' , move_to_last_line_position_command    ) ;
  704.       set_c ( 'F' , 'F' , find_command                 ) ;
  705.       set_c ( 'H' , 'H' , help_command                 ) ;
  706.       set_c ( 'I' , 'I' , insert_command               ) ;
  707.       set_c ( 'J' , 'J' , jump_command                 ) ;
  708.       set_c ( 'K' , 'K' , kill_command                 ) ;
  709.       set_c ( 'L' , 'L' , print_screen_command         ) ;
  710.       set_c ( 'M' , 'M' , re_margin_command            ) ;
  711.       set_c ( 'P' , 'P' , advance_page_command         ) ;
  712.       set_c ( 'Q' , 'Q' , quit_command                 ) ;
  713.       set_c ( 'R' , 'R' , replace_command              ) ;
  714.       set_c ( 'S' , 'S' , set_stuff_command            ) ;
  715.       set_c ( 'V' , 'V' , verify_screen_command        ) ;
  716.       set_c ( 'W' , 'W' , advance_word_command         ) ;
  717.       set_c ( 'X' , 'X' , enter_exchange_mode          ) ;
  718.       set_c ( 'Y' , 'Y' , advance_paragraph_command    ) ;
  719.       set_c ( 'Z' , 'Z' , zap_command                  ) ;
  720.       set_c ( 'a' , 'a' , adjust_command               ) ;
  721.       set_c ( 'b' , 'b' , move_to_first_line_position_command   ) ;
  722.       set_c ( 'c' , 'c' , copy_command                 ) ;
  723.       set_c ( 'd' , 'd' , start_deletion_command       ) ;
  724.       set_c ( 'e' , 'e' , move_to_last_line_position_command    ) ;
  725.       set_c ( 'f' , 'f' , find_command                 ) ;
  726.       set_c ( 'h' , 'h' , help_command                 ) ;
  727.       set_c ( 'i' , 'i' , insert_command               ) ;
  728.       set_c ( 'j' , 'j' , jump_command                 ) ;
  729.       set_c ( 'k' , 'k' , kill_command                 ) ;
  730.       set_c ( 'l' , 'l' , print_screen_command         ) ;
  731.       set_c ( 'm' , 'm' , re_margin_command            ) ;
  732.       set_c ( 'p' , 'p' , advance_page_command         ) ;
  733.       set_c ( 'q' , 'q' , quit_command                 ) ;
  734.       set_c ( 'r' , 'r' , replace_command              ) ;
  735.       set_c ( 's' , 's' , set_stuff_command            ) ;
  736.       set_c ( 'v' , 'v' , verify_screen_command        ) ;
  737.       set_c ( 'w' , 'w' , advance_word_command         ) ;
  738.       set_c ( 'x' , 'x' , enter_exchange_mode          ) ;
  739.       set_c ( 'y' , 'y' , advance_paragraph_command    ) ;
  740.       set_c ( 'z' , 'z' , zap_command                  ) ;
  741.       set_c ( '?' , '?' , help_command                 ) ;
  742.       set_c ( ' ' , ' ' , advance_character_command    ) ;
  743.       set_c ( ',' , ',' , set_backward_direction       ) ;
  744.       set_c ( '<' , '<' , set_backward_direction       ) ;
  745.       set_c ( '.' , '.' , set_forward_direction        ) ;
  746.       set_c ( '>' , '>' , set_forward_direction        ) ;
  747.       set_c ( '+' , '+' , shift_screen_right           ) ;
  748.       set_c ( ';' , ';' , shift_screen_right           ) ;
  749.       set_c ( '-' , '-' , shift_screen_left            ) ;
  750.       set_c ( '!' , '!' , show_other_prompt_command    ) ;
  751.       set_c ( '/' , '/' , infinity_command             ) ;
  752.       set_c ( '=' , '=' , jump_to_marked_position_command);
  753.       for cc in '0' .. '9' loop
  754.         set_c ( cc , cc , digit_command                ) ;
  755.       end loop ;
  756.       -- key_macro ( all ) is handled in the lower levels 
  757.     end initialize_translate_tables ;
  758.      
  759.     procedure initialize_prompt_lines is
  760.     begin
  761.     Main_Command_Prompt  :=
  762. " Edit: A(djst C(opy D(elete F(ind H(elp I(nsrt Q(uit R(place eX(chg '!'" ;
  763.     Alternate_Command_Prompt  :=
  764. " Edit: H(elp J(ump K(ill L(inePrntr M(argin P(age S(et V(erify Z(ap '!'" ;
  765.     Adjust_Command_Prompt:= 
  766. " Adjust: L(just R(just C(ent <left,right,up,down> [<ACCEPT> to leave]" ;
  767.     Copy_Command_Prompt  := 
  768. " Copy: B(uffer, F(ile, or <Reject> to abort ? " ;
  769.     Delete_Command_Prompt:= 
  770. " Delete: < > <Moving Commands>, <Append Toggle>, <Accept>, <Reject>  " ;
  771.     Find_Command_Prompt  := " Find: " ;
  772.     Help_Command_Prompt  := " Help: Prompt not defined...." ;
  773.     Insert_Command_Prompt:= 
  774. " Insert: Text [<bs> a char,<del> a line][<Accept> or <Reject>] " ;
  775.     Jump_Command_Prompt  := 
  776. " Jump to B(egin, E(nd, M(arker, or <Reject> to abort ? " ;
  777.     Kill_Command_Prompt  := 
  778. "!KILLING! - - Are You Really Sure You Want To Kill All Following Text "
  779.                                                                 & "(Y/N) ? " ;
  780.     Line_Printer_Command_Prompt := 
  781. "!PRINTING! - - Are You Sure You Want To Print This Screen (Y/N) ? " ;
  782.     Margin_Command_Prompt:= " " ; 
  783.     Quit_Command_Prompt  := " Quit Options:      " ;
  784.     Replace_Command_Prompt    := " Replace: " ;
  785.     Set_Command_Prompt := 
  786. " Set: E(nvironment, M(arker, T(abs, Z(ap Marker, H(elp or <Reject> ? " ;
  787.     eXchange_Command_Prompt   :=
  788. " eXchange TEXT [<bs> a char] [<reject> escapes, <accept> accepts]" ;
  789.     Zap_Command_Prompt :=
  790. " WARNING! Are you sure you wish to zap ? (y/n) " ;
  791.     Enter_Input_File_Name_Prompt:=
  792. " Enter Input File Name ( or <return> for a new file ) => " ;
  793.     Enter_Copied_In_File_Name_Prompt := 
  794. " Copy: from what file ( or <return> to skip ) => " ;
  795.     end initialize_prompt_lines ;
  796.       
  797.     procedure translate( ch            : in character          ;
  798.                          special       : in crt.special_keys   ;
  799.                          new_ch        : out character         ;
  800.                          edit_special  : out crt_editor_command ) is
  801.       -- translate an input character and special meaning pair to
  802.       -- an internal editor character representation and editor
  803.       -- special meaning pair
  804.       temp_new_ch : character ;
  805.       temp_special: crt_editor_command ;
  806.     begin -- translate
  807.       case special is
  808.         when crt.key_function  => 
  809.                if character'pos(ch) <= maximum_function_keys then
  810.                  temp_new_ch  := function_key  ( character'pos(ch) ).c       ;
  811.                  temp_special := function_key  ( character'pos(ch) ).command ;
  812.                else 
  813.                  temp_new_ch  := ascii.nul ;
  814.                  temp_special := illegal_command ;
  815.                end if ;
  816.         when crt.key_alternate =>
  817.                if character'pos(ch) <= maximum_alternate_keys then
  818.                  temp_new_ch  := alternate_key ( character'pos(ch) ).c       ;
  819.                  temp_special := alternate_key ( character'pos(ch) ).command ;
  820.                else 
  821.                  temp_new_ch  := ascii.nul ;
  822.                  temp_special := illegal_command ;
  823.                end if ;
  824.         when crt.key_character =>
  825.                  temp_new_ch  := c_to_command  ( character'pos(ch) ).c       ;
  826.                  temp_special := c_to_command  ( character'pos(ch) ).command ;
  827.         when others        =>
  828.                  temp_new_ch  := physical_tran ( special ).c       ;
  829.                  temp_special := physical_tran ( special ).command ;
  830.       end case ;
  831.       if temp_special = word_processor_command then
  832.         word_processor_command_string_length :=
  833.                   word_processor_command_list(character'pos(temp_new_ch)).len ;
  834.         word_processor_command_string        :=
  835.                   word_processor_command_list(character'pos(temp_new_ch)).str ;
  836.       end if ;
  837.       new_ch := temp_new_ch ;
  838.       edit_special := temp_special ;
  839.     end translate ;
  840.         
  841.   begin -- editor_customization
  842.     -- EDITVT10 by SAIC/Clearwater Editor Customization  VT100 07 Jan 85
  843.     initialize_translate_tables ;
  844.     initialize_prompt_lines ; -- can't put into constants at top because
  845.                               -- of initialization code limitation on wicat
  846.   end editor_customization ;
  847.   
  848.   begin -- crt_customization
  849.     -- CRTIBM by SAIC/Clearwater CRT Customization for IBM PC 07 Jan 85
  850.     null ;
  851.   end crt_customization ;
  852.   
  853.   --$$$- CRTIBM
  854.  
  855. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  856. --crtvt100
  857. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  858.  
  859.   --$$$+ CRTVT100
  860.    
  861.   -- File 003a
  862.   --
  863.   -- Editor Written By Robert S. Cymbalski
  864.   --   Science Applications International Corporation
  865.   --   Energy Systems Group
  866.   --   Ada Software Development Project Team
  867.   --   2280 U.S. Highway 19 North, Suite 120
  868.   --   Clearwater, Florida  33575
  869.   --
  870.   -- CRT Manager Revised from text Copyright (c) 1984 , R.S.Cymbalski
  871.   -- 
  872.   -- Program for CRT I/O for the VT100 in ANSI mode with 80 column screen
  873.     
  874.   with string_library   ;
  875.   use  string_library   ;
  876.    
  877.   with basic_io_system  ;
  878.   use  basic_io_system  ;
  879.    
  880.   package crt_customization is
  881.     
  882.   package CRT is
  883.          
  884.     type SPECIAL_KEYS is ( KEY_ILLEGAL, KEY_CHARACTER, KEY_END_OF_TEXT, 
  885.                            KEY_ESCAPE, KEY_TAB_FORWARD, KEY_HOME,
  886.                            KEY_LINE_FEED , KEY_CARRIAGE_RETURN ,
  887.                            KEY_TAB_BACKWARD, KEY_BACKSPACE, KEY_UP, KEY_DOWN, 
  888.                            KEY_RIGHT, KEY_LEFT, KEY_DELETE, KEY_FUNCTION,
  889.                            KEY_ALTERNATE );
  890.          
  891.     type CRT_COLOR is (BLACK,RED,BLUE,GREEN,PURPLE,YELLOW,LIGHT_BLUE,WHITE);
  892.     type CHAR_ATTRIBUTES is (NORMAL, BLINK, UNDERLINE, OTHER_INTENSITY );
  893.     type CRT_CONTROL is (COLD_INIT, WARM_INIT, ERASE_ALL, ERASE_EOL,
  894.                          ERASE_EOS, INSERT_LINE, DELETE_LINE,REVERSE_VIDEO,
  895.                          CRT_HOME, CRT_UP, CRT_DOWN, CRT_RIGHT, CRT_LEFT,
  896.                          scroll_middle_screen_up , scroll_entire_screen_up ,
  897.                          scroll_partial_screen_up ,
  898.                          scroll_middle_screen_down , scroll_entire_screen_down ,
  899.                          scroll_partial_screen_down ,
  900.                          CURSOR_ON, CURSOR_OFF, EXTRA_DISPLAY_ON,
  901.                          EXTRA_DISPLAY_OFF, KEYBOARD_INPUT_ON, 
  902.                          KEYBOARD_INPUT_OFF, PROGRAM_TERMINATION );
  903.         
  904.     CRT_ATTRIBUTE_1 : CHAR_ATTRIBUTES := NORMAL ;
  905.     CRT_ATTRIBUTE_2 : CHAR_ATTRIBUTES := NORMAL ;
  906.     CRT_ATTRIBUTE_3 : CHAR_ATTRIBUTES := NORMAL ;
  907.     CURRENT_CRT_COLOR : CRT_COLOR     := GREEN ; -- holds current color 
  908.     DEFAULT_CRT_COLOR : CRT_COLOR     := GREEN ; -- is standard I/O color
  909.     CURRENT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;
  910.     DEFAULT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;--standard background color
  911.         
  912.     NUM_KEY_TYPES : constant integer := 5 ;
  913.     NUM_KEYS_WITHIN_TYPE : constant integer := 16 ;
  914.     type type_of_key_change is record
  915.       KEY          : extended_character;
  916.       SPECIAL_MEANING: SPECIAL_KEYS ;
  917.       FINAL_KEY    : extended_character;
  918.       end record;
  919.     type ARRAY_TYPE_OF_KEY_CHANGE is 
  920.       array ( 1 .. NUM_KEYS_WITHIN_TYPE ) of type_of_key_change ;
  921.     type KEY_SET is record
  922.       LEAD_IN_LENGTH : INTEGER ;
  923.       LEAD_IN        : STRING(1 .. 5);
  924.       FOLLOW_REMOVE  : INTEGER ;
  925.       EACH_KEY       : ARRAY_TYPE_OF_KEY_CHANGE ;
  926.       end record;
  927.     type ALL_KEYS is array ( 1..NUM_KEY_TYPES ) of KEY_SET ;
  928.     KEY_MAP : ALL_KEYS;
  929.     REAL_KEY_ON_INPUT : array ( 0..255 ) of extended_character ;
  930.     SPECIAL_MEANING_ON_INPUT : array ( 0..255 ) OF SPECIAL_KEYS ;
  931.        
  932.     -- Now, we need the CRT handler routines
  933.          
  934.     procedure GOTOXY(COL : in A_SCREEN_COLUMN_NUMBER; 
  935.                      LINE : in A_SCREEN_LINE_NUMBER);
  936.        -- Positions the cursor to COL,LINE on the screen; changing COL 
  937.        -- and LINE to maximum allowable column or line if they are in error.
  938.        -- This could be done with SET_COL/SET_LINE but this is one call
  939.          
  940.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN;
  941.       -- Returns true if CRT has the ability to perform the given crt
  942.       -- control function, false otherwise.
  943.         
  944.     procedure DO_CRT( CONTROL : in CRT_CONTROL );
  945.       -- Performs the given crt control function; if the crt does not have
  946.       -- the ability to perform the crt control, nothing is done.
  947.         
  948.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  949.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  950.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL );
  951.       -- Changes the crt attributes to one, two or three new attributes
  952.           
  953.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  954.                             BACKGROUND_COLOR : in CRT_COLOR := black);
  955.       -- Changes the crt color to the new text and background colors
  956.          
  957.     procedure scroll_up_middle_screen (
  958.                         first_line_to_scroll      : a_screen_line_number ;
  959.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  960.      
  961.     procedure scroll_up_entire_screen (
  962.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  963.      
  964.     procedure scroll_up_partial_screen ( 
  965.                         first_line_to_scroll      : a_screen_line_number ;
  966.                         last_line_to_scroll       : a_screen_line_number ;
  967.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  968.      
  969.     procedure scroll_down_middle_screen (
  970.                         last_line_to_scroll       : a_screen_line_number ;
  971.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  972.      
  973.     procedure scroll_down_entire_screen (
  974.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  975.      
  976.     procedure scroll_down_partial_screen (
  977.                         first_line_to_scroll      : a_screen_line_number ;
  978.                         last_line_to_scroll       : a_screen_line_number ;
  979.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  980.      
  981.   end CRT ;
  982.        
  983.   package editor_customization is
  984.        
  985.     type crt_editor_command is ( up_command          , down_command        ,
  986.                                  right_command       , left_command        ,
  987.                                      
  988.                                 advance_character_command ,
  989.                                 advance_word_command      ,
  990.                                 advance_tab_command       ,
  991.                                 advance_line_command      ,
  992.                                 advance_paragraph_command ,
  993.                                 advance_page_command      ,
  994.                                 advance_infinity_command  ,
  995.                                  
  996.                                 forward_character_command  , 
  997.                                 backward_character_command ,
  998.                                 forward_word_command  , backward_word_command ,
  999.                                 forward_tab_command   , backward_tab_command  ,
  1000.                                 forward_line_command  , backward_line_command ,
  1001.                                 forward_paragraph_command  ,
  1002.                                 backward_paragraph_command ,
  1003.                                 forward_page_command  , backward_page_command ,
  1004.                                  
  1005.                                 home_command          ,
  1006.                                 move_to_first_line_position_command ,
  1007.                                 move_to_last_line_position_command  ,
  1008.                                 jump_to_first_position_command ,
  1009.                                 jump_to_last_position_command  ,
  1010.                                  
  1011.                                 jump_to_marked_position_command ,
  1012.                                  
  1013.                                 set_forward_direction ,
  1014.                                 set_backward_direction ,
  1015.                                      
  1016.                                 shift_screen_right  , shift_screen_left   ,
  1017.                                  
  1018.                                 adjust_command        , 
  1019.                                 copy_command          , 
  1020.                                 start_deletion_command,
  1021.                                 find_command          ,
  1022.                                 help_command          ,
  1023.                                 insert_command        ,
  1024.                                 jump_command          , 
  1025.                                 kill_command          , 
  1026.                                 print_screen_command  , 
  1027.                                 re_margin_command     ,
  1028.                                 quit_command          , 
  1029.                                 replace_command       , 
  1030.                                 set_stuff_command     ,
  1031.                                 verify_screen_command ,
  1032.                                 enter_exchange_mode   ,
  1033.                                 zap_command           , 
  1034.                                  
  1035.                                 accept_command        , 
  1036.                                 reject_command        ,
  1037.                                 word_processor_command,
  1038.                                 digit_command         ,
  1039.                                 infinity_command      ,
  1040.                                 show_other_prompt_command ,
  1041.                                 illegal_command    )  ;
  1042.        
  1043.     Main_Command_Prompt                : string (1..71) ;
  1044.     Alternate_Command_Prompt           : string (1..71) ;
  1045.     Adjust_Command_Prompt              : string (1..69) ; 
  1046.     Copy_Command_Prompt                : string (1..46) ;
  1047.     Delete_Command_Prompt              : string (1..69) ; 
  1048.     Find_Command_Prompt                : string (1.. 7) ; 
  1049.     Help_Command_Prompt                : string (1..29) ; 
  1050.     Insert_Command_Prompt              : string (1..63) ; 
  1051.     Jump_Command_Prompt                : string (1..55) ;
  1052.     Kill_Command_Prompt                : string (1..78) ; 
  1053.     Line_Printer_Command_Prompt        : string (1..66) ; 
  1054.     Margin_Command_Prompt              : string (1.. 1) ; 
  1055.     Quit_Command_Prompt                : string (1..20) ;
  1056.     Replace_Command_Prompt             : string (1..10) ; 
  1057.     Set_Command_Prompt                 : string (1..69) ; 
  1058.     eXchange_Command_Prompt            : string (1..65) ;
  1059.     Zap_Command_Prompt                 : string (1..47) ;
  1060.     Enter_Input_File_Name_Prompt       : string (1..57) ;
  1061.     Enter_Copied_In_File_Name_Prompt   : string (1..49) ; 
  1062.       
  1063.     procedure translate( ch            : in character          ;
  1064.                          special       : in crt.special_keys   ;
  1065.                          new_ch        : out character         ;
  1066.                          edit_special  : out crt_editor_command ) ;
  1067.       -- translate an input character and special meaning pair to
  1068.       -- an internal editor character representation and editor
  1069.       -- special meaning pair
  1070.         
  1071.     max_wp_command_length : constant integer := 20 ;
  1072.      
  1073.     word_processor_command_string_length : integer ;
  1074.       -- The length of the word processor command string for the 
  1075.       -- key just pressed
  1076.        
  1077.     word_processor_command_string : string ( 1 .. max_wp_command_length ) ;
  1078.       -- The string of characters associated with the function key hit
  1079.       -- If the first character is ascii.cr, then start a new line at
  1080.       -- column 1.  If the length is greater than 1 and then the last 
  1081.       -- character is ascii.cr, then end by starting a new line and 
  1082.       -- indenting to the old indentation from before the command key.
  1083.       -- If the first character is a space, then, only put the space in
  1084.       -- if the last character was not a space
  1085.        
  1086.   end;
  1087.      
  1088.   end crt_customization ;
  1089.     
  1090.   package body crt_customization is 
  1091.     
  1092.   package body CRT is
  1093.          
  1094.     procedure GOTOXY( COL : in A_SCREEN_COLUMN_NUMBER ; 
  1095.                       LINE : in A_SCREEN_LINE_NUMBER ) is
  1096.       A_COL, A_LINE : NATURAL;
  1097.     begin
  1098.       A_COL := COL ;
  1099.       A_LINE := LINE ;
  1100.       if A_COL > TOTAL_CRT_COL then
  1101.         A_COL := TOTAL_CRT_COL ;
  1102.       end if;
  1103.       if A_LINE > TOTAL_CRT_LINE then
  1104.         A_LINE := TOTAL_CRT_LINE ;
  1105.       end if;
  1106.       CRT_COL := A_COL ;
  1107.       CRT_LINE := A_LINE ;
  1108.       put_transparent(ASCII.ESC);
  1109.       put_transparent("[");
  1110.       put_transparent(A_LINE);
  1111.       put_transparent(';');
  1112.       put_transparent(A_COL);
  1113.       put_transparent('H');
  1114.     end;
  1115.      
  1116.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN is
  1117.       ok : BOOLEAN ;
  1118.     begin
  1119.       case CONTROL is
  1120.         when COLD_INIT          => ok := TRUE   ;  -- Required
  1121.         when WARM_INIT          => ok := TRUE   ;  -- Required
  1122.         when ERASE_ALL          => ok := TRUE   ;  -- Required
  1123.         when ERASE_EOL          => ok := TRUE   ;
  1124.         when ERASE_EOS          => ok := TRUE   ;
  1125.         when INSERT_LINE        => ok := FALSE  ;
  1126.         when DELETE_LINE        => ok := FALSE  ;
  1127.         when REVERSE_VIDEO      => ok := TRUE   ;
  1128.         when CRT_HOME           => ok := TRUE   ;  -- Required
  1129.         when CRT_UP             => ok := TRUE   ;
  1130.         when CRT_DOWN           => ok := TRUE   ;
  1131.         when CRT_RIGHT          => ok := TRUE   ;
  1132.         when CRT_LEFT           => ok := TRUE   ;
  1133.         when scroll_middle_screen_up    => ok := true   ;
  1134.         when scroll_entire_screen_up    => ok := true   ;  -- required
  1135.         when scroll_partial_screen_up   => ok := false  ;
  1136.         when scroll_middle_screen_down  => ok := false  ;
  1137.         when scroll_entire_screen_down  => ok := false  ;
  1138.         when scroll_partial_screen_down => ok := false  ;
  1139.         when CURSOR_ON          => ok := FALSE   ;
  1140.         when CURSOR_OFF         => ok := FALSE   ;
  1141.         when EXTRA_DISPLAY_ON   => ok := FALSE   ;
  1142.         when EXTRA_DISPLAY_OFF  => ok := FALSE   ;
  1143.         when KEYBOARD_INPUT_ON  => ok := FALSE   ;
  1144.         when KEYBOARD_INPUT_OFF => ok := FALSE   ;
  1145.         when PROGRAM_TERMINATION=> ok := TRUE   ;  -- Required
  1146.       end case;
  1147.       return ok ;
  1148.     end;
  1149.          
  1150.     procedure new_attributes(new_text_color , 
  1151.                              new_background_color : crt_color;
  1152.            new_crt_atr_1  , new_crt_atr_2 , new_crt_atr_3 : char_attributes) is
  1153.       screen_color : crt_color ;
  1154.          
  1155.       procedure new_attr( atr : char_attributes ) is
  1156.       begin
  1157.         case atr is
  1158.           when other_intensity => put_transparent("7;"); 
  1159.           when blink           => put_transparent("5;");
  1160.           when underline       => put_transparent("4;");
  1161.           when normal          => null ; 
  1162.         end case;
  1163.       end;
  1164.            
  1165.     begin
  1166.       -- First, turn off all old settings
  1167.       put_transparent(ASCII.ESC);
  1168.       put_transparent("[0m");
  1169.       CRT_ATTRIBUTE_1 := new_crt_atr_1 ;
  1170.       CRT_ATTRIBUTE_2 := new_crt_atr_2 ;
  1171.       CRT_ATTRIBUTE_3 := new_crt_atr_3 ;
  1172.       CURRENT_CRT_COLOR := new_text_color ;
  1173.       CURRENT_BACKGROUND_COLOR := new_background_color ;
  1174.       put_transparent(ASCII.ESC);
  1175.       put_transparent("[");
  1176.       new_attr(crt_attribute_1);
  1177.       new_attr(crt_attribute_2);
  1178.       new_attr(crt_attribute_3);
  1179.       -- reverse video ?
  1180.       if ( current_background_color /= black )
  1181.       and ( current_crt_color = black ) then
  1182.         put_transparent("7;");
  1183.         screen_color := current_background_color;
  1184.       else
  1185.         screen_color := current_crt_color;
  1186.       end if;
  1187.       put_transparent("m");
  1188.     end;
  1189.          
  1190.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  1191.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  1192.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL ) is
  1193.     begin
  1194.       new_attributes( current_crt_color , current_background_color ,
  1195.                       to , also , and_also );
  1196.     end;
  1197.          
  1198.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  1199.                             BACKGROUND_COLOR : in CRT_COLOR := black) is
  1200.     begin
  1201.       new_attributes( text_color , background_color ,
  1202.                       crt_attribute_1 , crt_attribute_2 , crt_attribute_3 );
  1203.     end;
  1204.          
  1205.     procedure KEYBOARD_INITIALIZE;
  1206.          
  1207.     procedure DO_CRT( CONTROL : in CRT_CONTROL ) is
  1208.     begin
  1209.       case CONTROL is
  1210.         when COLD_INIT    => TOTAL_CRT_COL := 80 ;
  1211.                              TOTAL_CRT_LINE:= 24 ;
  1212.                              KEYBOARD_INITIALIZE;
  1213.                              DO_CRT(WARM_INIT);
  1214.         when WARM_INIT    => CHANGE_CRT( NORMAL ) ;
  1215.                              CHANGE_COLOR( GREEN ) ;
  1216.                              DO_CRT(ERASE_ALL);
  1217.                              DO_CRT(CURSOR_ON);
  1218.                              DO_CRT(EXTRA_DISPLAY_ON);
  1219.                              DO_CRT(KEYBOARD_INPUT_ON);
  1220.         when ERASE_ALL    => put_transparent(ASCII.ESC);
  1221.                              put_transparent("[" & "2J");
  1222.                              DO_CRT(CRT_HOME) ;  -- This is not done
  1223.                                                  -- automatically, but 
  1224.                                                  -- ERASE_ALL always 
  1225.                                                  --provides this service
  1226.         when ERASE_EOL    => put_transparent(ASCII.ESC);
  1227.                              put_transparent("[" & "0K") ;
  1228.         when ERASE_EOS    => put_transparent(ASCII.ESC);
  1229.                              put_transparent("[" & "0J") ; 
  1230.         when INSERT_LINE  => null ;
  1231.         when DELETE_LINE  => null ;
  1232.         when REVERSE_VIDEO=> null ;
  1233.         when CRT_HOME     => GOTOXY(1,1);
  1234.         when CRT_UP       => if CRT_LINE > 1 then
  1235.                                CRT_LINE := CRT_LINE - 1 ;
  1236.                                put_transparent(ASCII.ESC);
  1237.                                put_transparent("[" & "1A");
  1238.                              -- else do nothing...
  1239.                              end if ;
  1240.         when CRT_DOWN     => if CRT_LINE < TOTAL_CRT_LINE then
  1241.                                CRT_LINE := CRT_LINE + 1 ;
  1242.                                put_transparent(ASCII.ESC);
  1243.                                put_transparent("[" & "1B");
  1244.                              -- else do nothing...
  1245.                              end if ;
  1246.         when CRT_RIGHT    => if CRT_COL < TOTAL_CRT_COL then
  1247.                                CRT_COL := CRT_COL + 1 ;
  1248.                                put_transparent(ASCII.ESC);
  1249.                                put_transparent("[" & "1C");
  1250.                              -- else do nothing...
  1251.                              end if ;
  1252.         when CRT_LEFT     => if CRT_COL > 1 then
  1253.                                CRT_COL := CRT_COL - 1 ;
  1254.                                put_transparent(ASCII.ESC);
  1255.                                put_transparent("[" & "1D") ;
  1256.                              -- Else, we do nothing...
  1257.                              end if ;
  1258.         when scroll_middle_screen_up    => null ;
  1259.         when scroll_entire_screen_up    => scroll_up_entire_screen(1);
  1260.         when scroll_partial_screen_up   => null ;
  1261.         when scroll_middle_screen_down  => null ;
  1262.         when scroll_entire_screen_down  => scroll_down_entire_screen(1);
  1263.         when scroll_partial_screen_down => null ;
  1264.         when CURSOR_ON          => null ;
  1265.         when CURSOR_OFF         => null ;
  1266.         when EXTRA_DISPLAY_ON   => null ;
  1267.         when EXTRA_DISPLAY_OFF  => null ;
  1268.         when KEYBOARD_INPUT_ON  => null ;
  1269.         when KEYBOARD_INPUT_OFF => null ;
  1270.         when PROGRAM_TERMINATION=> do_crt(warm_init)   ;
  1271.                                    put(" Type A Key ") ;
  1272.                                    terminate_basic_io_system ;
  1273.                                    do_crt(warm_init)   ;
  1274.       end case;
  1275.     end;
  1276.          
  1277.     procedure scroll_up_middle_screen (
  1278.                         first_line_to_scroll      : a_screen_line_number ;
  1279.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1280.     begin -- scroll_up_middle_screen 
  1281.       gotoxy(1,first_line_to_scroll);
  1282.       put_transparent(ASCII.ESC);
  1283.       put_transparent("[");
  1284.       put_transparent(number_of_lines_to_scroll);
  1285.       put_transparent("M");
  1286.     end scroll_up_middle_screen ;
  1287.      
  1288.     procedure scroll_up_entire_screen (
  1289.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1290.       lines_so_far : integer := 0 ;
  1291.     begin -- scroll_up_entire_screen 
  1292.       gotoxy(1,total_crt_line);
  1293.       loop
  1294.         put_transparent( ascii.lf ) ;
  1295.         lines_so_far := lines_so_far + 1 ;
  1296.       exit when lines_so_far >= number_of_lines_to_scroll ;
  1297.       end loop ;
  1298.     end scroll_up_entire_screen ;
  1299.     
  1300.     procedure scroll_up_partial_screen ( 
  1301.                         first_line_to_scroll      : a_screen_line_number ;
  1302.                         last_line_to_scroll       : a_screen_line_number ;
  1303.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1304.     begin -- scroll_up_partial_screen 
  1305.       null ;
  1306.     end scroll_up_partial_screen ;
  1307.     
  1308.     procedure scroll_down_middle_screen (
  1309.                         last_line_to_scroll       : a_screen_line_number ;
  1310.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1311.     begin -- scroll_down_middle_screen 
  1312.       null ;
  1313.     end scroll_down_middle_screen ;
  1314.     
  1315.     procedure scroll_down_entire_screen (
  1316.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1317.     begin -- scroll_down_entire_screen 
  1318.       null ;
  1319.     end scroll_down_entire_screen ;
  1320.      
  1321.     procedure scroll_down_partial_screen (
  1322.                         first_line_to_scroll      : a_screen_line_number ;
  1323.                         last_line_to_scroll       : a_screen_line_number ;
  1324.                         number_of_lines_to_scroll : a_screen_line_number ) is
  1325.     begin -- scroll_down_partial_screen
  1326.       null ;
  1327.     end scroll_down_partial_screen ;
  1328.     
  1329.     -- Finally, we need the Keyboard handler routines
  1330.          
  1331.     function CTRL( A_CHARACTER : in CHARACTER ) return INTEGER is
  1332.     begin
  1333.       return CHARACTER'POS(A_CHARACTER) mod 32;   -- Strip off high bits
  1334.     end;
  1335.          
  1336.     procedure KEYBOARD_INITIALIZE is
  1337.       -- Set up for the input of special keys.
  1338.       -- Program the function keys
  1339.        
  1340.       procedure set_em( place:integer; c_val: integer; new_key: special_keys) is
  1341.       begin -- set_em
  1342.         real_key_on_input        ( place ) := extended_character ( c_val ) ;
  1343.         special_meaning_on_input ( place ) := new_key ;
  1344.       end set_em ;
  1345.        
  1346.       procedure SET_KEY_MAPPINGS is
  1347.         -- Set up the mappings of keys to new meanings
  1348.       begin
  1349.         -- First, do the normal mappings
  1350.         for C_NUMBER in 0..255 loop
  1351.           set_em ( c_number , c_number , key_character ) ;
  1352.         end loop;
  1353.         -- Then, change the characters which are to be treated specially...
  1354.         set_em ( ctrl('A') , 0 , key_home            ) ;
  1355.         set_em ( ctrl('U') , 0 , key_up              ) ;
  1356.         set_em ( ctrl('D') , 0 , key_down            ) ;
  1357.         set_em ( ctrl('R') , 0 , key_right           ) ;
  1358.         set_em ( ctrl('L') , 0 , key_left            ) ;
  1359.         set_em ( ctrl('V') , 0 , key_end_of_text     ) ;
  1360.         set_em ( 27        , 0 , key_escape          ) ;
  1361.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ; 
  1362.         set_em ( ctrl('H') , 0 , key_backspace       ) ;
  1363.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  1364.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  1365.         set_em ( 127       , 0 , key_delete          ) ;
  1366.       end;
  1367.            
  1368.       procedure MAP_FUNCTION_KEYS is
  1369.          
  1370.         function make_key( in_character : in character ;
  1371.                            out_meaning  : in special_keys ;    
  1372.                            out_character: in integer ) 
  1373.                                        return type_of_key_change is
  1374.           t : type_of_key_change ;
  1375.         begin
  1376.           t.key := extended_character( CHARACTER'POS( in_character ) ) ;
  1377.           t.special_meaning := out_meaning ;
  1378.           t.final_key := extended_character( out_character ) ;
  1379.           return t;
  1380.         end;
  1381.              
  1382.       begin
  1383.         -- Initialize 
  1384.         for A_KEY_TYPE in 1..NUM_KEY_TYPES loop
  1385.           KEY_MAP(A_KEY_TYPE).LEAD_IN_LENGTH := 0 ;
  1386.           KEY_MAP(A_KEY_TYPE).LEAD_IN        := "     ";
  1387.           KEY_MAP(A_KEY_TYPE).FOLLOW_REMOVE  := 0 ;
  1388.           for A_SINGLE_KEY in 1..NUM_KEYS_WITHIN_TYPE loop
  1389.             KEY_MAP(A_KEY_TYPE).EACH_KEY(A_SINGLE_KEY)   
  1390.                             := make_key( CHARACTER'VAL(0) , key_illegal , 0 );
  1391.           end loop;
  1392.         end loop;
  1393.         KEY_MAP(1).LEAD_IN_LENGTH := 2 ;
  1394.         KEY_MAP(1).LEAD_IN(1..2)  := " [" ; 
  1395.         KEY_MAP(1).LEAD_IN(1)     := ASCII.ESC ;
  1396.         KEY_MAP(1).FOLLOW_REMOVE  := 0 ;
  1397.         KEY_MAP(1).EACH_KEY(01) := make_key('A',KEY_UP, 0);
  1398.         KEY_MAP(1).EACH_KEY(02) := make_key('B',KEY_DOWN, 0);
  1399.         KEY_MAP(1).EACH_KEY(03) := make_key('C',KEY_RIGHT, 0);
  1400.         KEY_MAP(1).EACH_KEY(04) := make_key('D',KEY_LEFT, 0);
  1401.         KEY_MAP(2).LEAD_IN_LENGTH := 2 ;
  1402.         KEY_MAP(2).LEAD_IN(1..2)  := " O" ; 
  1403.         KEY_MAP(2).LEAD_IN(1)     := ASCII.ESC ;
  1404.         KEY_MAP(2).FOLLOW_REMOVE  := 0 ;
  1405.         KEY_MAP(2).EACH_KEY(01) := make_key('P',key_function, 1);
  1406.         KEY_MAP(2).EACH_KEY(02) := make_key('Q',key_function, 2);
  1407.         KEY_MAP(2).EACH_KEY(03) := make_key('R',key_function, 3);
  1408.         KEY_MAP(2).EACH_KEY(04) := make_key('S',key_function, 4);
  1409.         key_map(3).lead_in_length := 1 ;
  1410.         key_map(3).lead_in(1)     := ascii.esc ;
  1411.         key_map(3).follow_remove  := 0 ;
  1412.         key_map(3).each_key(01)   := make_key(ascii.esc,key_escape,0);
  1413.         -- map <esc><esc> to a single escape 
  1414.         key_map(3).each_key(02)   := make_key('1',key_alternate, 1);
  1415.         key_map(3).each_key(03)   := make_key('2',key_alternate, 2);
  1416.         key_map(3).each_key(04)   := make_key('3',key_alternate, 3);
  1417.         key_map(3).each_key(05)   := make_key('4',key_alternate, 4);
  1418.         key_map(3).each_key(06)   := make_key('5',key_alternate, 5);
  1419.         key_map(3).each_key(07)   := make_key('6',key_alternate, 6);
  1420.         key_map(3).each_key(08)   := make_key('7',key_alternate, 7);
  1421.         key_map(3).each_key(09)   := make_key('8',key_alternate, 8);
  1422.         key_map(3).each_key(10)   := make_key('9',key_alternate, 9);
  1423.         key_map(3).each_key(11)   := make_key('0',key_alternate,10);
  1424.       end;
  1425.           
  1426.     begin  -- Keyboard_initialize
  1427.       set_key_mappings ; -- Set up the special 1 to 1 mappings
  1428.       map_function_keys ; -- ready the memory map to read keys
  1429.     end KEYBOARD_INITIALIZE;
  1430.          
  1431.   begin -- CRT 
  1432.     -- CRT      by SAIC/Clearwater VT100 ANSI I/O Routines     07 Jan 85
  1433.     do_crt(cold_init);
  1434.     --
  1435.   end CRT;
  1436.      
  1437.   package body editor_customization is
  1438.      
  1439.     maximum_function_keys : constant integer := 10 ;
  1440.     maximum_alternate_keys: constant integer := 10 ;
  1441.       
  1442.     type command_pair is 
  1443.            record
  1444.              c       : character ;
  1445.              command : crt_editor_command ;
  1446.            end record ;
  1447.              
  1448.     function_key : array ( 1 .. maximum_function_keys ) of command_pair ;
  1449.     alternate_key: array ( 1 .. maximum_alternate_keys) of command_pair ;
  1450.      
  1451.     type a_wp_command is 
  1452.            record
  1453.              len : integer ;
  1454.              str : string ( 1 .. max_wp_command_length ) ;
  1455.            end record ;
  1456.             
  1457.     word_processor_command_list : array ( 1 .. 10 ) of a_wp_command     ;
  1458.       
  1459.     Physical_Tran : array ( crt.special_keys ) of command_pair ;
  1460.       
  1461.     c_to_command : array ( 0 .. 255 ) of command_pair ;
  1462.       
  1463.     procedure set_c ( in_char     ,
  1464.                       out_char    : in character ;
  1465.                       out_meaning : in crt_editor_command ) is
  1466.     begin -- set_c
  1467.       c_to_command( character'pos( in_char ) ) := ( out_char , out_meaning) ;
  1468.     end set_c ;
  1469.       
  1470.     procedure initialize_translate_tables is
  1471.       
  1472.     use crt ;
  1473.       
  1474.     begin -- initialize_translate_tables
  1475.       -- First , make everything Illegal 
  1476.       for indx in 1 .. maximum_function_keys loop
  1477.         function_key ( indx ) := ( ascii.nul , illegal_command ) ;
  1478.       end loop ;
  1479.       for indx in 1 .. maximum_alternate_keys loop
  1480.         alternate_key ( indx ) := ( ascii.nul , illegal_command ) ;
  1481.       end loop ;
  1482.       for indx in crt.special_keys'first .. crt.special_keys'last loop
  1483.         Physical_Tran( indx ) := ( ascii.nul , illegal_command ) ;
  1484.       end loop ;
  1485.       for indx in 0 .. 255 loop
  1486.         c_to_command ( indx ) := ( ascii.nul , illegal_command ) ;
  1487.       end loop ;
  1488.       -- We have 4 function keys on the VT 100 Terminal
  1489.       -- This mapping set is called when the input key type is key_function
  1490.       -- Note that we could have another set called if we needed to work
  1491.       -- with key_alternate
  1492.       function_key ( 1 ) := ( ascii.nul   , accept_command             ) ;
  1493.       function_key ( 2 ) := ( ascii.nul   , home_command               ) ;
  1494.       function_key ( 3 ) := ( ascii.nul   , advance_paragraph_command  ) ;
  1495.       function_key ( 4 ) := ( ascii.nul   , reject_command             ) ;
  1496.       -- The following is the physical to editor logical key mapping
  1497.       Physical_Tran ( key_end_of_text ) := ( ascii.nul , accept_command) ;
  1498.       Physical_Tran ( key_escape      ) := ( ascii.nul , reject_command) ;
  1499.       Physical_Tran ( key_line_feed   ) := ( ascii.nul , down_command  ) ;
  1500.       Physical_Tran ( key_carriage_return):=(ascii.nul , advance_line_command);
  1501.       Physical_Tran ( key_tab_forward ) := ( ascii.nul , advance_tab_command );
  1502.       Physical_Tran ( key_home        ) := ( ascii.nul , home_command  ) ;
  1503.       -- Physical_Tran ( key_tab_backward) := ( ascii.nul ,            ) ;
  1504.       Physical_Tran ( key_backspace   ) := ( ascii.nul , 
  1505.                                                   backward_character_command ) ;
  1506.       Physical_Tran ( key_up          ) := ( ascii.nul , up_command    ) ;
  1507.       Physical_Tran ( key_down        ) := ( ascii.nul , down_command  ) ;
  1508.       Physical_Tran ( key_right       ) := ( ascii.nul , right_command ) ;
  1509.       Physical_Tran ( key_left        ) := ( ascii.nul , left_command  ) ;
  1510.       Physical_Tran ( key_delete      ) := ( ascii.nul , backward_line_command);
  1511.       -- Max wp command length is 20 , so initialize to that length 
  1512.       for posn in 1 .. 10 loop
  1513.         alternate_key(posn) := ( character'val(posn), word_processor_command ) ;
  1514.       end loop ;
  1515.       word_processor_command_list( 1) :=  
  1516.         (  8 , ascii.cr & ".add 1"         & ascii.cr & "            "    ) ;
  1517.       word_processor_command_list( 2) :=  
  1518.         (  7 , ascii.cr & ".bold "                    & "             "   ) ;
  1519.       word_processor_command_list( 3) :=  
  1520.         (  9 , ascii.cr & ".shadow "                  & "           "     ) ;
  1521.       word_processor_command_list( 4) :=  
  1522.         ( 11 , ascii.cr & ".end_page"      & ascii.cr & "         "       ) ;
  1523.       word_processor_command_list( 5) :=  
  1524.         (  4 ,            " on"            & ascii.cr & "                ") ;
  1525.       word_processor_command_list( 6) :=  
  1526.         (  5 ,            " off"           & ascii.cr & "               " ) ;
  1527.       word_processor_command_list( 7) :=  
  1528.         (  9 , ascii.cr & ".indent "                  & "           "     ) ;
  1529.       word_processor_command_list( 8) :=  
  1530.         ( 12 , ascii.cr & ".underline "               & "        "        ) ;
  1531.       word_processor_command_list( 9) :=  
  1532.         ( 14 , ascii.cr & ".ucontinuous "             & "      "          ) ;
  1533.       word_processor_command_list(10) :=  
  1534.         (  1 , ascii.cr                           & "                   " ) ;
  1535.         -- the last is the soft carriage return 
  1536.       -- key_character is handled next
  1537.       set_c ( 'A' , 'A' , adjust_command ) ;
  1538.       set_c ( 'B' , 'B' , move_to_first_line_position_command   ) ;
  1539.       set_c ( 'C' , 'C' , copy_command   ) ;
  1540.       set_c ( 'D' , 'D' , start_deletion_command       ) ;
  1541.       set_c ( 'E' , 'E' , move_to_last_line_position_command    ) ;
  1542.       set_c ( 'F' , 'F' , find_command   ) ;
  1543.       set_c ( 'H' , 'H' , help_command   ) ;
  1544.       set_c ( 'I' , 'I' , insert_command ) ;
  1545.       set_c ( 'J' , 'J' , jump_command   ) ;
  1546.       set_c ( 'K' , 'K' , kill_command   ) ;
  1547.       set_c ( 'L' , 'L' , print_screen_command         ) ;
  1548.       set_c ( 'M' , 'M' , re_margin_command            ) ;
  1549.       set_c ( 'P' , 'P' , advance_page_command         ) ;
  1550.       set_c ( 'Q' , 'Q' , quit_command   ) ;
  1551.       set_c ( 'R' , 'R' , replace_command              ) ;
  1552.       set_c ( 'S' , 'S' , set_stuff_command            ) ;
  1553.       set_c ( 'V' , 'V' , verify_screen_command        ) ;
  1554.       set_c ( 'W' , 'W' , advance_word_command         ) ;
  1555.       set_c ( 'X' , 'X' , enter_exchange_mode          ) ;
  1556.       set_c ( 'Y' , 'Y' , advance_paragraph_command    ) ;
  1557.       set_c ( 'Z' , 'Z' , zap_command    ) ;
  1558.       set_c ( 'a' , 'a' , adjust_command ) ;
  1559.       set_c ( 'b' , 'b' , move_to_first_line_position_command   ) ;
  1560.       set_c ( 'c' , 'c' , copy_command   ) ;
  1561.       set_c ( 'd' , 'd' , start_deletion_command       ) ;
  1562.       set_c ( 'e' , 'e' , move_to_last_line_position_command    ) ;
  1563.       set_c ( 'f' , 'f' , find_command   ) ;
  1564.       set_c ( 'h' , 'h' , help_command   ) ;
  1565.       set_c ( 'i' , 'i' , insert_command ) ;
  1566.       set_c ( 'j' , 'j' , jump_command   ) ;
  1567.       set_c ( 'k' , 'k' , kill_command   ) ;
  1568.       set_c ( 'l' , 'l' , print_screen_command         ) ;
  1569.       set_c ( 'm' , 'm' , re_margin_command            ) ;
  1570.       set_c ( 'p' , 'p' , advance_page_command         ) ;
  1571.       set_c ( 'q' , 'q' , quit_command   ) ;
  1572.       set_c ( 'r' , 'r' , replace_command              ) ;
  1573.       set_c ( 's' , 's' , set_stuff_command            ) ;
  1574.       set_c ( 'v' , 'v' , verify_screen_command        ) ;
  1575.       set_c ( 'w' , 'w' , advance_word_command         ) ;
  1576.       set_c ( 'x' , 'x' , enter_exchange_mode          ) ;
  1577.       set_c ( 'y' , 'y' , advance_paragraph_command    ) ;
  1578.       set_c ( 'z' , 'z' , zap_command    ) ;
  1579.       set_c ( '?' , '?' , help_command   ) ;
  1580.       set_c ( ' ' , ' ' , advance_character_command    ) ;
  1581.       set_c ( ',' , ',' , set_backward_direction       ) ;
  1582.       set_c ( '<' , '<' , set_backward_direction       ) ;
  1583.       set_c ( '.' , '.' , set_forward_direction        ) ;
  1584.       set_c ( '>' , '>' , set_forward_direction        ) ;
  1585.       set_c ( '+' , '+' , shift_screen_right           ) ;
  1586.       set_c ( ';' , ';' , shift_screen_right           ) ;
  1587.       set_c ( '-' , '-' , shift_screen_left            ) ;
  1588.       set_c ( '!' , '!' , show_other_prompt_command    ) ;
  1589.       set_c ( '/' , '/' , infinity_command             ) ;
  1590.       set_c ( '=' , '=' , jump_to_marked_position_command);
  1591.       for cc in '0' .. '9' loop
  1592.         set_c ( cc , cc , digit_command  ) ;
  1593.       end loop ;
  1594.       -- key_macro ( all ) is handled in the lower levels 
  1595.     end initialize_translate_tables ;
  1596.      
  1597.     procedure initialize_prompt_lines is
  1598.     begin
  1599.     Main_Command_Prompt :=
  1600. " Edit: A(djst C(opy D(elete F(ind H(elp I(nsrt Q(uit R(place eX(chg '!'" ;
  1601.     Alternate_Command_Prompt :=
  1602. " Edit: H(elp J(ump K(ill L(inePrntr M(argin P(age S(et V(erify Z(ap '!'" ;
  1603.     Adjust_Command_Prompt := 
  1604. " Adjust: L(just R(just C(ent <left,right,up,down> [<ACCEPT> to leave]" ;
  1605.     Copy_Command_Prompt := 
  1606. " Copy: B(uffer, F(ile, or <Reject> to abort ? " ;
  1607.     Delete_Command_Prompt := 
  1608. " Delete: < > <Moving Commands>, <Append Toggle>, <Accept>, <Reject>  " ;
  1609.     Find_Command_Prompt := " Find: " ;
  1610.     Help_Command_Prompt := " Help: Prompt not defined...." ;
  1611.     Insert_Command_Prompt := 
  1612. " Insert: Text [<bs> a char,<del> a line][<Accept> or <Reject>] " ;
  1613.     Jump_Command_Prompt := 
  1614. " Jump to B(egin, E(nd, M(arker, or <Reject> to abort ? " ;
  1615.     Kill_Command_Prompt := 
  1616. "!KILLING! - - Are You Really Sure You Want To Kill All Following Text "
  1617.                                                                 & "(Y/N) ? " ;
  1618.     Line_Printer_Command_Prompt := 
  1619. "!PRINTING! - - Are You Sure You Want To Print This Screen (Y/N) ? " ;
  1620.     Margin_Command_Prompt := " " ; 
  1621.     Quit_Command_Prompt := " Quit Options:      " ;
  1622.     Replace_Command_Prompt := " Replace: " ;
  1623.     Set_Command_Prompt := 
  1624. " Set: E(nvironment, M(arker, T(abs, Z(ap Marker, H(elp or <Reject> ? " ;
  1625.     eXchange_Command_Prompt :=
  1626. " eXchange TEXT [<bs> a char] [<reject> escapes, <accept> accepts]" ;
  1627.     Zap_Command_Prompt :=
  1628. " WARNING! Are you sure you wish to zap ? (y/n) " ;
  1629.     Enter_Input_File_Name_Prompt :=
  1630. " Enter Input File Name ( or <return> for a new file ) => " ;
  1631.     Enter_Copied_In_File_Name_Prompt   := 
  1632. " Copy: from what file ( or <return> to skip ) => " ;
  1633.     end initialize_prompt_lines ;
  1634.       
  1635.     procedure translate( ch            : in character          ;
  1636.                          special       : in crt.special_keys   ;
  1637.                          new_ch        : out character         ;
  1638.                          edit_special  : out crt_editor_command ) is
  1639.       -- translate an input character and special meaning pair to
  1640.       -- an internal editor character representation and editor
  1641.       -- special meaning pair
  1642.       temp_new_ch : character ;
  1643.       temp_special: crt_editor_command ;
  1644.     begin -- translate
  1645.       case special is
  1646.         when crt.key_function  => 
  1647.                if character'pos(ch) <= maximum_function_keys then
  1648.                  temp_new_ch  := function_key  ( character'pos(ch) ).c       ;
  1649.                  temp_special := function_key  ( character'pos(ch) ).command ;
  1650.                else 
  1651.                  temp_new_ch  := ascii.nul ;
  1652.                  temp_special := illegal_command ;
  1653.                end if ;
  1654.         when crt.key_alternate =>
  1655.                if character'pos(ch) <= maximum_alternate_keys then
  1656.                  temp_new_ch  := alternate_key ( character'pos(ch) ).c       ;
  1657.                  temp_special := alternate_key ( character'pos(ch) ).command ;
  1658.                else 
  1659.                  temp_new_ch  := ascii.nul ;
  1660.                  temp_special := illegal_command ;
  1661.                end if ;
  1662.         when crt.key_character =>
  1663.                  temp_new_ch  := c_to_command  ( character'pos(ch) ).c       ;
  1664.                  temp_special := c_to_command  ( character'pos(ch) ).command ;
  1665.         when others        =>
  1666.                  temp_new_ch  := physical_tran ( special ).c       ;
  1667.                  temp_special := physical_tran ( special ).command ;
  1668.       end case ;
  1669.       if temp_special = word_processor_command then
  1670.         word_processor_command_string_length :=
  1671.                   word_processor_command_list(character'pos(temp_new_ch)).len ;
  1672.         word_processor_command_string        :=
  1673.                   word_processor_command_list(character'pos(temp_new_ch)).str ;
  1674.       end if ;
  1675.       new_ch := temp_new_ch ;
  1676.       edit_special := temp_special ;
  1677.     end translate ;
  1678.         
  1679.   begin -- editor_customization
  1680.     -- EDITVT10 by SAIC/Clearwater Editor Customization  VT100 07 Jan 85
  1681.     initialize_translate_tables ;
  1682.     initialize_prompt_lines ; -- can't put into constants at top because
  1683.                               -- of initialization code limitation on wicat
  1684.   end editor_customization ;
  1685.   
  1686.   begin -- crt_customization
  1687.     -- CRTVT100 by SAIC/Clearwater CRT Customization for VT100 07 Jan 85
  1688.     null ;
  1689.   end crt_customization ;
  1690.   
  1691.   --$$$- CRTVT100
  1692.  
  1693. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1694. --crtvt52
  1695. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1696.  
  1697.   --$$$+ CRTVT52
  1698.    
  1699.   --
  1700.   -- File 003b
  1701.   --
  1702.   -- Editor Written By Robert S. Cymbalski
  1703.   --                   Science Applications International Corporation
  1704.   --                   Energy Systems Group
  1705.   --                   Ada Software Development Project Team
  1706.   --                   2280 U.S. Highway 19 North, Suite 120
  1707.   --                   Clearwater, Florida  33575
  1708.   --
  1709.   -- CRT Manager Revised from text Copyright (c) 1984 , R.S.Cymbalski
  1710.   -- 
  1711.   -- Program for CRT I/O for the VT52 
  1712.     
  1713.    
  1714.   with string_library  ;
  1715.   use  string_library  ;
  1716.    
  1717.   with basic_io_system ;
  1718.   use  basic_io_system ;
  1719.    
  1720.   package crt_customization is
  1721.     
  1722.   package CRT is
  1723.          
  1724.     type SPECIAL_KEYS is ( KEY_ILLEGAL, KEY_CHARACTER, KEY_END_OF_TEXT, 
  1725.                            KEY_ESCAPE, KEY_TAB_FORWARD, KEY_HOME,
  1726.                            KEY_LINE_FEED , KEY_CARRIAGE_RETURN ,
  1727.                            KEY_TAB_BACKWARD, KEY_BACKSPACE, KEY_UP, KEY_DOWN, 
  1728.                            KEY_RIGHT, KEY_LEFT, KEY_DELETE, KEY_FUNCTION,
  1729.                            KEY_ALTERNATE );
  1730.          
  1731.     type CRT_COLOR is (BLACK,RED,BLUE,GREEN,PURPLE,YELLOW,LIGHT_BLUE,WHITE);
  1732.     type CHAR_ATTRIBUTES is (NORMAL, BLINK, UNDERLINE, OTHER_INTENSITY );
  1733.     type CRT_CONTROL is (COLD_INIT, WARM_INIT, ERASE_ALL, ERASE_EOL,
  1734.                          ERASE_EOS, INSERT_LINE, DELETE_LINE, REVERSE_VIDEO,
  1735.                          CRT_HOME, CRT_UP, CRT_DOWN, CRT_RIGHT, CRT_LEFT,
  1736.                          scroll_middle_screen_up , scroll_entire_screen_up ,
  1737.                          scroll_partial_screen_up ,
  1738.                          scroll_middle_screen_down , scroll_entire_screen_down ,
  1739.                          scroll_partial_screen_down ,
  1740.                          CURSOR_ON, CURSOR_OFF, EXTRA_DISPLAY_ON,
  1741.                          EXTRA_DISPLAY_OFF, KEYBOARD_INPUT_ON, 
  1742.                          KEYBOARD_INPUT_OFF, PROGRAM_TERMINATION );
  1743.         
  1744.     CRT_ATTRIBUTE_1 : CHAR_ATTRIBUTES := NORMAL ;
  1745.     CRT_ATTRIBUTE_2 : CHAR_ATTRIBUTES := NORMAL ;
  1746.     CRT_ATTRIBUTE_3 : CHAR_ATTRIBUTES := NORMAL ;
  1747.         
  1748.     CURRENT_CRT_COLOR : CRT_COLOR     := GREEN ; -- holds current color 
  1749.     DEFAULT_CRT_COLOR : CRT_COLOR     := GREEN ; -- is standard I/O color
  1750.     CURRENT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;
  1751.     DEFAULT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;--standard background color
  1752.         
  1753.     NUM_KEY_TYPES : constant integer := 5 ;
  1754.     NUM_KEYS_WITHIN_TYPE : constant integer := 16 ;
  1755.     type type_of_key_change is record
  1756.       KEY          : extended_character;
  1757.       SPECIAL_MEANING: SPECIAL_KEYS ;
  1758.       FINAL_KEY    : extended_character;
  1759.       end record;
  1760.     type ARRAY_TYPE_OF_KEY_CHANGE is 
  1761.       array ( 1 .. NUM_KEYS_WITHIN_TYPE ) of type_of_key_change ;
  1762.     type KEY_SET is record
  1763.       LEAD_IN_LENGTH : INTEGER ;
  1764.       LEAD_IN        : STRING(1 .. 5);
  1765.       FOLLOW_REMOVE  : INTEGER ;
  1766.       EACH_KEY       : ARRAY_TYPE_OF_KEY_CHANGE ;
  1767.       end record;
  1768.     type ALL_KEYS is array ( 1..NUM_KEY_TYPES ) of KEY_SET ;
  1769.         
  1770.     KEY_MAP : ALL_KEYS;
  1771.     REAL_KEY_ON_INPUT : array ( 0..255 ) of extended_character ;
  1772.     SPECIAL_MEANING_ON_INPUT : array ( 0..255 ) OF SPECIAL_KEYS ;
  1773.        
  1774.     -- Now, we need the CRT handler routines
  1775.          
  1776.     procedure GOTOXY(COL : in A_SCREEN_COLUMN_NUMBER; 
  1777.                      LINE : in A_SCREEN_LINE_NUMBER);
  1778.        -- Positions the cursor to COL,LINE on the screen; changing COL 
  1779.        -- and LINE to maximum allowable column or line if they are
  1780.        -- in error.
  1781.        -- This could be done with SET_COL/SET_LINE but this is one call
  1782.          
  1783.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN;
  1784.       -- Returns true if CRT has the ability to perform the given crt
  1785.       -- control function, false otherwise.
  1786.         
  1787.     procedure DO_CRT( CONTROL : in CRT_CONTROL );
  1788.       -- Performs the given crt control function; if the crt does not have
  1789.       -- the ability to perform the crt control, nothing is done.
  1790.         
  1791.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  1792.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  1793.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL );
  1794.       -- Changes the crt attributes to one, two or three new attributes
  1795.           
  1796.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  1797.                             BACKGROUND_COLOR : in CRT_COLOR := black);
  1798.       -- Changes the crt color to the new text and background colors
  1799.          
  1800.     procedure scroll_up_middle_screen (
  1801.                         first_line_to_scroll      : a_screen_line_number ;
  1802.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1803.      
  1804.     procedure scroll_up_entire_screen (
  1805.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1806.      
  1807.     procedure scroll_up_partial_screen ( 
  1808.                         first_line_to_scroll      : a_screen_line_number ;
  1809.                         last_line_to_scroll       : a_screen_line_number ;
  1810.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1811.      
  1812.     procedure scroll_down_middle_screen (
  1813.                         last_line_to_scroll       : a_screen_line_number ;
  1814.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1815.      
  1816.     procedure scroll_down_entire_screen (
  1817.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1818.      
  1819.     procedure scroll_down_partial_screen (
  1820.                         first_line_to_scroll      : a_screen_line_number ;
  1821.                         last_line_to_scroll       : a_screen_line_number ;
  1822.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  1823.      
  1824.   end CRT ;
  1825.        
  1826.   package editor_customization is
  1827.        
  1828.     type crt_editor_command is ( up_command          , down_command        ,
  1829.                                  right_command       , left_command        ,
  1830.                                      
  1831.                                 advance_character_command ,
  1832.                                 advance_word_command      ,
  1833.                                 advance_tab_command       ,
  1834.                                 advance_line_command      ,
  1835.                                 advance_paragraph_command ,
  1836.                                 advance_page_command      ,
  1837.                                 advance_infinity_command  ,
  1838.                                  
  1839.                                 forward_character_command  , 
  1840.                                 backward_character_command ,
  1841.                                 forward_word_command  , backward_word_command ,
  1842.                                 forward_tab_command   , backward_tab_command  ,
  1843.                                 forward_line_command  , backward_line_command ,
  1844.                                 forward_paragraph_command  ,
  1845.                                 backward_paragraph_command ,
  1846.                                 forward_page_command  , backward_page_command ,
  1847.                                  
  1848.                                 home_command          ,
  1849.                                 move_to_first_line_position_command ,
  1850.                                 move_to_last_line_position_command  ,
  1851.                                 jump_to_first_position_command ,
  1852.                                 jump_to_last_position_command  ,
  1853.                                  
  1854.                                 jump_to_marked_position_command ,
  1855.                                  
  1856.                                 set_forward_direction ,
  1857.                                 set_backward_direction ,
  1858.                                      
  1859.                                 shift_screen_right  , shift_screen_left   ,
  1860.                                  
  1861.                                 adjust_command        , 
  1862.                                 copy_command          , 
  1863.                                 start_deletion_command,
  1864.                                 find_command          ,
  1865.                                 help_command          ,
  1866.                                 insert_command        ,
  1867.                                 jump_command          , 
  1868.                                 kill_command          , 
  1869.                                 print_screen_command  , 
  1870.                                 re_margin_command     ,
  1871.                                 quit_command          , 
  1872.                                 replace_command       , 
  1873.                                 set_stuff_command     ,
  1874.                                 verify_screen_command ,
  1875.                                 enter_exchange_mode   ,
  1876.                                 zap_command           , 
  1877.                                  
  1878.                                 accept_command        , 
  1879.                                 reject_command        ,
  1880.                                 word_processor_command,
  1881.                                 digit_command         ,
  1882.                                 infinity_command      ,
  1883.                                 show_other_prompt_command ,
  1884.                                 illegal_command    )  ;
  1885.        
  1886.     Main_Command_Prompt                : string (1..71) ;
  1887.     Alternate_Command_Prompt           : string (1..71) ;
  1888.     Adjust_Command_Prompt              : string (1..69) ; 
  1889.     Copy_Command_Prompt                : string (1..46) ;
  1890.     Delete_Command_Prompt              : string (1..69) ; 
  1891.     Find_Command_Prompt                : string (1.. 7) ; 
  1892.     Help_Command_Prompt                : string (1..29) ; 
  1893.     Insert_Command_Prompt              : string (1..63) ; 
  1894.     Jump_Command_Prompt                : string (1..55) ;
  1895.     Kill_Command_Prompt                : string (1..78) ; 
  1896.     Line_Printer_Command_Prompt        : string (1..66) ; 
  1897.     Margin_Command_Prompt              : string (1.. 1) ; 
  1898.     Quit_Command_Prompt                : string (1..20) ;
  1899.     Replace_Command_Prompt             : string (1..10) ; 
  1900.     Set_Command_Prompt                 : string (1..69) ; 
  1901.     eXchange_Command_Prompt            : string (1..65) ;
  1902.     Zap_Command_Prompt                 : string (1..47) ;
  1903.     Enter_Input_File_Name_Prompt       : string (1..57) ;
  1904.     Enter_Copied_In_File_Name_Prompt   : string (1..49) ; 
  1905.       
  1906.     procedure translate( ch            : in character          ;
  1907.                          special       : in crt.special_keys   ;
  1908.                          new_ch        : out character         ;
  1909.                          edit_special  : out crt_editor_command ) ;
  1910.       -- translate an input character and special meaning pair to
  1911.       -- an internal editor character representation and editor
  1912.       -- special meaning pair
  1913.         
  1914.     max_wp_command_length : constant integer := 20 ;
  1915.      
  1916.     word_processor_command_string_length : integer ;
  1917.       -- The length of the word processor command string for the 
  1918.       -- key just pressed
  1919.        
  1920.     word_processor_command_string : string ( 1 .. max_wp_command_length ) ;
  1921.       -- The string of characters associated with the function key hit
  1922.       -- If the first character is ascii.cr, then start a new line at
  1923.       -- column 1.  If the length is greater than 1 and then the last 
  1924.       -- character is ascii.cr, then end by starting a new line and 
  1925.       -- indenting to the old indentation from before the command key.
  1926.       -- If the first character is a space, then, only put the space in
  1927.       -- if the last character was not a space
  1928.        
  1929.   end;
  1930.      
  1931.   end crt_customization ;
  1932.     
  1933.   package body crt_customization is 
  1934.     
  1935.   package body CRT is
  1936.          
  1937.     procedure GOTOXY( COL : in A_SCREEN_COLUMN_NUMBER ; 
  1938.                       LINE : in A_SCREEN_LINE_NUMBER ) is
  1939.       --  It will change the col or line if they are in error
  1940.       A_COL, A_LINE : NATURAL;
  1941.     begin
  1942.       A_COL := COL ;
  1943.       A_LINE := LINE ;
  1944.       if A_COL > TOTAL_CRT_COL then
  1945.         A_COL := TOTAL_CRT_COL ;
  1946.       end if;
  1947.       if A_LINE > TOTAL_CRT_LINE then
  1948.         A_LINE := TOTAL_CRT_LINE ;
  1949.       end if;
  1950.       CRT_COL := A_COL ;
  1951.       CRT_LINE := A_LINE ;
  1952.       put_transparent(ASCII.ESC);
  1953.       put_transparent("Y");
  1954.       put_transparent(CHARACTER'VAL(A_LINE+31));
  1955.       put_transparent(CHARACTER'VAL(A_COL+31));
  1956.     end;
  1957.      
  1958.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN is
  1959.       ok : BOOLEAN ;
  1960.     begin
  1961.       case CONTROL is
  1962.         when COLD_INIT          => ok := TRUE   ;  -- Required
  1963.         when WARM_INIT          => ok := TRUE   ;  -- Required
  1964.         when ERASE_ALL          => ok := TRUE   ;  -- Required
  1965.         when ERASE_EOL          => ok := TRUE   ;
  1966.         when ERASE_EOS          => ok := TRUE   ;
  1967.         when INSERT_LINE        => ok := FALSE  ;
  1968.         when DELETE_LINE        => ok := FALSE  ;
  1969.         when REVERSE_VIDEO      => ok := FALSE  ;
  1970.         when CRT_HOME           => ok := TRUE   ;  -- Required
  1971.         when CRT_UP             => ok := TRUE   ;
  1972.         when CRT_DOWN           => ok := TRUE   ;
  1973.         when CRT_RIGHT          => ok := TRUE   ;
  1974.         when CRT_LEFT           => ok := TRUE   ;
  1975.         when scroll_middle_screen_up    => ok := false  ;
  1976.         when scroll_entire_screen_up    => ok := true   ;  -- required
  1977.         when scroll_partial_screen_up   => ok := false  ;
  1978.         when scroll_middle_screen_down  => ok := false  ;
  1979.         when scroll_entire_screen_down  => ok := false  ;
  1980.         when scroll_partial_screen_down => ok := false  ;
  1981.         when CURSOR_ON          => ok := FALSE   ;
  1982.         when CURSOR_OFF         => ok := FALSE   ;
  1983.         when EXTRA_DISPLAY_ON   => ok := FALSE   ;
  1984.         when EXTRA_DISPLAY_OFF  => ok := FALSE   ;
  1985.         when KEYBOARD_INPUT_ON  => ok := FALSE   ;
  1986.         when KEYBOARD_INPUT_OFF => ok := FALSE   ;
  1987.         when PROGRAM_TERMINATION=> ok := TRUE   ;  -- Required
  1988.       end case;
  1989.       return ok ;
  1990.     end;
  1991.          
  1992.     procedure new_attributes(new_text_color , 
  1993.                              new_background_color : crt_color;
  1994.            new_crt_atr_1  , new_crt_atr_2 , new_crt_atr_3 : char_attributes) is
  1995.       screen_color : crt_color ;
  1996.          
  1997.     BEGIN
  1998.       NULL ;
  1999.     END ;
  2000.        
  2001.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  2002.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  2003.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL ) is
  2004.     begin
  2005.       new_attributes( current_crt_color , current_background_color ,
  2006.                       to , also , and_also );
  2007.     end;
  2008.          
  2009.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  2010.                             BACKGROUND_COLOR : in CRT_COLOR := black) is
  2011.     begin
  2012.       new_attributes( text_color , background_color ,
  2013.                       crt_attribute_1 , crt_attribute_2 , crt_attribute_3 );
  2014.     end;
  2015.          
  2016.     procedure KEYBOARD_INITIALIZE;
  2017.          
  2018.     procedure DO_CRT( CONTROL : in CRT_CONTROL ) is
  2019.     begin
  2020.       case CONTROL is
  2021.         when COLD_INIT    => TOTAL_CRT_COL := 80 ;
  2022.                              TOTAL_CRT_LINE:= 24 ;
  2023.                              KEYBOARD_INITIALIZE;
  2024.                              DO_CRT(WARM_INIT);
  2025.         when WARM_INIT    => CHANGE_CRT( NORMAL ) ;
  2026.                              CHANGE_COLOR( GREEN ) ;
  2027.                              DO_CRT(ERASE_ALL);
  2028.                              DO_CRT(CURSOR_ON);
  2029.                              DO_CRT(EXTRA_DISPLAY_ON);
  2030.                              DO_CRT(KEYBOARD_INPUT_ON);
  2031.         when ERASE_ALL    => do_crt(crt_home) ;
  2032.                              do_crt(erase_eos) ;
  2033.                              DO_CRT(CRT_HOME) ;  -- This is not done
  2034.                                                  -- automatically, but 
  2035.                                                  -- ERASE_ALL always 
  2036.                                                  --provides this service
  2037.         when ERASE_EOL    => put_transparent(ASCII.ESC);
  2038.                              put_transparent("K") ;
  2039.         when ERASE_EOS    => put_transparent(ASCII.ESC);
  2040.                              put_transparent("J") ; 
  2041.         when INSERT_LINE  => null ;
  2042.         when DELETE_LINE  => null ;
  2043.         when REVERSE_VIDEO=> null ;
  2044.         when CRT_HOME     => GOTOXY(1,1);
  2045.         when CRT_UP       => if CRT_LINE > 1 then
  2046.                                CRT_LINE := CRT_LINE - 1 ;
  2047.                                put_transparent(ASCII.ESC);
  2048.                                put_transparent("A");
  2049.                              -- else do nothing...
  2050.                              end if ;
  2051.         when CRT_DOWN     => if CRT_LINE < TOTAL_CRT_LINE then
  2052.                                CRT_LINE := CRT_LINE + 1 ;
  2053.                                put_transparent(ASCII.ESC);
  2054.                                put_transparent("B");
  2055.                              -- else do nothing...
  2056.                              end if ;
  2057.         when CRT_RIGHT    => if CRT_COL < TOTAL_CRT_COL then
  2058.                                CRT_COL := CRT_COL + 1 ;
  2059.                                put_transparent(ASCII.ESC);
  2060.                                put_transparent("C");
  2061.                              -- else do nothing...
  2062.                              end if ;
  2063.         when CRT_LEFT     => if CRT_COL > 1 then
  2064.                                CRT_COL := CRT_COL - 1 ;
  2065.                                put_transparent(ASCII.ESC);
  2066.                                put_transparent("D") ;
  2067.                              -- Else, we do nothing...
  2068.                              end if ;
  2069.         when scroll_middle_screen_up    => null ;  -- handled separately 
  2070.         when scroll_entire_screen_up    => scroll_up_entire_screen(1);
  2071.         when scroll_partial_screen_up   => null ; -- handled separately 
  2072.         when scroll_middle_screen_down  => null ;  -- handled separately 
  2073.         when scroll_entire_screen_down  => scroll_down_entire_screen(1);
  2074.         when scroll_partial_screen_down => null ; -- handled separately 
  2075.         when CURSOR_ON          => null ;
  2076.         when CURSOR_OFF         => null ;
  2077.         when EXTRA_DISPLAY_ON   => null ;
  2078.         when EXTRA_DISPLAY_OFF  => null ;
  2079.         when KEYBOARD_INPUT_ON  => null ;
  2080.         when KEYBOARD_INPUT_OFF => null ;
  2081.         when PROGRAM_TERMINATION=> do_crt(warm_init)          ;
  2082.                                    put(" Type A Key ") ;
  2083.                                    terminate_basic_io_system  ;
  2084.                                    do_crt(warm_init)          ;
  2085.       end case;
  2086.     end;
  2087.          
  2088.     procedure scroll_up_middle_screen (
  2089.                         first_line_to_scroll      : a_screen_line_number ;
  2090.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2091.     begin -- scroll_up_middle_screen 
  2092.       null ;
  2093.     end scroll_up_middle_screen ;
  2094.      
  2095.     procedure scroll_up_entire_screen (
  2096.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2097.       lines_so_far : integer := 0 ;
  2098.     begin -- scroll_up_entire_screen 
  2099.       gotoxy(1,total_crt_line);
  2100.       loop
  2101.         put_transparent( ascii.lf ) ;
  2102.         lines_so_far := lines_so_far + 1 ;
  2103.       exit when lines_so_far >= number_of_lines_to_scroll ;
  2104.       end loop ;
  2105.     end scroll_up_entire_screen ;
  2106.     
  2107.     procedure scroll_up_partial_screen ( 
  2108.                         first_line_to_scroll      : a_screen_line_number ;
  2109.                         last_line_to_scroll       : a_screen_line_number ;
  2110.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2111.     begin -- scroll_up_partial_screen 
  2112.       null ;
  2113.     end scroll_up_partial_screen ;
  2114.     
  2115.     procedure scroll_down_middle_screen (
  2116.                         last_line_to_scroll       : a_screen_line_number ;
  2117.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2118.     begin -- scroll_down_middle_screen 
  2119.       null ;
  2120.     end scroll_down_middle_screen ;
  2121.     
  2122.     procedure scroll_down_entire_screen (
  2123.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2124.     begin -- scroll_down_entire_screen 
  2125.       null ;
  2126.     end scroll_down_entire_screen ;
  2127.      
  2128.     procedure scroll_down_partial_screen (
  2129.                         first_line_to_scroll      : a_screen_line_number ;
  2130.                         last_line_to_scroll       : a_screen_line_number ;
  2131.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2132.     begin -- scroll_down_partial_screen
  2133.       null ;
  2134.     end scroll_down_partial_screen ;
  2135.     
  2136.     -- Finally, we need the Keyboard handler routines
  2137.          
  2138.     function CTRL( A_CHARACTER : in CHARACTER ) return INTEGER is
  2139.     begin
  2140.       return CHARACTER'POS(A_CHARACTER) mod 32;   -- Strip off high bits
  2141.     end;
  2142.          
  2143.     procedure KEYBOARD_INITIALIZE is
  2144.       -- Set up for the input of special keys.
  2145.       -- Program the function keys
  2146.        
  2147.       procedure set_em( place:integer; c_val: integer; new_key: special_keys) is
  2148.       begin -- set_em
  2149.         real_key_on_input        ( place ) := extended_character ( c_val ) ;
  2150.         special_meaning_on_input ( place ) := new_key ;
  2151.       end set_em ;
  2152.        
  2153.       procedure SET_KEY_MAPPINGS is
  2154.         -- Set up the mappings of keys to new meanings
  2155.       begin
  2156.         -- First, do the normal mappings
  2157.         for C_NUMBER in 0..255 loop
  2158.           set_em ( c_number , c_number , key_character ) ;
  2159.         end loop;
  2160.         -- Then, change the characters which are to be treated specially...
  2161.         set_em ( ctrl('A') , 0 , key_home            ) ;
  2162.         set_em ( ctrl('U') , 0 , key_up              ) ;
  2163.         set_em ( ctrl('D') , 0 , key_down            ) ;
  2164.         set_em ( ctrl('R') , 0 , key_right           ) ;
  2165.         set_em ( ctrl('L') , 0 , key_left            ) ;
  2166.         set_em ( ctrl('V') , 0 , key_end_of_text     ) ;
  2167.         set_em ( 27        , 0 , key_escape          ) ;
  2168.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ; 
  2169.         set_em ( ctrl('H') , 0 , key_backspace       ) ;
  2170.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  2171.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  2172.         set_em ( 127       , 0 , key_delete          ) ;
  2173.       end;
  2174.            
  2175.       procedure MAP_FUNCTION_KEYS is
  2176.          
  2177.         function make_key( in_character : in character ;
  2178.                            out_meaning  : in special_keys ;    
  2179.                            out_character: in integer ) 
  2180.                                        return type_of_key_change is
  2181.           t : type_of_key_change ;
  2182.         begin
  2183.           t.key := extended_character( CHARACTER'POS( in_character ) ) ;
  2184.           t.special_meaning := out_meaning ;
  2185.           t.final_key := extended_character( out_character ) ;
  2186.           return t;
  2187.         end;
  2188.              
  2189.       begin
  2190.         -- Initialize to nothing...
  2191.         for A_KEY_TYPE in 1..NUM_KEY_TYPES loop
  2192.           KEY_MAP(A_KEY_TYPE).LEAD_IN_LENGTH := 0 ;
  2193.           KEY_MAP(A_KEY_TYPE).LEAD_IN        := "     ";
  2194.           KEY_MAP(A_KEY_TYPE).FOLLOW_REMOVE  := 0 ;
  2195.           for A_SINGLE_KEY in 1..NUM_KEYS_WITHIN_TYPE loop
  2196.             KEY_MAP(A_KEY_TYPE).EACH_KEY(A_SINGLE_KEY)   
  2197.                             := make_key( CHARACTER'VAL(0) , key_illegal , 0 );
  2198.           end loop;
  2199.         end loop;
  2200.         KEY_MAP(1).LEAD_IN_LENGTH := 1 ;
  2201.         KEY_MAP(1).LEAD_IN(1)     := ASCII.ESC ;
  2202.         KEY_MAP(1).FOLLOW_REMOVE  := 0 ;
  2203.         KEY_MAP(1).EACH_KEY(01) := make_key('A',KEY_UP, 0);
  2204.         KEY_MAP(1).EACH_KEY(02) := make_key('B',KEY_DOWN, 0);
  2205.         KEY_MAP(1).EACH_KEY(03) := make_key('C',KEY_RIGHT, 0);
  2206.         KEY_MAP(1).EACH_KEY(04) := make_key('D',KEY_LEFT, 0);
  2207.         KEY_MAP(1).EACH_KEY(05) := make_key('P',key_function, 1);
  2208.         KEY_MAP(1).EACH_KEY(06) := make_key('Q',key_function, 2);
  2209.         KEY_MAP(1).EACH_KEY(07) := make_key('R',key_function, 3);
  2210.         KEY_MAP(1).EACH_KEY(08) := make_key('S',key_function, 4);
  2211.         key_map(1).each_key(12) := make_key(ascii.esc,key_escape,0);
  2212.         KEY_MAP(2).LEAD_IN_LENGTH := 1 ;
  2213.         KEY_MAP(2).LEAD_IN(1)     := ASCII.ESC ;
  2214.         KEY_MAP(2).FOLLOW_REMOVE  := 0 ;
  2215.         key_map(2).each_key(01)   := make_key('1',key_alternate, 1);
  2216.         key_map(2).each_key(02)   := make_key('2',key_alternate, 2);
  2217.         key_map(2).each_key(03)   := make_key('3',key_alternate, 3);
  2218.         key_map(2).each_key(04)   := make_key('4',key_alternate, 4);
  2219.         key_map(2).each_key(05)   := make_key('5',key_alternate, 5);
  2220.         key_map(2).each_key(06)   := make_key('6',key_alternate, 6);
  2221.         key_map(2).each_key(07)   := make_key('7',key_alternate, 7);
  2222.         key_map(2).each_key(08)   := make_key('8',key_alternate, 8);
  2223.         key_map(2).each_key(09)   := make_key('9',key_alternate, 9);
  2224.         key_map(2).each_key(10)   := make_key('0',key_alternate,10);
  2225.       end;
  2226.           
  2227.     begin  -- Keyboard_initialize
  2228.       set_key_mappings ;               -- Set up the special 1 to 1 mappings
  2229.       map_function_keys ;              -- ready the memory map to read keys
  2230.     end KEYBOARD_INITIALIZE;
  2231.          
  2232.   begin -- CRT 
  2233.     -- CRT      by SAIC/Clearwater VT52 ANSI I/O Routines     07 Jan 85
  2234.     do_crt(cold_init);
  2235.     --
  2236.   end CRT;
  2237.      
  2238.   package body editor_customization is
  2239.      
  2240.     maximum_function_keys : constant integer := 10 ;
  2241.     maximum_alternate_keys: constant integer := 10 ;
  2242.       
  2243.     type command_pair is 
  2244.            record
  2245.              c       : character ;
  2246.              command : crt_editor_command ;
  2247.            end record ;
  2248.              
  2249.     function_key : array ( 1 .. maximum_function_keys ) of command_pair ;
  2250.     alternate_key: array ( 1 .. maximum_alternate_keys) of command_pair ;
  2251.      
  2252.     type a_wp_command is 
  2253.            record
  2254.              len : integer ;
  2255.              str : string ( 1 .. max_wp_command_length ) ;
  2256.            end record ;
  2257.             
  2258.     word_processor_command_list : array ( 1 .. 10 ) of a_wp_command     ;
  2259.       
  2260.     Physical_Tran : array ( crt.special_keys ) of command_pair ;
  2261.       
  2262.     c_to_command : array ( 0 .. 255 ) of command_pair ;
  2263.       
  2264.     procedure set_c ( in_char     ,
  2265.                       out_char    : in character ;
  2266.                       out_meaning : in crt_editor_command ) is
  2267.     begin -- set_c
  2268.       c_to_command( character'pos( in_char ) ) := ( out_char , out_meaning) ;
  2269.     end set_c ;
  2270.       
  2271.     procedure initialize_translate_tables is
  2272.       
  2273.     use crt ;
  2274.       
  2275.     begin -- initialize_translate_tables
  2276.       -- First , make everything Illegal 
  2277.       for indx in 1 .. maximum_function_keys loop
  2278.         function_key ( indx ) := ( ascii.nul , illegal_command ) ;
  2279.       end loop ;
  2280.       for indx in 1 .. maximum_alternate_keys loop
  2281.         alternate_key ( indx ) := ( ascii.nul , illegal_command ) ;
  2282.       end loop ;
  2283.       for indx in crt.special_keys'first .. crt.special_keys'last loop
  2284.         Physical_Tran( indx ) := ( ascii.nul , illegal_command ) ;
  2285.       end loop ;
  2286.       for indx in 0 .. 255 loop
  2287.         c_to_command ( indx ) := ( ascii.nul , illegal_command ) ;
  2288.       end loop ;
  2289.       -- We have 4 function keys on the VT 100 Terminal
  2290.       -- This mapping set is called when the input key type is key_function
  2291.       -- Note that we could have another set called if we needed to work
  2292.       -- with key_alternate
  2293.       function_key ( 1 ) := ( ascii.nul   , accept_command             ) ;
  2294.       function_key ( 2 ) := ( ascii.nul   , home_command               ) ;
  2295.       function_key ( 3 ) := ( ascii.nul   , advance_paragraph_command  ) ;
  2296.       function_key ( 4 ) := ( ascii.nul   , reject_command             ) ;
  2297.       -- The following is the physical to editor logical key mapping
  2298.       Physical_Tran ( key_end_of_text ) := ( ascii.nul , accept_command) ;
  2299.       Physical_Tran ( key_escape      ) := ( ascii.nul , reject_command) ;
  2300.       Physical_Tran ( key_line_feed   ) := ( ascii.nul , down_command  ) ;
  2301.       Physical_Tran ( key_carriage_return):=(ascii.nul , advance_line_command);
  2302.       Physical_Tran ( key_tab_forward ) := ( ascii.nul , advance_tab_command );
  2303.       Physical_Tran ( key_home        ) := ( ascii.nul , home_command  ) ;
  2304.       -- Physical_Tran ( key_tab_backward) := ( ascii.nul ,            ) ;
  2305.       Physical_Tran ( key_backspace   ) := ( ascii.nul , 
  2306.                                                   backward_character_command ) ;
  2307.       Physical_Tran ( key_up          ) := ( ascii.nul , up_command    ) ;
  2308.       Physical_Tran ( key_down        ) := ( ascii.nul , down_command  ) ;
  2309.       Physical_Tran ( key_right       ) := ( ascii.nul , right_command ) ;
  2310.       Physical_Tran ( key_left        ) := ( ascii.nul , left_command  ) ;
  2311.       Physical_Tran ( key_delete      ) := ( ascii.nul , backward_line_command);
  2312.       -- Max wp command length is 20 , so initialize to that length 
  2313.       for posn in 1 .. 10 loop
  2314.         alternate_key(posn) := ( character'val(posn), word_processor_command ) ;
  2315.       end loop ;
  2316.       word_processor_command_list( 1) :=  
  2317.         (  8 , ascii.cr & ".add 1"         & ascii.cr & "            "    ) ;
  2318.       word_processor_command_list( 2) :=  
  2319.         (  7 , ascii.cr & ".bold "                    & "             "   ) ;
  2320.       word_processor_command_list( 3) :=  
  2321.         (  9 , ascii.cr & ".shadow "                  & "           "     ) ;
  2322.       word_processor_command_list( 4) :=  
  2323.         ( 11 , ascii.cr & ".end_page"      & ascii.cr & "         "       ) ;
  2324.       word_processor_command_list( 5) :=  
  2325.         (  4 ,            " on"            & ascii.cr & "                ") ;
  2326.       word_processor_command_list( 6) :=  
  2327.         (  5 ,            " off"           & ascii.cr & "               " ) ;
  2328.       word_processor_command_list( 7) :=  
  2329.         (  9 , ascii.cr & ".indent "                  & "           "     ) ;
  2330.       word_processor_command_list( 8) :=  
  2331.         ( 12 , ascii.cr & ".underline "               & "        "        ) ;
  2332.       word_processor_command_list( 9) :=  
  2333.         ( 14 , ascii.cr & ".ucontinuous "             & "      "          ) ;
  2334.       word_processor_command_list(10) :=  
  2335.         (  1 , ascii.cr                           & "                   " ) ;
  2336.         -- the last is the soft carriage return 
  2337.       -- key_character is handled next
  2338.       set_c ( 'A' , 'A' , adjust_command               ) ;
  2339.       set_c ( 'B' , 'B' , move_to_first_line_position_command   ) ;
  2340.       set_c ( 'C' , 'C' , copy_command                 ) ;
  2341.       set_c ( 'D' , 'D' , start_deletion_command       ) ;
  2342.       set_c ( 'E' , 'E' , move_to_last_line_position_command    ) ;
  2343.       set_c ( 'F' , 'F' , find_command                 ) ;
  2344.       set_c ( 'H' , 'H' , help_command                 ) ;
  2345.       set_c ( 'I' , 'I' , insert_command               ) ;
  2346.       set_c ( 'J' , 'J' , jump_command                 ) ;
  2347.       set_c ( 'K' , 'K' , kill_command                 ) ;
  2348.       set_c ( 'L' , 'L' , print_screen_command         ) ;
  2349.       set_c ( 'M' , 'M' , re_margin_command            ) ;
  2350.       set_c ( 'P' , 'P' , advance_page_command         ) ;
  2351.       set_c ( 'Q' , 'Q' , quit_command                 ) ;
  2352.       set_c ( 'R' , 'R' , replace_command              ) ;
  2353.       set_c ( 'S' , 'S' , set_stuff_command            ) ;
  2354.       set_c ( 'V' , 'V' , verify_screen_command        ) ;
  2355.       set_c ( 'W' , 'W' , advance_word_command         ) ;
  2356.       set_c ( 'X' , 'X' , enter_exchange_mode          ) ;
  2357.       set_c ( 'Y' , 'Y' , advance_paragraph_command    ) ;
  2358.       set_c ( 'Z' , 'Z' , zap_command                  ) ;
  2359.       set_c ( 'a' , 'a' , adjust_command               ) ;
  2360.       set_c ( 'b' , 'b' , move_to_first_line_position_command   ) ;
  2361.       set_c ( 'c' , 'c' , copy_command                 ) ;
  2362.       set_c ( 'd' , 'd' , start_deletion_command       ) ;
  2363.       set_c ( 'e' , 'e' , move_to_last_line_position_command    ) ;
  2364.       set_c ( 'f' , 'f' , find_command                 ) ;
  2365.       set_c ( 'h' , 'h' , help_command                 ) ;
  2366.       set_c ( 'i' , 'i' , insert_command               ) ;
  2367.       set_c ( 'j' , 'j' , jump_command                 ) ;
  2368.       set_c ( 'k' , 'k' , kill_command                 ) ;
  2369.       set_c ( 'l' , 'l' , print_screen_command         ) ;
  2370.       set_c ( 'm' , 'm' , re_margin_command            ) ;
  2371.       set_c ( 'p' , 'p' , advance_page_command         ) ;
  2372.       set_c ( 'q' , 'q' , quit_command                 ) ;
  2373.       set_c ( 'r' , 'r' , replace_command              ) ;
  2374.       set_c ( 's' , 's' , set_stuff_command            ) ;
  2375.       set_c ( 'v' , 'v' , verify_screen_command        ) ;
  2376.       set_c ( 'w' , 'w' , advance_word_command         ) ;
  2377.       set_c ( 'x' , 'x' , enter_exchange_mode          ) ;
  2378.       set_c ( 'y' , 'y' , advance_paragraph_command    ) ;
  2379.       set_c ( 'z' , 'z' , zap_command                  ) ;
  2380.       set_c ( '?' , '?' , help_command                 ) ;
  2381.       set_c ( ' ' , ' ' , advance_character_command    ) ;
  2382.       set_c ( ',' , ',' , set_backward_direction       ) ;
  2383.       set_c ( '<' , '<' , set_backward_direction       ) ;
  2384.       set_c ( '.' , '.' , set_forward_direction        ) ;
  2385.       set_c ( '>' , '>' , set_forward_direction        ) ;
  2386.       set_c ( '+' , '+' , shift_screen_right           ) ;
  2387.       set_c ( ';' , ';' , shift_screen_right           ) ;
  2388.       set_c ( '-' , '-' , shift_screen_left            ) ;
  2389.       set_c ( '!' , '!' , show_other_prompt_command    ) ;
  2390.       set_c ( '/' , '/' , infinity_command             ) ;
  2391.       set_c ( '=' , '=' , jump_to_marked_position_command);
  2392.       for cc in '0' .. '9' loop
  2393.         set_c ( cc , cc , digit_command                ) ;
  2394.       end loop ;
  2395.       -- key_macro ( all ) is handled in the lower levels 
  2396.     end initialize_translate_tables ;
  2397.      
  2398.     procedure initialize_prompt_lines is
  2399.     begin
  2400.     Main_Command_Prompt                :=
  2401. " Edit: A(djst C(opy D(elete F(ind H(elp I(nsrt Q(uit R(place eX(chg '!'" ;
  2402.     Alternate_Command_Prompt           :=
  2403. " Edit: H(elp J(ump K(ill L(inePrntr M(argin P(age S(et V(erify Z(ap '!'" ;
  2404.     Adjust_Command_Prompt              := 
  2405. " Adjust: L(just R(just C(ent <left,right,up,down> [<ACCEPT> to leave]" ;
  2406.     Copy_Command_Prompt                := 
  2407. " Copy: B(uffer, F(ile, or <Reject> to abort ? " ;
  2408.     Delete_Command_Prompt              := 
  2409. " Delete: < > <Moving Commands>, <Append Toggle>, <Accept>, <Reject>  " ;
  2410.     Find_Command_Prompt                := " Find: " ;
  2411.     Help_Command_Prompt                := " Help: Prompt not defined...." ;
  2412.     Insert_Command_Prompt              := 
  2413. " Insert: Text [<bs> a char,<del> a line][<Accept> or <Reject>] " ;
  2414.     Jump_Command_Prompt                := 
  2415. " Jump to B(egin, E(nd, M(arker, or <Reject> to abort ? " ;
  2416.     Kill_Command_Prompt                := 
  2417. "!KILLING! - - Are You Really Sure You Want To Kill All Following Text "
  2418.                                                                 & "(Y/N) ? " ;
  2419.     Line_Printer_Command_Prompt        := 
  2420. "!PRINTING! - - Are You Sure You Want To Print This Screen (Y/N) ? " ;
  2421.     Margin_Command_Prompt              := " " ; 
  2422.     Quit_Command_Prompt                := " Quit Options:      " ;
  2423.     Replace_Command_Prompt             := " Replace: " ;
  2424.     Set_Command_Prompt                 := 
  2425. " Set: E(nvironment, M(arker, T(abs, Z(ap Marker, H(elp or <Reject> ? " ;
  2426.     eXchange_Command_Prompt            :=
  2427. " eXchange TEXT [<bs> a char] [<reject> escapes, <accept> accepts]" ;
  2428.     Zap_Command_Prompt                 :=
  2429. " WARNING! Are you sure you wish to zap ? (y/n) " ;
  2430.     Enter_Input_File_Name_Prompt       :=
  2431. " Enter Input File Name ( or <return> for a new file ) => " ;
  2432.     Enter_Copied_In_File_Name_Prompt   := 
  2433. " Copy: from what file ( or <return> to skip ) => " ;
  2434.     end initialize_prompt_lines ;
  2435.       
  2436.     procedure translate( ch            : in character          ;
  2437.                          special       : in crt.special_keys   ;
  2438.                          new_ch        : out character         ;
  2439.                          edit_special  : out crt_editor_command ) is
  2440.       -- translate an input character and special meaning pair to
  2441.       -- an internal editor character representation and editor
  2442.       -- special meaning pair
  2443.       temp_new_ch : character ;
  2444.       temp_special: crt_editor_command ;
  2445.     begin -- translate
  2446.       case special is
  2447.         when crt.key_function  => 
  2448.                if character'pos(ch) <= maximum_function_keys then
  2449.                  temp_new_ch  := function_key  ( character'pos(ch) ).c       ;
  2450.                  temp_special := function_key  ( character'pos(ch) ).command ;
  2451.                else 
  2452.                  temp_new_ch  := ascii.nul ;
  2453.                  temp_special := illegal_command ;
  2454.                end if ;
  2455.         when crt.key_alternate =>
  2456.                if character'pos(ch) <= maximum_alternate_keys then
  2457.                  temp_new_ch  := alternate_key ( character'pos(ch) ).c       ;
  2458.                  temp_special := alternate_key ( character'pos(ch) ).command ;
  2459.                else 
  2460.                  temp_new_ch  := ascii.nul ;
  2461.                  temp_special := illegal_command ;
  2462.                end if ;
  2463.         when crt.key_character =>
  2464.                  temp_new_ch  := c_to_command  ( character'pos(ch) ).c       ;
  2465.                  temp_special := c_to_command  ( character'pos(ch) ).command ;
  2466.         when others        =>
  2467.                  temp_new_ch  := physical_tran ( special ).c       ;
  2468.                  temp_special := physical_tran ( special ).command ;
  2469.       end case ;
  2470.       if temp_special = word_processor_command then
  2471.         word_processor_command_string_length :=
  2472.                   word_processor_command_list(character'pos(temp_new_ch)).len ;
  2473.         word_processor_command_string        :=
  2474.                   word_processor_command_list(character'pos(temp_new_ch)).str ;
  2475.       end if ;
  2476.       new_ch := temp_new_ch ;
  2477.       edit_special := temp_special ;
  2478.     end translate ;
  2479.         
  2480.   begin -- editor_customization
  2481.     -- EDITVT10 by SAIC/Clearwater Editor Customization  VT52 07 Jan 85
  2482.     initialize_translate_tables ;
  2483.     initialize_prompt_lines ; -- can't put into constants at top because
  2484.                               -- of initialization code limitation on wicat
  2485.   end editor_customization ;
  2486.   
  2487.   begin -- crt_customization
  2488.     -- CRTVT52 by SAIC/Clearwater CRT Customization for VT52 07 Jan 85
  2489.     null ;
  2490.   end crt_customization ;
  2491.   
  2492.   --$$$- CRTVT52
  2493.  
  2494. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2495. --crtdig
  2496. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2497.  
  2498.   --$$$+ CRTDIG
  2499.    
  2500.   --
  2501.   -- File 004
  2502.   --
  2503.   -- Editor Written By Robert S. Cymbalski
  2504.   --                   Science Applications International Corporation
  2505.   --                   Energy Systems Group
  2506.   --                   Ada Software Development Project Team
  2507.   --                   2280 U.S. Highway 19 North, Suite 120
  2508.   --                   Clearwater, Florida  33575
  2509.   --
  2510.   -- CRT Manager Revised from text Copyright (c) 1984 , R.S.Cymbalski
  2511.   -- 
  2512.   -- Program for CRT I/O for the Digital Microsystem 5086 (80x24 mode)
  2513.   -- Editor Customization Package     
  2514.     
  2515.   with string_library  ;
  2516.   use  string_library  ;
  2517.    
  2518.   with basic_io_system ;
  2519.   use  basic_io_system ;
  2520.  
  2521.   package crt_customization is
  2522.     
  2523.   package CRT is
  2524.          
  2525.     type SPECIAL_KEYS is ( KEY_ILLEGAL, KEY_CHARACTER, KEY_END_OF_TEXT, 
  2526.                            KEY_ESCAPE, KEY_TAB_FORWARD, KEY_HOME,
  2527.                            KEY_LINE_FEED , KEY_CARRIAGE_RETURN ,
  2528.                            KEY_TAB_BACKWARD, KEY_BACKSPACE, KEY_UP, KEY_DOWN, 
  2529.                            KEY_RIGHT, KEY_LEFT, KEY_DELETE, KEY_FUNCTION,
  2530.                            KEY_ALTERNATE );
  2531.          
  2532.     type CRT_COLOR is (BLACK,RED,BLUE,GREEN,PURPLE,YELLOW,LIGHT_BLUE,WHITE);
  2533.     type CHAR_ATTRIBUTES is (NORMAL, BLINK, UNDERLINE, OTHER_INTENSITY );
  2534.     type CRT_CONTROL is (COLD_INIT, WARM_INIT, ERASE_ALL, ERASE_EOL,
  2535.                          ERASE_EOS, INSERT_LINE, DELETE_LINE,REVERSE_VIDEO,
  2536.                          CRT_HOME, CRT_UP, CRT_DOWN, CRT_RIGHT, CRT_LEFT,
  2537.                          scroll_middle_screen_up , scroll_entire_screen_up ,
  2538.                          scroll_partial_screen_up ,
  2539.                          scroll_middle_screen_down , scroll_entire_screen_down ,
  2540.                          scroll_partial_screen_down ,
  2541.                          CURSOR_ON, CURSOR_OFF, EXTRA_DISPLAY_ON,
  2542.                          EXTRA_DISPLAY_OFF, KEYBOARD_INPUT_ON, 
  2543.                          KEYBOARD_INPUT_OFF, PROGRAM_TERMINATION );
  2544.         
  2545.     CRT_ATTRIBUTE_1 : CHAR_ATTRIBUTES := NORMAL ;
  2546.     CRT_ATTRIBUTE_2 : CHAR_ATTRIBUTES := NORMAL ;
  2547.     CRT_ATTRIBUTE_3 : CHAR_ATTRIBUTES := NORMAL ;
  2548.         
  2549.     CURRENT_CRT_COLOR : CRT_COLOR     := GREEN ; -- holds current color 
  2550.     DEFAULT_CRT_COLOR : CRT_COLOR     := GREEN ; -- is standard I/O color
  2551.     CURRENT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;
  2552.     DEFAULT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;--standard background color
  2553.         
  2554.     NUM_KEY_TYPES : constant integer := 5 ;
  2555.     NUM_KEYS_WITHIN_TYPE : constant integer := 16 ;
  2556.     type type_of_key_change is record
  2557.       KEY          : extended_character;
  2558.       SPECIAL_MEANING: SPECIAL_KEYS ;
  2559.       FINAL_KEY    : extended_character;
  2560.       end record;
  2561.     type ARRAY_TYPE_OF_KEY_CHANGE is 
  2562.       array ( 1 .. NUM_KEYS_WITHIN_TYPE ) of type_of_key_change ;
  2563.     type KEY_SET is record
  2564.       LEAD_IN_LENGTH : INTEGER ;
  2565.       LEAD_IN        : STRING(1 .. 5);
  2566.       FOLLOW_REMOVE  : INTEGER ;
  2567.       EACH_KEY       : ARRAY_TYPE_OF_KEY_CHANGE ;
  2568.       end record;
  2569.     type ALL_KEYS is array ( 1..NUM_KEY_TYPES ) of KEY_SET ;
  2570.         
  2571.     KEY_MAP : ALL_KEYS;
  2572.     REAL_KEY_ON_INPUT : array ( 0..255 ) of extended_character ;
  2573.     SPECIAL_MEANING_ON_INPUT : array ( 0..255 ) OF SPECIAL_KEYS ;
  2574.        
  2575.     -- Now, we need the CRT handler routines
  2576.          
  2577.     procedure GOTOXY(COL : in A_SCREEN_COLUMN_NUMBER; 
  2578.                      LINE : in A_SCREEN_LINE_NUMBER);
  2579.        -- Positions the cursor to COL,LINE on the screen; changing COL 
  2580.        -- and LINE to maximum allowable column or line if they are
  2581.        -- in error.
  2582.        -- This could be done with SET_COL/SET_LINE but this is one call
  2583.          
  2584.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN;
  2585.       -- Returns true if CRT has the ability to perform the given crt
  2586.       -- control function, false otherwise.
  2587.         
  2588.     procedure DO_CRT( CONTROL : in CRT_CONTROL );
  2589.       -- Performs the given crt control function; if the crt does not have
  2590.       -- the ability to perform the crt control, nothing is done.
  2591.         
  2592.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  2593.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  2594.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL );
  2595.       -- Changes the crt attributes to one, two or three new attributes
  2596.           
  2597.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  2598.                             BACKGROUND_COLOR : in CRT_COLOR := black);
  2599.       -- Changes the crt color to the new text and background colors
  2600.          
  2601.     procedure scroll_up_middle_screen (
  2602.                         first_line_to_scroll      : a_screen_line_number ;
  2603.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2604.      
  2605.     procedure scroll_up_entire_screen (
  2606.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2607.      
  2608.     procedure scroll_up_partial_screen ( 
  2609.                         first_line_to_scroll      : a_screen_line_number ;
  2610.                         last_line_to_scroll       : a_screen_line_number ;
  2611.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2612.      
  2613.     procedure scroll_down_middle_screen (
  2614.                         last_line_to_scroll       : a_screen_line_number ;
  2615.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2616.      
  2617.     procedure scroll_down_entire_screen (
  2618.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2619.      
  2620.     procedure scroll_down_partial_screen (
  2621.                         first_line_to_scroll      : a_screen_line_number ;
  2622.                         last_line_to_scroll       : a_screen_line_number ;
  2623.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  2624.      
  2625.   end CRT ;
  2626.        
  2627.   package editor_customization is
  2628.        
  2629.     type crt_editor_command is ( up_command          , down_command        ,
  2630.                                  right_command       , left_command        ,
  2631.                                      
  2632.                                 advance_character_command ,
  2633.                                 advance_word_command      ,
  2634.                                 advance_tab_command       ,
  2635.                                 advance_line_command      ,
  2636.                                 advance_paragraph_command ,
  2637.                                 advance_page_command      ,
  2638.                                 advance_infinity_command  ,
  2639.                                  
  2640.                                 forward_character_command  , 
  2641.                                 backward_character_command ,
  2642.                                 forward_word_command  , backward_word_command ,
  2643.                                 forward_tab_command   , backward_tab_command  ,
  2644.                                 forward_line_command  , backward_line_command ,
  2645.                                 forward_paragraph_command  ,
  2646.                                 backward_paragraph_command ,
  2647.                                 forward_page_command  , backward_page_command ,
  2648.                                  
  2649.                                 home_command          ,
  2650.                                 move_to_first_line_position_command ,
  2651.                                 move_to_last_line_position_command  ,
  2652.                                 jump_to_first_position_command ,
  2653.                                 jump_to_last_position_command  ,
  2654.                                  
  2655.                                 jump_to_marked_position_command ,
  2656.                                  
  2657.                                 set_forward_direction ,
  2658.                                 set_backward_direction ,
  2659.                                      
  2660.                                 shift_screen_right  , shift_screen_left   ,
  2661.                                  
  2662.                                 adjust_command        , 
  2663.                                 copy_command          , 
  2664.                                 start_deletion_command,
  2665.                                 find_command          ,
  2666.                                 help_command          ,
  2667.                                 insert_command        ,
  2668.                                 jump_command          , 
  2669.                                 kill_command          , 
  2670.                                 print_screen_command  , 
  2671.                                 re_margin_command     ,
  2672.                                 quit_command          , 
  2673.                                 replace_command       , 
  2674.                                 set_stuff_command     ,
  2675.                                 verify_screen_command ,
  2676.                                 enter_exchange_mode   ,
  2677.                                 zap_command           , 
  2678.                                  
  2679.                                 accept_command        , 
  2680.                                 reject_command        ,
  2681.                                 word_processor_command,
  2682.                                 digit_command         ,
  2683.                                 infinity_command      ,
  2684.                                 show_other_prompt_command ,
  2685.                                 illegal_command    )  ;
  2686.        
  2687.     Main_Command_Prompt                : string (1..71) ;
  2688.     Alternate_Command_Prompt           : string (1..71) ;
  2689.     Adjust_Command_Prompt              : string (1..69) ; 
  2690.     Copy_Command_Prompt                : string (1..46) ;
  2691.     Delete_Command_Prompt              : string (1..69) ; 
  2692.     Find_Command_Prompt                : string (1.. 7) ; 
  2693.     Help_Command_Prompt                : string (1..29) ; 
  2694.     Insert_Command_Prompt              : string (1..63) ; 
  2695.     Jump_Command_Prompt                : string (1..55) ;
  2696.     Kill_Command_Prompt                : string (1..78) ; 
  2697.     Line_Printer_Command_Prompt        : string (1..66) ; 
  2698.     Margin_Command_Prompt              : string (1.. 1) ; 
  2699.     Quit_Command_Prompt                : string (1..20) ;
  2700.     Replace_Command_Prompt             : string (1..10) ; 
  2701.     Set_Command_Prompt                 : string (1..69) ; 
  2702.     eXchange_Command_Prompt            : string (1..65) ;
  2703.     Zap_Command_Prompt                 : string (1..47) ;
  2704.     Enter_Input_File_Name_Prompt       : string (1..57) ;
  2705.     Enter_Copied_In_File_Name_Prompt   : string (1..49) ; 
  2706.       
  2707.     procedure translate( ch            : in character          ;
  2708.                          special       : in crt.special_keys   ;
  2709.                          new_ch        : out character         ;
  2710.                          edit_special  : out crt_editor_command ) ;
  2711.       -- translate an input character and special meaning pair to
  2712.       -- an internal editor character representation and editor
  2713.       -- special meaning pair
  2714.         
  2715.     max_wp_command_length : constant integer := 20 ;
  2716.      
  2717.     word_processor_command_string_length : integer ;
  2718.       -- The length of the word processor command string for the 
  2719.       -- key just pressed
  2720.        
  2721.     word_processor_command_string : string ( 1 .. max_wp_command_length ) ;
  2722.       -- The string of characters associated with the function key hit
  2723.       -- If the first character is ascii.cr, then start a new line at
  2724.       -- column 1.  If the length is greater than 1 and then the last 
  2725.       -- character is ascii.cr, then end by starting a new line and 
  2726.       -- indenting to the old indentation from before the command key.
  2727.       -- If the first character is a space, then, only put the space in
  2728.       -- if the last character was not a space
  2729.        
  2730.   end;
  2731.      
  2732.   end crt_customization ;
  2733.     
  2734.   package body crt_customization is 
  2735.     
  2736.   package body CRT is
  2737.          
  2738.     procedure GOTOXY( COL : in A_SCREEN_COLUMN_NUMBER ; 
  2739.                       LINE : in A_SCREEN_LINE_NUMBER ) is
  2740.       --  It will change the col or line if they are in error
  2741.       A_COL, A_LINE : NATURAL;
  2742.     begin
  2743.       A_COL := COL ;
  2744.       A_LINE := LINE ;
  2745.       if A_COL > TOTAL_CRT_COL then
  2746.         A_COL := TOTAL_CRT_COL ;
  2747.       end if;
  2748.       if A_LINE > TOTAL_CRT_LINE then
  2749.         A_LINE := TOTAL_CRT_LINE ;
  2750.       end if;
  2751.       CRT_COL := A_COL ;
  2752.       CRT_LINE := A_LINE ;
  2753.       put_transparent(ASCII.ESC);
  2754.       put_transparent("Y");
  2755.       put_transparent(character'val(A_LINE+32));
  2756.       put_transparent(character'val(A_COL+32));
  2757.     end;
  2758.      
  2759.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN is
  2760.       ok : BOOLEAN ;
  2761.     begin
  2762.       case CONTROL is
  2763.         when COLD_INIT          => ok := TRUE   ;  -- Required
  2764.         when WARM_INIT          => ok := TRUE   ;  -- Required
  2765.         when ERASE_ALL          => ok := TRUE   ;  -- Required
  2766.         when ERASE_EOL          => ok := TRUE   ;
  2767.         when ERASE_EOS          => ok := TRUE   ;
  2768.         when INSERT_LINE        => ok := FALSE  ;
  2769.         when DELETE_LINE        => ok := FALSE  ;
  2770.         when CRT_HOME           => ok := TRUE   ;  -- Required
  2771.         when CRT_UP             => ok := TRUE   ;
  2772.         when CRT_DOWN           => ok := TRUE   ;
  2773.         when CRT_RIGHT          => ok := TRUE   ;
  2774.         when CRT_LEFT           => ok := TRUE   ;
  2775.         when REVERSE_VIDEO      => ok := FALSE  ;
  2776.         when scroll_middle_screen_up    => ok := false  ;
  2777.         when scroll_entire_screen_up    => ok := true   ;  -- required
  2778.         when scroll_partial_screen_up   => ok := false  ;
  2779.         when scroll_middle_screen_down  => ok := false  ;
  2780.         when scroll_entire_screen_down  => ok := false  ;
  2781.         when scroll_partial_screen_down => ok := false  ;
  2782.         when CURSOR_ON          => ok := FALSE   ;
  2783.         when CURSOR_OFF         => ok := FALSE   ;
  2784.         when EXTRA_DISPLAY_ON   => ok := FALSE   ;
  2785.         when EXTRA_DISPLAY_OFF  => ok := FALSE   ;
  2786.         when KEYBOARD_INPUT_ON  => ok := FALSE   ;
  2787.         when KEYBOARD_INPUT_OFF => ok := FALSE   ;
  2788.         when PROGRAM_TERMINATION=> ok := TRUE   ;  -- Required
  2789.       end case;
  2790.       return ok ;
  2791.     end;
  2792.          
  2793.     procedure new_attributes(new_text_color , 
  2794.                              new_background_color : crt_color;
  2795.            new_crt_atr_1  , new_crt_atr_2 , new_crt_atr_3 : char_attributes) is
  2796.       screen_color : crt_color ;
  2797.          
  2798.     begin
  2799.       null ;
  2800.     end;
  2801.          
  2802.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  2803.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  2804.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL ) is
  2805.     begin
  2806.       null ;
  2807.     end;
  2808.          
  2809.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  2810.                             BACKGROUND_COLOR : in CRT_COLOR := black) is
  2811.     begin
  2812.       null ;
  2813.     end;
  2814.          
  2815.     procedure KEYBOARD_INITIALIZE;
  2816.          
  2817.     function cntrl(A_CHARACTER : in CHARACTER) return CHARACTER is
  2818.     begin
  2819.       return CHARACTER'val(CHARACTER'pos(A_CHARACTER) mod 32) ;
  2820.     end;
  2821.      
  2822.     procedure DO_CRT( CONTROL : in CRT_CONTROL ) is
  2823.     begin
  2824.       case CONTROL is
  2825.         when COLD_INIT    => TOTAL_CRT_COL := 80 ;
  2826.                              TOTAL_CRT_LINE:= 24 ;
  2827.                              KEYBOARD_INITIALIZE;
  2828.                              DO_CRT(WARM_INIT);
  2829.         when WARM_INIT    => CHANGE_CRT( NORMAL ) ;
  2830.                              CHANGE_COLOR( GREEN ) ;
  2831.                              DO_CRT(ERASE_ALL);
  2832.                              DO_CRT(CURSOR_ON);
  2833.                              DO_CRT(EXTRA_DISPLAY_ON);
  2834.                              DO_CRT(KEYBOARD_INPUT_ON);
  2835.         when ERASE_ALL    => put_transparent(cntrl('L'));
  2836.         when ERASE_EOL    => put_transparent(ASCII.ESC);
  2837.                              put_transparent("K") ;
  2838.         when ERASE_EOS    => put_transparent(ASCII.ESC);
  2839.                              put_transparent("k") ;
  2840.         when INSERT_LINE  => null ;
  2841.         when DELETE_LINE  => null ;
  2842.         when CRT_HOME     => GOTOXY(1,1);
  2843.         when CRT_UP       => if CRT_LINE > 1 then
  2844.                                CRT_LINE := CRT_LINE - 1 ;
  2845.                                put_transparent(cntrl('Z'));
  2846.                              -- else do nothing...
  2847.                              end if ;
  2848.         when CRT_DOWN     => if CRT_LINE < TOTAL_CRT_LINE then
  2849.                                CRT_LINE := CRT_LINE + 1 ;
  2850.                                put_transparent(cntrl('J'));
  2851.                              -- else do nothing...
  2852.                              end if ;
  2853.         when CRT_RIGHT    => if CRT_COL < TOTAL_CRT_COL then
  2854.                                CRT_COL := CRT_COL + 1 ;
  2855.                                put_transparent(cntrl('F'));
  2856.                              -- else do nothing...
  2857.                              end if ;
  2858.         when CRT_LEFT     => if CRT_COL > 1 then
  2859.                                CRT_COL := CRT_COL - 1 ;
  2860.                                put_transparent(cntrl('H')) ;
  2861.                              -- Else, we do nothing...
  2862.                              end if ;
  2863.         when REVERSE_VIDEO=> null ;
  2864.         when scroll_middle_screen_up    => null ;  -- handled separately 
  2865.         when scroll_entire_screen_up    => scroll_up_entire_screen(1);
  2866.         when scroll_partial_screen_up   => null ; -- handled separately 
  2867.         when scroll_middle_screen_down  => null ;  -- handled separately 
  2868.         when scroll_entire_screen_down  => scroll_down_entire_screen(1);
  2869.         when scroll_partial_screen_down => null ; -- handled separately 
  2870.         when CURSOR_ON          => null ;
  2871.         when CURSOR_OFF         => null ;
  2872.         when EXTRA_DISPLAY_ON   => null ;
  2873.         when EXTRA_DISPLAY_OFF  => null ;
  2874.         when KEYBOARD_INPUT_ON  => null ;
  2875.         when KEYBOARD_INPUT_OFF => null ;
  2876.         when PROGRAM_TERMINATION=> do_crt(warm_init)          ;
  2877.                                    put(" Type A Key ") ;
  2878.                                    terminate_basic_io_system  ;
  2879.                                    do_crt(warm_init)          ;
  2880.       end case;
  2881.     end;
  2882.          
  2883.     procedure scroll_up_middle_screen (
  2884.                         first_line_to_scroll      : a_screen_line_number ;
  2885.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2886.     begin -- scroll_up_middle_screen 
  2887.       null ;
  2888.     end scroll_up_middle_screen ;
  2889.      
  2890.     procedure scroll_up_entire_screen (
  2891.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2892.       lines_so_far : integer := 0 ;
  2893.     begin -- scroll_up_entire_screen 
  2894.       gotoxy(1,total_crt_line);
  2895.       loop
  2896.         put_transparent( ascii.lf ) ;
  2897.         lines_so_far := lines_so_far + 1 ;
  2898.       exit when lines_so_far >= number_of_lines_to_scroll ;
  2899.       end loop ;
  2900.     end scroll_up_entire_screen ;
  2901.     
  2902.     procedure scroll_up_partial_screen ( 
  2903.                         first_line_to_scroll      : a_screen_line_number ;
  2904.                         last_line_to_scroll       : a_screen_line_number ;
  2905.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2906.     begin -- scroll_up_partial_screen 
  2907.       null ;
  2908.     end scroll_up_partial_screen ;
  2909.     
  2910.     procedure scroll_down_middle_screen (
  2911.                         last_line_to_scroll       : a_screen_line_number ;
  2912.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2913.     begin -- scroll_down_middle_screen 
  2914.       null ;
  2915.     end scroll_down_middle_screen ;
  2916.     
  2917.     procedure scroll_down_entire_screen (
  2918.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2919.     begin -- scroll_down_entire_screen 
  2920.       null ;
  2921.     end scroll_down_entire_screen ;
  2922.      
  2923.     procedure scroll_down_partial_screen (
  2924.                         first_line_to_scroll      : a_screen_line_number ;
  2925.                         last_line_to_scroll       : a_screen_line_number ;
  2926.                         number_of_lines_to_scroll : a_screen_line_number ) is
  2927.     begin -- scroll_down_partial_screen
  2928.       null ;
  2929.     end scroll_down_partial_screen ;
  2930.     
  2931.     -- Finally, we need the Keyboard handler routines
  2932.          
  2933.     function CTRL( A_CHARACTER : in CHARACTER ) return INTEGER is
  2934.     begin
  2935.       return CHARACTER'POS(A_CHARACTER) mod 32;   -- Strip off high bits
  2936.     end;
  2937.          
  2938.     procedure KEYBOARD_INITIALIZE is
  2939.       -- Set up for the input of special keys.
  2940.       -- Program the function keys
  2941.        
  2942.       procedure set_em( place:integer; c_val: integer; new_key: special_keys) is
  2943.       begin -- set_em
  2944.         real_key_on_input        ( place ) := extended_character ( c_val ) ;
  2945.         special_meaning_on_input ( place ) := new_key ;
  2946.       end set_em ;
  2947.        
  2948.       procedure SET_KEY_MAPPINGS is
  2949.         -- Set up the mappings of keys to new meanings
  2950.       begin
  2951.         -- First, do the normal mappings
  2952.         for C_NUMBER in 0..255 loop
  2953.           set_em ( c_number , c_number , key_character ) ;
  2954.         end loop;
  2955.         -- Then, change the characters which are to be treated specially...
  2956.         set_em ( ctrl('V') , 0 , key_end_of_text     ) ;
  2957.         set_em ( 27        , 0 , key_escape          ) ;
  2958.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ; 
  2959.         set_em ( ctrl('H') , 0 , key_backspace       ) ;
  2960.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  2961.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  2962.         set_em ( 127       , 0 , key_delete          ) ;
  2963.         set_em ( ctrl('A') , 0 , key_home            ) ;
  2964.       end;
  2965.            
  2966.       procedure MAP_FUNCTION_KEYS is
  2967.          
  2968.         function make_key( in_character : in character ;
  2969.                            out_meaning  : in special_keys ;    
  2970.                            out_character: in integer ) 
  2971.                                        return type_of_key_change is
  2972.           t : type_of_key_change ;
  2973.         begin
  2974.           t.key := extended_character( CHARACTER'POS( in_character ) ) ;
  2975.           t.special_meaning := out_meaning ;
  2976.           t.final_key := extended_character( out_character ) ;
  2977.           return t;
  2978.         end;
  2979.              
  2980.       begin
  2981.         -- Initialize to nothing...
  2982.         for A_KEY_TYPE in 1..NUM_KEY_TYPES loop
  2983.           KEY_MAP(A_KEY_TYPE).LEAD_IN_LENGTH := 0 ;
  2984.           KEY_MAP(A_KEY_TYPE).LEAD_IN        := "     ";
  2985.           KEY_MAP(A_KEY_TYPE).FOLLOW_REMOVE  := 0 ;
  2986.           for A_SINGLE_KEY in 1..NUM_KEYS_WITHIN_TYPE loop
  2987.             KEY_MAP(A_KEY_TYPE).EACH_KEY(A_SINGLE_KEY)   
  2988.                             := make_key( CHARACTER'VAL(0) , key_illegal , 0 );
  2989.           end loop;
  2990.         end loop;
  2991.         KEY_MAP(1).LEAD_IN_LENGTH := 2 ;
  2992.         KEY_MAP(1).LEAD_IN(1..2)  := " O" ;
  2993.         KEY_MAP(1).LEAD_IN(1)     := ASCII.ESC ;
  2994.         KEY_MAP(1).FOLLOW_REMOVE  := 0 ;
  2995.         KEY_MAP(1).EACH_KEY(01) := make_key('A',KEY_FUNCTION,1);
  2996.         KEY_MAP(1).EACH_KEY(02) := make_key('B',KEY_FUNCTION,2);
  2997.         KEY_MAP(1).EACH_KEY(03) := make_key('C',KEY_FUNCTION,3);
  2998.         KEY_MAP(1).EACH_KEY(04) := make_key('D',KEY_FUNCTION,4);
  2999.         KEY_MAP(1).EACH_KEY(05) := make_key('E',KEY_FUNCTION,5);
  3000.         KEY_MAP(1).EACH_KEY(06) := make_key('F',KEY_FUNCTION,6);
  3001.         KEY_MAP(1).EACH_KEY(07) := make_key('G',KEY_FUNCTION,7);
  3002.         KEY_MAP(1).EACH_KEY(08) := make_key('H',KEY_FUNCTION,8);
  3003.         KEY_MAP(1).EACH_KEY(09) := make_key('I',KEY_FUNCTION,9);
  3004.         KEY_MAP(1).EACH_KEY(10) := make_key('J',KEY_FUNCTION,10);
  3005.         KEY_MAP(1).EACH_KEY(11) := make_key('K',KEY_FUNCTION,11);
  3006.         KEY_MAP(1).EACH_KEY(12) := make_key('L',KEY_FUNCTION,12);
  3007.         KEY_MAP(2).LEAD_IN_LENGTH := 2 ;
  3008.         KEY_MAP(2).LEAD_IN(1..2)  := " O" ;
  3009.         KEY_MAP(2).LEAD_IN(1)     := ASCII.ESC ;
  3010.         KEY_MAP(2).FOLLOW_REMOVE  := 0 ;
  3011.         KEY_MAP(2).EACH_KEY(01) := make_key('M',key_function,13);
  3012.         KEY_MAP(2).EACH_KEY(02) := make_key('N',key_function,14);
  3013.         KEY_MAP(2).EACH_KEY(03) := make_key('O',key_function,15);
  3014.         KEY_MAP(2).EACH_KEY(04) := make_key('P',key_function,16);
  3015.         KEY_MAP(2).EACH_KEY(05) := make_key('1',KEY_FUNCTION,17);
  3016.         KEY_MAP(2).EACH_KEY(06) := make_key('2',KEY_FUNCTION,18);
  3017.         KEY_MAP(2).EACH_KEY(07) := make_key('3',KEY_FUNCTION,19);
  3018.         KEY_MAP(2).EACH_KEY(08) := make_key('a',KEY_FUNCTION,20);
  3019.         KEY_MAP(2).EACH_KEY(09) := make_key('b',KEY_FUNCTION,21);
  3020.         KEY_MAP(2).EACH_KEY(10) := make_key('c',KEY_FUNCTION,22);
  3021.         KEY_MAP(2).EACH_KEY(11) := make_key('d',KEY_FUNCTION,23);
  3022.         KEY_MAP(2).EACH_KEY(12) := make_key('e',KEY_FUNCTION,24);
  3023.         key_map(3).lead_in_length := 2 ;
  3024.         key_map(3).lead_in(1..2)  := " 0";
  3025.         key_map(3).lead_in(1)     := ascii.esc ;
  3026.         key_map(3).follow_remove  := 0 ;
  3027.         key_map(3).each_key(01) := make_key('f',key_function,25);
  3028.         key_map(3).each_key(02) := make_key('g',key_function,26);
  3029.         key_map(3).each_key(03) := make_key('h',key_function,27);
  3030.         key_map(3).each_key(04) := make_key('i',key_function,28);
  3031.         key_map(3).each_key(05) := make_key('j',key_function,29);
  3032.         key_map(3).each_key(06) := make_key('k',key_function,30);
  3033.         key_map(3).each_key(07) := make_key('l',key_function,31);
  3034.         key_map(3).each_key(08) := make_key('m',key_function,32);
  3035.         key_map(3).each_key(09) := make_key('n',key_function,33);
  3036.         key_map(3).each_key(10) := make_key('o',key_function,34);
  3037.         key_map(3).each_key(11) := make_key('p',key_function,35);
  3038.         key_map(4).lead_in_length := 1 ;
  3039.         key_map(4).lead_in(1)     := ascii.esc ;
  3040.         key_map(4).follow_remove := 0 ;
  3041.         key_map(4).each_key(01) := make_key(ascii.esc,key_escape,0) ;
  3042.       end;
  3043.           
  3044.     begin  -- Keyboard_initialize
  3045.       set_key_mappings ;               -- Set up the special 1 to 1 mappings
  3046.       map_function_keys ;              -- ready the memory map to read keys
  3047.     end KEYBOARD_INITIALIZE;
  3048.          
  3049.   begin -- CRT 
  3050.     -- CRT      by SAIC/Clearwater VT100 ANSI I/O Routines     07 Jan 85
  3051.     do_crt(cold_init);
  3052.     --
  3053.   end CRT;
  3054.      
  3055.   package body editor_customization is
  3056.      
  3057.     maximum_function_keys : constant integer := 10 ;
  3058.     maximum_alternate_keys: constant integer := 10 ;
  3059.       
  3060.     type command_pair is 
  3061.            record
  3062.              c       : character ;
  3063.              command : crt_editor_command ;
  3064.            end record ;
  3065.              
  3066.     function_key : array ( 1 .. maximum_function_keys ) of command_pair ;
  3067.     alternate_key: array ( 1 .. maximum_alternate_keys) of command_pair ;
  3068.      
  3069.     type a_wp_command is 
  3070.            record
  3071.              len : integer ;
  3072.              str : string ( 1 .. max_wp_command_length ) ;
  3073.            end record ;
  3074.             
  3075.     word_processor_command_list : array ( 1 .. 10 ) of a_wp_command     ;
  3076.       
  3077.     Physical_Tran : array ( crt.special_keys ) of command_pair ;
  3078.       
  3079.     c_to_command : array ( 0 .. 255 ) of command_pair ;
  3080.       
  3081.     procedure set_c ( in_char     ,
  3082.                       out_char    : in character ;
  3083.                       out_meaning : in crt_editor_command ) is
  3084.     begin -- set_c
  3085.       c_to_command( character'pos( in_char ) ) := ( out_char , out_meaning) ;
  3086.     end set_c ;
  3087.       
  3088.     procedure initialize_translate_tables is
  3089.       
  3090.     use crt ;
  3091.       
  3092.     begin -- initialize_translate_tables
  3093.       -- First , make everything Illegal 
  3094.       for indx in 1 .. maximum_function_keys loop
  3095.         function_key ( indx ) := ( ascii.nul , illegal_command ) ;
  3096.       end loop ;
  3097.       for indx in 1 .. maximum_alternate_keys loop
  3098.         alternate_key ( indx ) := ( ascii.nul , illegal_command ) ;
  3099.       end loop ;
  3100.       for indx in crt.special_keys'first .. crt.special_keys'last loop
  3101.         Physical_Tran( indx ) := ( ascii.nul , illegal_command ) ;
  3102.       end loop ;
  3103.       for indx in 0 .. 255 loop
  3104.         c_to_command ( indx ) := ( ascii.nul , illegal_command ) ;
  3105.       end loop ;
  3106.       -- We have 4 function keys on the VT 100 Terminal
  3107.       -- This mapping set is called when the input key type is key_function
  3108.       -- Note that we could have another set called if we needed to work
  3109.       -- with key_alternate
  3110.       function_key ( 1 ) := ( ascii.nul   , accept_command             ) ;
  3111.       function_key ( 2 ) := ( ascii.nul   , home_command               ) ;
  3112.       function_key ( 3 ) := ( ascii.nul   , advance_paragraph_command  ) ;
  3113.       function_key ( 4 ) := ( ascii.nul   , reject_command             ) ;
  3114.       -- The following is the physical to editor logical key mapping
  3115.       Physical_Tran ( key_end_of_text ) := ( ascii.nul , accept_command) ;
  3116.       Physical_Tran ( key_escape      ) := ( ascii.nul , reject_command) ;
  3117.       Physical_Tran ( key_line_feed   ) := ( ascii.nul , down_command  ) ;
  3118.       Physical_Tran ( key_carriage_return):=(ascii.nul , advance_line_command);
  3119.       Physical_Tran ( key_tab_forward ) := ( ascii.nul , advance_tab_command );
  3120.       Physical_Tran ( key_home        ) := ( ascii.nul , home_command  ) ;
  3121.       -- Physical_Tran ( key_tab_backward) := ( ascii.nul ,            ) ;
  3122.       Physical_Tran ( key_backspace   ) := ( ascii.nul , 
  3123.                                                   backward_character_command ) ;
  3124.       Physical_Tran ( key_up          ) := ( ascii.nul , up_command    ) ;
  3125.       Physical_Tran ( key_down        ) := ( ascii.nul , down_command  ) ;
  3126.       Physical_Tran ( key_right       ) := ( ascii.nul , right_command ) ;
  3127.       Physical_Tran ( key_left        ) := ( ascii.nul , left_command  ) ;
  3128.       Physical_Tran ( key_delete      ) := ( ascii.nul , backward_line_command);
  3129.       -- Max wp command length is 20 , so initialize to that length 
  3130.       for posn in 1 .. 10 loop
  3131.         alternate_key(posn) := ( character'val(posn), word_processor_command ) ;
  3132.       end loop ;
  3133.       word_processor_command_list( 1) :=  
  3134.         (  8 , ascii.cr & ".add 1"         & ascii.cr & "            "    ) ;
  3135.       word_processor_command_list( 2) :=  
  3136.         (  7 , ascii.cr & ".bold "                    & "             "   ) ;
  3137.       word_processor_command_list( 3) :=  
  3138.         (  9 , ascii.cr & ".shadow "                  & "           "     ) ;
  3139.       word_processor_command_list( 4) :=  
  3140.         ( 11 , ascii.cr & ".end_page"      & ascii.cr & "         "       ) ;
  3141.       word_processor_command_list( 5) :=  
  3142.         (  4 ,            " on"            & ascii.cr & "                ") ;
  3143.       word_processor_command_list( 6) :=  
  3144.         (  5 ,            " off"           & ascii.cr & "               " ) ;
  3145.       word_processor_command_list( 7) :=  
  3146.         (  9 , ascii.cr & ".indent "                  & "           "     ) ;
  3147.       word_processor_command_list( 8) :=  
  3148.         ( 12 , ascii.cr & ".underline "               & "        "        ) ;
  3149.       word_processor_command_list( 9) :=  
  3150.         ( 14 , ascii.cr & ".ucontinuous "             & "      "          ) ;
  3151.       word_processor_command_list(10) :=  
  3152.         (  1 , ascii.cr                           & "                   " ) ;
  3153.         -- the last is the soft carriage return 
  3154.       -- key_character is handled next
  3155.       set_c ( 'A' , 'A' , adjust_command               ) ;
  3156.       set_c ( 'B' , 'B' , move_to_first_line_position_command   ) ;
  3157.       set_c ( 'C' , 'C' , copy_command                 ) ;
  3158.       set_c ( 'D' , 'D' , start_deletion_command       ) ;
  3159.       set_c ( 'E' , 'E' , move_to_last_line_position_command    ) ;
  3160.       set_c ( 'F' , 'F' , find_command                 ) ;
  3161.       set_c ( 'H' , 'H' , help_command                 ) ;
  3162.       set_c ( 'I' , 'I' , insert_command               ) ;
  3163.       set_c ( 'J' , 'J' , jump_command                 ) ;
  3164.       set_c ( 'K' , 'K' , kill_command                 ) ;
  3165.       set_c ( 'L' , 'L' , print_screen_command         ) ;
  3166.       set_c ( 'M' , 'M' , re_margin_command            ) ;
  3167.       set_c ( 'P' , 'P' , advance_page_command         ) ;
  3168.       set_c ( 'Q' , 'Q' , quit_command                 ) ;
  3169.       set_c ( 'R' , 'R' , replace_command              ) ;
  3170.       set_c ( 'S' , 'S' , set_stuff_command            ) ;
  3171.       set_c ( 'V' , 'V' , verify_screen_command        ) ;
  3172.       set_c ( 'W' , 'W' , advance_word_command         ) ;
  3173.       set_c ( 'X' , 'X' , enter_exchange_mode          ) ;
  3174.       set_c ( 'Y' , 'Y' , advance_paragraph_command    ) ;
  3175.       set_c ( 'Z' , 'Z' , zap_command                  ) ;
  3176.       set_c ( 'a' , 'a' , adjust_command               ) ;
  3177.       set_c ( 'b' , 'b' , move_to_first_line_position_command   ) ;
  3178.       set_c ( 'c' , 'c' , copy_command                 ) ;
  3179.       set_c ( 'd' , 'd' , start_deletion_command       ) ;
  3180.       set_c ( 'e' , 'e' , move_to_last_line_position_command    ) ;
  3181.       set_c ( 'f' , 'f' , find_command                 ) ;
  3182.       set_c ( 'h' , 'h' , help_command                 ) ;
  3183.       set_c ( 'i' , 'i' , insert_command               ) ;
  3184.       set_c ( 'j' , 'j' , jump_command                 ) ;
  3185.       set_c ( 'k' , 'k' , kill_command                 ) ;
  3186.       set_c ( 'l' , 'l' , print_screen_command         ) ;
  3187.       set_c ( 'm' , 'm' , re_margin_command            ) ;
  3188.       set_c ( 'p' , 'p' , advance_page_command         ) ;
  3189.       set_c ( 'q' , 'q' , quit_command                 ) ;
  3190.       set_c ( 'r' , 'r' , replace_command              ) ;
  3191.       set_c ( 's' , 's' , set_stuff_command            ) ;
  3192.       set_c ( 'v' , 'v' , verify_screen_command        ) ;
  3193.       set_c ( 'w' , 'w' , advance_word_command         ) ;
  3194.       set_c ( 'x' , 'x' , enter_exchange_mode          ) ;
  3195.       set_c ( 'y' , 'y' , advance_paragraph_command    ) ;
  3196.       set_c ( 'z' , 'z' , zap_command                  ) ;
  3197.       set_c ( '?' , '?' , help_command                 ) ;
  3198.       set_c ( ' ' , ' ' , advance_character_command    ) ;
  3199.       set_c ( ',' , ',' , set_backward_direction       ) ;
  3200.       set_c ( '<' , '<' , set_backward_direction       ) ;
  3201.       set_c ( '.' , '.' , set_forward_direction        ) ;
  3202.       set_c ( '>' , '>' , set_forward_direction        ) ;
  3203.       set_c ( '+' , '+' , shift_screen_right           ) ;
  3204.       set_c ( ';' , ';' , shift_screen_right           ) ;
  3205.       set_c ( '-' , '-' , shift_screen_left            ) ;
  3206.       set_c ( '!' , '!' , show_other_prompt_command    ) ;
  3207.       set_c ( '/' , '/' , infinity_command             ) ;
  3208.       set_c ( '=' , '=' , jump_to_marked_position_command);
  3209.       for cc in '0' .. '9' loop
  3210.         set_c ( cc , cc , digit_command                ) ;
  3211.       end loop ;
  3212.       -- key_macro ( all ) is handled in the lower levels 
  3213.     end initialize_translate_tables ;
  3214.      
  3215.     procedure initialize_prompt_lines is
  3216.     begin
  3217.     Main_Command_Prompt                :=
  3218. " Edit: A(djst C(opy D(elete F(ind H(elp I(nsrt Q(uit R(place eX(chg '!'" ;
  3219.     Alternate_Command_Prompt           :=
  3220. " Edit: H(elp J(ump K(ill L(inePrntr M(argin P(age S(et V(erify Z(ap '!'" ;
  3221.     Adjust_Command_Prompt              := 
  3222. " Adjust: L(just R(just C(ent <left,right,up,down> [<ACCEPT> to leave]" ;
  3223.     Copy_Command_Prompt                := 
  3224. " Copy: B(uffer, F(ile, or <Reject> to abort ? " ;
  3225.     Delete_Command_Prompt              := 
  3226. " Delete: < > <Moving Commands>, <Append Toggle>, <Accept>, <Reject>  " ;
  3227.     Find_Command_Prompt                := " Find: " ;
  3228.     Help_Command_Prompt                := " Help: Prompt not defined...." ;
  3229.     Insert_Command_Prompt              := 
  3230. " Insert: Text [<bs> a char,<del> a line][<Accept> or <Reject>] " ;
  3231.     Jump_Command_Prompt                := 
  3232. " Jump to B(egin, E(nd, M(arker, or <Reject> to abort ? " ;
  3233.     Kill_Command_Prompt                := 
  3234. "!KILLING! - - Are You Really Sure You Want To Kill All Following Text "
  3235.                                                                 & "(Y/N) ? " ;
  3236.     Line_Printer_Command_Prompt        := 
  3237. "!PRINTING! - - Are You Sure You Want To Print This Screen (Y/N) ? " ;
  3238.     Margin_Command_Prompt              := " " ; 
  3239.     Quit_Command_Prompt                := " Quit Options:      " ;
  3240.     Replace_Command_Prompt             := " Replace: " ;
  3241.     Set_Command_Prompt                 := 
  3242. " Set: E(nvironment, M(arker, T(abs, Z(ap Marker, H(elp or <Reject> ? " ;
  3243.     eXchange_Command_Prompt            :=
  3244. " eXchange TEXT [<bs> a char] [<reject> escapes, <accept> accepts]" ;
  3245.     Zap_Command_Prompt                 :=
  3246. " WARNING! Are you sure you wish to zap ? (y/n) " ;
  3247.     Enter_Input_File_Name_Prompt       :=
  3248. " Enter Input File Name ( or <return> for a new file ) => " ;
  3249.     Enter_Copied_In_File_Name_Prompt   := 
  3250. " Copy: from what file ( or <return> to skip ) => " ;
  3251.     end initialize_prompt_lines ;
  3252.       
  3253.     procedure translate( ch            : in character          ;
  3254.                          special       : in crt.special_keys   ;
  3255.                          new_ch        : out character         ;
  3256.                          edit_special  : out crt_editor_command ) is
  3257.       -- translate an input character and special meaning pair to
  3258.       -- an internal editor character representation and editor
  3259.       -- special meaning pair
  3260.       temp_new_ch : character ;
  3261.       temp_special: crt_editor_command ;
  3262.     begin -- translate
  3263.       case special is
  3264.         when crt.key_function  => 
  3265.                if character'pos(ch) <= maximum_function_keys then
  3266.                  temp_new_ch  := function_key  ( character'pos(ch) ).c       ;
  3267.                  temp_special := function_key  ( character'pos(ch) ).command ;
  3268.                else 
  3269.                  temp_new_ch  := ascii.nul ;
  3270.                  temp_special := illegal_command ;
  3271.                end if ;
  3272.         when crt.key_alternate =>
  3273.                if character'pos(ch) <= maximum_alternate_keys then
  3274.                  temp_new_ch  := alternate_key ( character'pos(ch) ).c       ;
  3275.                  temp_special := alternate_key ( character'pos(ch) ).command ;
  3276.                else 
  3277.                  temp_new_ch  := ascii.nul ;
  3278.                  temp_special := illegal_command ;
  3279.                end if ;
  3280.         when crt.key_character =>
  3281.                  temp_new_ch  := c_to_command  ( character'pos(ch) ).c       ;
  3282.                  temp_special := c_to_command  ( character'pos(ch) ).command ;
  3283.         when others        =>
  3284.                  temp_new_ch  := physical_tran ( special ).c       ;
  3285.                  temp_special := physical_tran ( special ).command ;
  3286.       end case ;
  3287.       if temp_special = word_processor_command then
  3288.         word_processor_command_string_length :=
  3289.                   word_processor_command_list(character'pos(temp_new_ch)).len ;
  3290.         word_processor_command_string        :=
  3291.                   word_processor_command_list(character'pos(temp_new_ch)).str ;
  3292.       end if ;
  3293.       new_ch := temp_new_ch ;
  3294.       edit_special := temp_special ;
  3295.     end translate ;
  3296.         
  3297.   begin -- editor_customization
  3298.     -- EDITVT10 by SAIC/Clearwater Editor Customization  VT100 07 Jan 85
  3299.     initialize_translate_tables ;
  3300.     initialize_prompt_lines ; -- can't put into constants at top because
  3301.                               -- of initialization code limitation on wicat
  3302.   end editor_customization ;
  3303.   
  3304.   begin -- crt_customization
  3305.     -- CRTDIG by SAIC/Clearwater CRT Customization for DIGITAL MICRO  07 Jan 85
  3306.     null ;
  3307.   end crt_customization ;
  3308.   
  3309.   --$$$- CRTDIG
  3310.  
  3311. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3312. --crtvip77
  3313. --::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3314.  
  3315.   --$$$+ CRTVIP77
  3316.  
  3317.   --
  3318.   -- File 003
  3319.   --
  3320.   -- Editor Written By Robert S. Cymbalski
  3321.   --                   Science Applications International Corporation
  3322.   --                   Energy Systems Group
  3323.   --                   Ada Software Development Project Team
  3324.   --                   2280 U.S. Highway 19 North, Suite 120
  3325.   --                   Clearwater, Florida  33575
  3326.   --
  3327.   -- CRT Manager Revised from text Copyright (c) 1984 , R.S.Cymbalski
  3328.   -- 
  3329.   -- Program for CRT I/O for the VIP 7705
  3330.   -- Editor Customization Package     
  3331.     
  3332.   with string_library  ;
  3333.   use  string_library  ;
  3334.    
  3335.   with basic_io_system ;
  3336.   use  basic_io_system ;
  3337.    
  3338.   package crt_customization is
  3339.     
  3340.   package CRT is
  3341.          
  3342.     type SPECIAL_KEYS is ( KEY_ILLEGAL, KEY_CHARACTER, KEY_END_OF_TEXT, 
  3343.                            KEY_ESCAPE, KEY_TAB_FORWARD, KEY_HOME,
  3344.                            KEY_LINE_FEED , KEY_CARRIAGE_RETURN ,
  3345.                            KEY_TAB_BACKWARD, KEY_BACKSPACE, KEY_UP, KEY_DOWN, 
  3346.                            KEY_RIGHT, KEY_LEFT, KEY_DELETE, KEY_FUNCTION,
  3347.                            KEY_ALTERNATE );
  3348.          
  3349.     type CRT_COLOR is (BLACK,RED,BLUE,GREEN,PURPLE,YELLOW,LIGHT_BLUE,WHITE);
  3350.     type CHAR_ATTRIBUTES is (NORMAL, BLINK, UNDERLINE, OTHER_INTENSITY );
  3351.     type CRT_CONTROL is (COLD_INIT, WARM_INIT, ERASE_ALL, ERASE_EOL,
  3352.                          ERASE_EOS, INSERT_LINE, DELETE_LINE,REVERSE_VIDEO,
  3353.                          CRT_HOME, CRT_UP, CRT_DOWN, CRT_RIGHT, CRT_LEFT,
  3354.                          scroll_middle_screen_up , scroll_entire_screen_up ,
  3355.                          scroll_partial_screen_up ,
  3356.                          scroll_middle_screen_down , scroll_entire_screen_down ,
  3357.                          scroll_partial_screen_down ,
  3358.                          CURSOR_ON, CURSOR_OFF, EXTRA_DISPLAY_ON,
  3359.                          EXTRA_DISPLAY_OFF, KEYBOARD_INPUT_ON, 
  3360.                          KEYBOARD_INPUT_OFF, PROGRAM_TERMINATION );
  3361.         
  3362.     CRT_ATTRIBUTE_1 : CHAR_ATTRIBUTES := NORMAL ;
  3363.     CRT_ATTRIBUTE_2 : CHAR_ATTRIBUTES := NORMAL ;
  3364.     CRT_ATTRIBUTE_3 : CHAR_ATTRIBUTES := NORMAL ;
  3365.         
  3366.     CURRENT_CRT_COLOR : CRT_COLOR     := GREEN ; -- holds current color 
  3367.     DEFAULT_CRT_COLOR : CRT_COLOR     := GREEN ; -- is standard I/O color
  3368.     CURRENT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;
  3369.     DEFAULT_BACKGROUND_COLOR : CRT_COLOR := BLACK ;--standard background color
  3370.         
  3371.     NUM_KEY_TYPES : constant integer := 5 ;
  3372.     NUM_KEYS_WITHIN_TYPE : constant integer := 16 ;
  3373.     type type_of_key_change is record
  3374.       KEY          : extended_character;
  3375.       SPECIAL_MEANING: SPECIAL_KEYS ;
  3376.       FINAL_KEY    : extended_character;
  3377.       end record;
  3378.     type ARRAY_TYPE_OF_KEY_CHANGE is 
  3379.       array ( 1 .. NUM_KEYS_WITHIN_TYPE ) of type_of_key_change ;
  3380.     type KEY_SET is record
  3381.       LEAD_IN_LENGTH : INTEGER ;
  3382.       LEAD_IN        : STRING(1 .. 5);
  3383.       FOLLOW_REMOVE  : INTEGER ;
  3384.       EACH_KEY       : ARRAY_TYPE_OF_KEY_CHANGE ;
  3385.       end record;
  3386.     type ALL_KEYS is array ( 1..NUM_KEY_TYPES ) of KEY_SET ;
  3387.         
  3388.     KEY_MAP : ALL_KEYS;
  3389.     REAL_KEY_ON_INPUT : array ( 0..255 ) of extended_character ;
  3390.     SPECIAL_MEANING_ON_INPUT : array ( 0..255 ) OF SPECIAL_KEYS ;
  3391.        
  3392.     -- Now, we need the CRT handler routines
  3393.          
  3394.     procedure GOTOXY(COL : in A_SCREEN_COLUMN_NUMBER; 
  3395.                      LINE : in A_SCREEN_LINE_NUMBER);
  3396.        -- Positions the cursor to COL,LINE on the screen; changing COL 
  3397.        -- and LINE to maximum allowable column or line if they are
  3398.        -- in error.
  3399.        -- This could be done with SET_COL/SET_LINE but this is one call
  3400.          
  3401.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN;
  3402.       -- Returns true if CRT has the ability to perform the given crt
  3403.       -- control function, false otherwise.
  3404.         
  3405.     procedure DO_CRT( CONTROL : in CRT_CONTROL );
  3406.       -- Performs the given crt control function; if the crt does not have
  3407.       -- the ability to perform the crt control, nothing is done.
  3408.         
  3409.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  3410.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  3411.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL );
  3412.       -- Changes the crt attributes to one, two or three new attributes
  3413.           
  3414.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  3415.                             BACKGROUND_COLOR : in CRT_COLOR := black);
  3416.       -- Changes the crt color to the new text and background colors
  3417.          
  3418.     procedure scroll_up_middle_screen (
  3419.                         first_line_to_scroll      : a_screen_line_number ;
  3420.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3421.      
  3422.     procedure scroll_up_entire_screen (
  3423.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3424.      
  3425.     procedure scroll_up_partial_screen ( 
  3426.                         first_line_to_scroll      : a_screen_line_number ;
  3427.                         last_line_to_scroll       : a_screen_line_number ;
  3428.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3429.      
  3430.     procedure scroll_down_middle_screen (
  3431.                         last_line_to_scroll       : a_screen_line_number ;
  3432.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3433.      
  3434.     procedure scroll_down_entire_screen (
  3435.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3436.      
  3437.     procedure scroll_down_partial_screen (
  3438.                         first_line_to_scroll      : a_screen_line_number ;
  3439.                         last_line_to_scroll       : a_screen_line_number ;
  3440.                         number_of_lines_to_scroll : a_screen_line_number ) ;
  3441.      
  3442.   end CRT ;
  3443.        
  3444.   package editor_customization is
  3445.        
  3446.     type crt_editor_command is ( up_command          , down_command        ,
  3447.                                  right_command       , left_command        ,
  3448.                                      
  3449.                                 advance_character_command ,
  3450.                                 advance_word_command      ,
  3451.                                 advance_tab_command       ,
  3452.                                 advance_line_command      ,
  3453.                                 advance_paragraph_command ,
  3454.                                 advance_page_command      ,
  3455.                                 advance_infinity_command  ,
  3456.                                  
  3457.                                 forward_character_command  , 
  3458.                                 backward_character_command ,
  3459.                                 forward_word_command  , backward_word_command ,
  3460.                                 forward_tab_command   , backward_tab_command  ,
  3461.                                 forward_line_command  , backward_line_command ,
  3462.                                 forward_paragraph_command  ,
  3463.                                 backward_paragraph_command ,
  3464.                                 forward_page_command  , backward_page_command ,
  3465.                                  
  3466.                                 home_command          ,
  3467.                                 move_to_first_line_position_command ,
  3468.                                 move_to_last_line_position_command  ,
  3469.                                 jump_to_first_position_command ,
  3470.                                 jump_to_last_position_command  ,
  3471.                                  
  3472.                                 jump_to_marked_position_command ,
  3473.                                  
  3474.                                 set_forward_direction ,
  3475.                                 set_backward_direction ,
  3476.                                      
  3477.                                 shift_screen_right  , shift_screen_left   ,
  3478.                                  
  3479.                                 adjust_command        , 
  3480.                                 copy_command          , 
  3481.                                 start_deletion_command,
  3482.                                 find_command          ,
  3483.                                 help_command          ,
  3484.                                 insert_command        ,
  3485.                                 jump_command          , 
  3486.                                 kill_command          , 
  3487.                                 print_screen_command  , 
  3488.                                 re_margin_command     ,
  3489.                                 quit_command          , 
  3490.                                 replace_command       , 
  3491.                                 set_stuff_command     ,
  3492.                                 verify_screen_command ,
  3493.                                 enter_exchange_mode   ,
  3494.                                 zap_command           , 
  3495.                                  
  3496.                                 accept_command        , 
  3497.                                 reject_command        ,
  3498.                                 word_processor_command,
  3499.                                 digit_command         ,
  3500.                                 infinity_command      ,
  3501.                                 show_other_prompt_command ,
  3502.                                 illegal_command    )  ;
  3503.        
  3504.     Main_Command_Prompt                : string (1..71) ;
  3505.     Alternate_Command_Prompt           : string (1..71) ;
  3506.     Adjust_Command_Prompt              : string (1..69) ; 
  3507.     Copy_Command_Prompt                : string (1..46) ;
  3508.     Delete_Command_Prompt              : string (1..69) ; 
  3509.     Find_Command_Prompt                : string (1.. 7) ; 
  3510.     Help_Command_Prompt                : string (1..29) ; 
  3511.     Insert_Command_Prompt              : string (1..63) ; 
  3512.     Jump_Command_Prompt                : string (1..55) ;
  3513.     Kill_Command_Prompt                : string (1..78) ; 
  3514.     Line_Printer_Command_Prompt        : string (1..66) ; 
  3515.     Margin_Command_Prompt              : string (1.. 1) ; 
  3516.     Quit_Command_Prompt                : string (1..20) ;
  3517.     Replace_Command_Prompt             : string (1..10) ; 
  3518.     Set_Command_Prompt                 : string (1..69) ; 
  3519.     eXchange_Command_Prompt            : string (1..65) ;
  3520.     Zap_Command_Prompt                 : string (1..47) ;
  3521.     Enter_Input_File_Name_Prompt       : string (1..57) ;
  3522.     Enter_Copied_In_File_Name_Prompt   : string (1..49) ; 
  3523.       
  3524.     procedure translate( ch            : in character          ;
  3525.                          special       : in crt.special_keys   ;
  3526.                          new_ch        : out character         ;
  3527.                          edit_special  : out crt_editor_command ) ;
  3528.       -- translate an input character and special meaning pair to
  3529.       -- an internal editor character representation and editor
  3530.       -- special meaning pair
  3531.         
  3532.     max_wp_command_length : constant integer := 20 ;
  3533.      
  3534.     word_processor_command_string_length : integer ;
  3535.       -- The length of the word processor command string for the 
  3536.       -- key just pressed
  3537.        
  3538.     word_processor_command_string : string ( 1 .. max_wp_command_length ) ;
  3539.       -- The string of characters associated with the function key hit
  3540.       -- If the first character is ascii.cr, then start a new line at
  3541.       -- column 1.  If the length is greater than 1 and then the last 
  3542.       -- character is ascii.cr, then end by starting a new line and 
  3543.       -- indenting to the old indentation from before the command key.
  3544.       -- If the first character is a space, then, only put the space in
  3545.       -- if the last character was not a space
  3546.        
  3547.   end;
  3548.      
  3549.   end crt_customization ;
  3550.     
  3551.   package body crt_customization is 
  3552.     
  3553.   package body CRT is
  3554.          
  3555.     procedure GOTOXY( COL : in A_SCREEN_COLUMN_NUMBER ; 
  3556.                       LINE : in A_SCREEN_LINE_NUMBER ) is
  3557.       --  It will change the col or line if they are in error
  3558.       A_COL, A_LINE : NATURAL;
  3559.     begin
  3560.       A_COL := COL ;
  3561.       A_LINE := LINE ;
  3562.       if A_COL > TOTAL_CRT_COL then
  3563.         A_COL := TOTAL_CRT_COL ;
  3564.       end if;
  3565.       if A_LINE > TOTAL_CRT_LINE then
  3566.         A_LINE := TOTAL_CRT_LINE ;
  3567.       end if;
  3568.       CRT_COL := A_COL ;
  3569.       CRT_LINE := A_LINE ;
  3570.       put_transparent(19);
  3571.       put_transparent(character'val(A_LINE+31));
  3572.       put_transparent(character'val(A_COL+31));
  3573.     end;
  3574.      
  3575.     function CRT_HAS( CONTROL : in CRT_CONTROL ) return BOOLEAN is
  3576.       ok : BOOLEAN ;
  3577.     begin
  3578.       case CONTROL is
  3579.         when COLD_INIT          => ok := TRUE   ;  -- Required
  3580.         when WARM_INIT          => ok := TRUE   ;  -- Required
  3581.         when ERASE_ALL          => ok := TRUE   ;  -- Required
  3582.         when ERASE_EOL          => ok := TRUE   ;
  3583.         when ERASE_EOS          => ok := TRUE   ;
  3584.         when INSERT_LINE        => ok := FALSE  ;
  3585.         when DELETE_LINE        => ok := FALSE  ;
  3586.         when CRT_HOME           => ok := TRUE   ;  -- Required
  3587.         when CRT_UP             => ok := TRUE   ;
  3588.         when CRT_DOWN           => ok := TRUE   ;
  3589.         when CRT_RIGHT          => ok := TRUE   ;
  3590.         when CRT_LEFT           => ok := TRUE   ;
  3591.         when REVERSE_VIDEO      => ok := false  ;
  3592.         when scroll_middle_screen_up    => ok := false  ;
  3593.         when scroll_entire_screen_up    => ok := true   ;  -- required
  3594.         when scroll_partial_screen_up   => ok := false  ;
  3595.         when scroll_middle_screen_down  => ok := false  ;
  3596.         when scroll_entire_screen_down  => ok := false  ;
  3597.         when scroll_partial_screen_down => ok := false  ;
  3598.         when CURSOR_ON          => ok := FALSE   ;
  3599.         when CURSOR_OFF         => ok := FALSE   ;
  3600.         when EXTRA_DISPLAY_ON   => ok := FALSE   ;
  3601.         when EXTRA_DISPLAY_OFF  => ok := FALSE   ;
  3602.         when KEYBOARD_INPUT_ON  => ok := FALSE   ;
  3603.         when KEYBOARD_INPUT_OFF => ok := FALSE   ;
  3604.         when PROGRAM_TERMINATION=> ok := TRUE   ;  -- Required
  3605.       end case;
  3606.       return ok ;
  3607.     end;
  3608.          
  3609.     procedure new_attributes(new_text_color , 
  3610.                              new_background_color : crt_color;
  3611.            new_crt_atr_1  , new_crt_atr_2 , new_crt_atr_3 : char_attributes) is
  3612.       screen_color : crt_color ;
  3613.          
  3614.     begin
  3615.       null ;
  3616.     end;
  3617.          
  3618.     procedure CHANGE_CRT( TO  : in CHAR_ATTRIBUTES ;
  3619.                           ALSO     : in CHAR_ATTRIBUTES := normal ;
  3620.                           AND_ALSO : in CHAR_ATTRIBUTES := NORMAL ) is
  3621.     begin
  3622.       null ;
  3623.     end;
  3624.          
  3625.     procedure CHANGE_COLOR( TEXT_COLOR : in CRT_COLOR ;
  3626.                             BACKGROUND_COLOR : in CRT_COLOR := black) is
  3627.     begin
  3628.       null ;
  3629.     end;
  3630.          
  3631.     procedure KEYBOARD_INITIALIZE;
  3632.          
  3633.     procedure DO_CRT( CONTROL : in CRT_CONTROL ) is
  3634.     begin
  3635.       case CONTROL is
  3636.         when COLD_INIT    => TOTAL_CRT_COL := 80 ;
  3637.                              TOTAL_CRT_LINE:= 24 ;
  3638.                              KEYBOARD_INITIALIZE;
  3639.                              DO_CRT(WARM_INIT);
  3640.         when WARM_INIT    => CHANGE_CRT( NORMAL ) ;
  3641.                              CHANGE_COLOR( GREEN ) ;
  3642.                              DO_CRT(ERASE_ALL);
  3643.                              DO_CRT(CURSOR_ON);
  3644.                              DO_CRT(EXTRA_DISPLAY_ON);
  3645.                              DO_CRT(KEYBOARD_INPUT_ON);
  3646.         when ERASE_ALL    => put_transparent(character'val(12));
  3647.         when ERASE_EOL    => put_transparent(ASCII.ESC);   -- ???????
  3648.                              put_transparent("[" & "0K") ; -- ???????
  3649.         when ERASE_EOS    => put_transparent(ASCII.ESC);   -- ???????
  3650.                              put_transparent("[" & "0J") ; -- ??????? 
  3651.         when INSERT_LINE  => null ;
  3652.         when DELETE_LINE  => null ;
  3653.         when CRT_HOME     => put_transparent(character'val(20));
  3654.         when CRT_UP       => if CRT_LINE > 1 then
  3655.                                CRT_LINE := CRT_LINE - 1 ;
  3656.                                put_transparent(character'val(17));
  3657.                              -- else do nothing...
  3658.                              end if ;
  3659.         when CRT_DOWN     => if CRT_LINE < TOTAL_CRT_LINE then
  3660.                                CRT_LINE := CRT_LINE + 1 ;
  3661.                                put_transparent(character'val(10));
  3662.                              -- else do nothing...
  3663.                              end if ;
  3664.         when CRT_RIGHT    => if CRT_COL < TOTAL_CRT_COL then
  3665.                                CRT_COL := CRT_COL + 1 ;
  3666.                                put_transparent(character'val(18));
  3667.                              -- else do nothing...
  3668.                              end if ;
  3669.         when CRT_LEFT     => if CRT_COL > 1 then
  3670.                                CRT_COL := CRT_COL - 1 ;
  3671.                                put_transparent(character'val(8));
  3672.                              -- Else, we do nothing...
  3673.                              end if ;
  3674.         when REVERSE_VIDEO=> null ;
  3675.         when scroll_middle_screen_up    => null ;  -- handled separately 
  3676.         when scroll_entire_screen_up    => scroll_up_entire_screen(1);
  3677.         when scroll_partial_screen_up   => null ; -- handled separately 
  3678.         when scroll_middle_screen_down  => null ;  -- handled separately 
  3679.         when scroll_entire_screen_down  => scroll_down_entire_screen(1);
  3680.         when scroll_partial_screen_down => null ; -- handled separately 
  3681.         when CURSOR_ON          => null ;
  3682.         when CURSOR_OFF         => null ;
  3683.         when EXTRA_DISPLAY_ON   => null ;
  3684.         when EXTRA_DISPLAY_OFF  => null ;
  3685.         when KEYBOARD_INPUT_ON  => null ;
  3686.         when KEYBOARD_INPUT_OFF => null ;
  3687.         when PROGRAM_TERMINATION=> do_crt(warm_init)          ;
  3688.                                    put(" Type A Key ") ;
  3689.                                    terminate_basic_io_system  ;
  3690.                                    do_crt(warm_init)          ;
  3691.       end case;
  3692.     end;
  3693.          
  3694.     procedure scroll_up_middle_screen (
  3695.                         first_line_to_scroll      : a_screen_line_number ;
  3696.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3697.     begin -- scroll_up_middle_screen 
  3698.       null ;
  3699.     end scroll_up_middle_screen ;
  3700.      
  3701.     procedure scroll_up_entire_screen (
  3702.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3703.       lines_so_far : integer := 0 ;
  3704.     begin -- scroll_up_entire_screen 
  3705.       gotoxy(1,total_crt_line);
  3706.       loop
  3707.         put_transparent( ascii.lf ) ;
  3708.         lines_so_far := lines_so_far + 1 ;
  3709.       exit when lines_so_far >= number_of_lines_to_scroll ;
  3710.       end loop ;
  3711.     end scroll_up_entire_screen ;
  3712.     
  3713.     procedure scroll_up_partial_screen ( 
  3714.                         first_line_to_scroll      : a_screen_line_number ;
  3715.                         last_line_to_scroll       : a_screen_line_number ;
  3716.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3717.     begin -- scroll_up_partial_screen 
  3718.       null ;
  3719.     end scroll_up_partial_screen ;
  3720.     
  3721.     procedure scroll_down_middle_screen (
  3722.                         last_line_to_scroll       : a_screen_line_number ;
  3723.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3724.     begin -- scroll_down_middle_screen 
  3725.       null ;
  3726.     end scroll_down_middle_screen ;
  3727.     
  3728.     procedure scroll_down_entire_screen (
  3729.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3730.     begin -- scroll_down_entire_screen 
  3731.       null ;
  3732.     end scroll_down_entire_screen ;
  3733.      
  3734.     procedure scroll_down_partial_screen (
  3735.                         first_line_to_scroll      : a_screen_line_number ;
  3736.                         last_line_to_scroll       : a_screen_line_number ;
  3737.                         number_of_lines_to_scroll : a_screen_line_number ) is
  3738.     begin -- scroll_down_partial_screen
  3739.       null ;
  3740.     end scroll_down_partial_screen ;
  3741.     
  3742.     -- Finally, we need the Keyboard handler routines
  3743.          
  3744.     function CTRL( A_CHARACTER : in CHARACTER ) return INTEGER is
  3745.     begin
  3746.       return CHARACTER'POS(A_CHARACTER) mod 32;   -- Strip off high bits
  3747.     end;
  3748.          
  3749.     procedure KEYBOARD_INITIALIZE is
  3750.       -- Set up for the input of special keys.
  3751.       -- Program the function keys
  3752.        
  3753.       procedure set_em( place:integer; c_val: integer; new_key: special_keys) is
  3754.       begin -- set_em
  3755.         real_key_on_input        ( place ) := extended_character ( c_val ) ;
  3756.         special_meaning_on_input ( place ) := new_key ;
  3757.       end set_em ;
  3758.        
  3759.       procedure SET_KEY_MAPPINGS is
  3760.         -- Set up the mappings of keys to new meanings
  3761.       begin
  3762.         -- First, do the normal mappings
  3763.         for C_NUMBER in 0..255 loop
  3764.           set_em ( c_number , c_number , key_character ) ;
  3765.         end loop;
  3766.         -- Then, change the characters which are to be treated specially...
  3767.         set_em ( ctrl('\') , 0 , key_end_of_text     ) ;
  3768.         set_em ( 128       , 0 , key_escape          ) ;
  3769.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ;
  3770.         set_em ( ctrl('_') , 0 , key_backspace       ) ;
  3771.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  3772.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  3773.         set_em ( 127       , 0 , key_delete          ) ;
  3774.         set_em ( ctrl('A') , 0 , key_home            ) ;
  3775.         --
  3776.         set_em ( ctrl('A') , 0 , key_home            ) ;
  3777.         set_em ( ctrl('U') , 0 , key_up              ) ;
  3778.         set_em ( ctrl('D') , 0 , key_down            ) ;
  3779.         set_em ( ctrl('R') , 0 , key_right           ) ;
  3780.         set_em ( ctrl('L') , 0 , key_left            ) ;
  3781.         set_em ( ctrl('V') , 0 , key_end_of_text     ) ;
  3782.         set_em ( 27        , 0 , key_escape          ) ;
  3783.         set_em ( ctrl('I') , 0 , key_tab_forward     ) ; 
  3784.         set_em ( ctrl('H') , 0 , key_backspace       ) ;
  3785.         set_em ( ctrl('J') , 0 , key_line_feed       ) ;
  3786.         set_em ( ctrl('M') , 0 , key_carriage_return ) ;
  3787.         set_em ( 127       , 0 , key_delete          ) ;
  3788.       end;
  3789.  
  3790.       procedure MAP_FUNCTION_KEYS is
  3791.  
  3792.         function make_key( in_character : in character ;
  3793.                            out_meaning  : in special_keys ;
  3794.                            out_character: in integer )
  3795.                                        return type_of_key_change is
  3796.           t : type_of_key_change ;
  3797.         begin
  3798.           t.key := extended_character( CHARACTER'POS( in_character ) ) ;
  3799.           t.special_meaning := out_meaning ;
  3800.           t.final_key := extended_character( out_character ) ;
  3801.           return t;
  3802.         end;
  3803.  
  3804.       begin
  3805.         -- Initialize to nothing...
  3806.         for A_KEY_TYPE in 1..NUM_KEY_TYPES loop
  3807.           KEY_MAP(A_KEY_TYPE).LEAD_IN_LENGTH := 0 ;
  3808.           KEY_MAP(A_KEY_TYPE).LEAD_IN        := "     ";
  3809.           KEY_MAP(A_KEY_TYPE).FOLLOW_REMOVE  := 0 ;
  3810.           for A_SINGLE_KEY in 1..NUM_KEYS_WITHIN_TYPE loop
  3811.             KEY_MAP(A_KEY_TYPE).EACH_KEY(A_SINGLE_KEY)
  3812.                             := make_key( CHARACTER'VAL(0) , key_illegal , 0 );
  3813.           end loop;
  3814.         end loop;
  3815.         KEY_MAP(1).LEAD_IN_LENGTH := 2 ;
  3816.         KEY_MAP(1).LEAD_IN(1..2)  := " [" ;
  3817.         KEY_MAP(1).LEAD_IN(1)     := ASCII.ESC ;
  3818.         KEY_MAP(1).FOLLOW_REMOVE  := 0 ;
  3819.         KEY_MAP(1).EACH_KEY(01) := make_key('A',KEY_UP, 0);
  3820.         KEY_MAP(1).EACH_KEY(02) := make_key('B',KEY_DOWN, 0);
  3821.         KEY_MAP(1).EACH_KEY(03) := make_key('C',KEY_RIGHT, 0);
  3822.         KEY_MAP(1).EACH_KEY(04) := make_key('D',KEY_LEFT, 0);
  3823.         KEY_MAP(2).LEAD_IN_LENGTH := 2 ;
  3824.         KEY_MAP(2).LEAD_IN(1..2)  := " O" ; 
  3825.         KEY_MAP(2).LEAD_IN(1)     := ASCII.ESC ;
  3826.         KEY_MAP(2).FOLLOW_REMOVE  := 0 ;
  3827.         KEY_MAP(2).EACH_KEY(01) := make_key('P',key_function, 1);
  3828.         KEY_MAP(2).EACH_KEY(02) := make_key('Q',key_function, 2);
  3829.         KEY_MAP(2).EACH_KEY(03) := make_key('R',key_function, 3);
  3830.         KEY_MAP(2).EACH_KEY(04) := make_key('S',key_function, 4);
  3831.         key_map(3).lead_in_length := 1 ;
  3832.         key_map(3).lead_in(1)     := ascii.esc ;
  3833.         key_map(3).follow_remove  := 0 ;
  3834.         key_map(3).each_key(01)   := make_key(ascii.esc,key_escape,0);
  3835.         -- The last maps <esc><esc> to a single escape 
  3836.         key_map(3).each_key(02)   := make_key('1',key_alternate, 1);
  3837.         key_map(3).each_key(03)   := make_key('2',key_alternate, 2);
  3838.         key_map(3).each_key(04)   := make_key('3',key_alternate, 3);
  3839.         key_map(3).each_key(05)   := make_key('4',key_alternate, 4);
  3840.         key_map(3).each_key(06)   := make_key('5',key_alternate, 5);
  3841.         key_map(3).each_key(07)   := make_key('6',key_alternate, 6);
  3842.         key_map(3).each_key(08)   := make_key('7',key_alternate, 7);
  3843.         key_map(3).each_key(09)   := make_key('8',key_alternate, 8);
  3844.         key_map(3).each_key(10)   := make_key('9',key_alternate, 9);
  3845.         key_map(3).each_key(11)   := make_key('0',key_alternate,10);
  3846.       end;
  3847.           
  3848.     begin  -- Keyboard_initialize
  3849.       set_key_mappings ;               -- Set up the special 1 to 1 mappings
  3850.       map_function_keys ;              -- ready the memory map to read keys
  3851.     end KEYBOARD_INITIALIZE;
  3852.          
  3853.   begin -- CRT 
  3854.     -- CRT      by SAIC/Clearwater VT100 ANSI I/O Routines     07 Jan 85
  3855.     do_crt(cold_init);
  3856.     --
  3857.   end CRT;
  3858.      
  3859.   package body editor_customization is
  3860.      
  3861.     maximum_function_keys : constant integer := 10 ;
  3862.     maximum_alternate_keys: constant integer := 10 ;
  3863.       
  3864.     type command_pair is 
  3865.            record
  3866.              c       : character ;
  3867.              command : crt_editor_command ;
  3868.            end record ;
  3869.              
  3870.     function_key : array ( 1 .. maximum_function_keys ) of command_pair ;
  3871.     alternate_key: array ( 1 .. maximum_alternate_keys) of command_pair ;
  3872.      
  3873.     type a_wp_command is 
  3874.            record
  3875.              len : integer ;
  3876.              str : string ( 1 .. max_wp_command_length ) ;
  3877.            end record ;
  3878.             
  3879.     word_processor_command_list : array ( 1 .. 10 ) of a_wp_command     ;
  3880.       
  3881.     Physical_Tran : array ( crt.special_keys ) of command_pair ;
  3882.       
  3883.     c_to_command : array ( 0 .. 255 ) of command_pair ;
  3884.       
  3885.     procedure set_c ( in_char     ,
  3886.                       out_char    : in character ;
  3887.                       out_meaning : in crt_editor_command ) is
  3888.     begin -- set_c
  3889.       c_to_command( character'pos( in_char ) ) := ( out_char , out_meaning) ;
  3890.     end set_c ;
  3891.       
  3892.     procedure initialize_translate_tables is
  3893.       
  3894.     use crt ;
  3895.       
  3896.     begin -- initialize_translate_tables
  3897.       -- First , make everything Illegal 
  3898.       for indx in 1 .. maximum_function_keys loop
  3899.         function_key ( indx ) := ( ascii.nul , illegal_command ) ;
  3900.       end loop ;
  3901.       for indx in 1 .. maximum_alternate_keys loop
  3902.         alternate_key ( indx ) := ( ascii.nul , illegal_command ) ;
  3903.       end loop ;
  3904.       for indx in crt.special_keys'first .. crt.special_keys'last loop
  3905.         Physical_Tran( indx ) := ( ascii.nul , illegal_command ) ;
  3906.       end loop ;
  3907.       for indx in 0 .. 255 loop
  3908.         c_to_command ( indx ) := ( ascii.nul , illegal_command ) ;
  3909.       end loop ;
  3910.       -- We have 4 function keys on the VT 100 Terminal
  3911.       -- This mapping set is called when the input key type is key_function
  3912.       -- Note that we could have another set called if we needed to work
  3913.       -- with key_alternate
  3914.       function_key ( 1 ) := ( ascii.nul   , accept_command             ) ;
  3915.       function_key ( 2 ) := ( ascii.nul   , home_command               ) ;
  3916.       function_key ( 3 ) := ( ascii.nul   , advance_paragraph_command  ) ;
  3917.       function_key ( 4 ) := ( ascii.nul   , reject_command             ) ;
  3918.       -- The following is the physical to editor logical key mapping
  3919.       Physical_Tran ( key_end_of_text ) := ( ascii.nul , accept_command) ;
  3920.       Physical_Tran ( key_escape      ) := ( ascii.nul , reject_command) ;
  3921.       Physical_Tran ( key_line_feed   ) := ( ascii.nul , down_command  ) ;
  3922.       Physical_Tran ( key_carriage_return):=(ascii.nul , advance_line_command);
  3923.       Physical_Tran ( key_tab_forward ) := ( ascii.nul , advance_tab_command );
  3924.       Physical_Tran ( key_home        ) := ( ascii.nul , home_command  ) ;
  3925.       -- Physical_Tran ( key_tab_backward) := ( ascii.nul ,            ) ;
  3926.       Physical_Tran ( key_backspace   ) := ( ascii.nul , 
  3927.                                                   backward_character_command ) ;
  3928.       Physical_Tran ( key_up          ) := ( ascii.nul , up_command    ) ;
  3929.       Physical_Tran ( key_down        ) := ( ascii.nul , down_command  ) ;
  3930.       Physical_Tran ( key_right       ) := ( ascii.nul , right_command ) ;
  3931.       Physical_Tran ( key_left        ) := ( ascii.nul , left_command  ) ;
  3932.       Physical_Tran ( key_delete      ) := ( ascii.nul , backward_line_command);
  3933.       -- Max wp command length is 20 , so initialize to that length 
  3934.       for posn in 1 .. 10 loop
  3935.         alternate_key(posn) := ( character'val(posn), word_processor_command ) ;
  3936.       end loop ;
  3937.       word_processor_command_list( 1) :=  
  3938.         (  8 , ascii.cr & ".add 1"         & ascii.cr & "            "    ) ;
  3939.       word_processor_command_list( 2) :=  
  3940.         (  7 , ascii.cr & ".bold "                    & "             "   ) ;
  3941.       word_processor_command_list( 3) :=  
  3942.         (  9 , ascii.cr & ".shadow "                  & "           "     ) ;
  3943.       word_processor_command_list( 4) :=  
  3944.         ( 11 , ascii.cr & ".end_page"      & ascii.cr & "         "       ) ;
  3945.       word_processor_command_list( 5) :=  
  3946.         (  4 ,            " on"            & ascii.cr & "                ") ;
  3947.       word_processor_command_list( 6) :=  
  3948.         (  5 ,            " off"           & ascii.cr & "               " ) ;
  3949.       word_processor_command_list( 7) :=  
  3950.         (  9 , ascii.cr & ".indent "                  & "           "     ) ;
  3951.       word_processor_command_list( 8) :=  
  3952.         ( 12 , ascii.cr & ".underline "               & "        "        ) ;
  3953.       word_processor_command_list( 9) :=  
  3954.         ( 14 , ascii.cr & ".ucontinuous "             & "      "          ) ;
  3955.       word_processor_command_list(10) :=  
  3956.         (  1 , ascii.cr                           & "                   " ) ;
  3957.         -- the last is the soft carriage return 
  3958.       -- key_character is handled next
  3959.       set_c ( 'A' , 'A' , adjust_command               ) ;
  3960.       set_c ( 'B' , 'B' , move_to_first_line_position_command   ) ;
  3961.       set_c ( 'C' , 'C' , copy_command                 ) ;
  3962.       set_c ( 'D' , 'D' , start_deletion_command       ) ;
  3963.       set_c ( 'E' , 'E' , move_to_last_line_position_command    ) ;
  3964.       set_c ( 'F' , 'F' , find_command                 ) ;
  3965.       set_c ( 'H' , 'H' , help_command                 ) ;
  3966.       set_c ( 'I' , 'I' , insert_command               ) ;
  3967.       set_c ( 'J' , 'J' , jump_command                 ) ;
  3968.       set_c ( 'K' , 'K' , kill_command                 ) ;
  3969.       set_c ( 'L' , 'L' , print_screen_command         ) ;
  3970.       set_c ( 'M' , 'M' , re_margin_command            ) ;
  3971.       set_c ( 'P' , 'P' , advance_page_command         ) ;
  3972.       set_c ( 'Q' , 'Q' , quit_command                 ) ;
  3973.       set_c ( 'R' , 'R' , replace_command              ) ;
  3974.       set_c ( 'S' , 'S' , set_stuff_command            ) ;
  3975.       set_c ( 'V' , 'V' , verify_screen_command        ) ;
  3976.       set_c ( 'W' , 'W' , advance_word_command         ) ;
  3977.       set_c ( 'X' , 'X' , enter_exchange_mode          ) ;
  3978.       set_c ( 'Y' , 'Y' , advance_paragraph_command    ) ;
  3979.       set_c ( 'Z' , 'Z' , zap_command                  ) ;
  3980.       set_c ( 'a' , 'a' , adjust_command               ) ;
  3981.       set_c ( 'b' , 'b' , move_to_first_line_position_command   ) ;
  3982.       set_c ( 'c' , 'c' , copy_command                 ) ;
  3983.       set_c ( 'd' , 'd' , start_deletion_command       ) ;
  3984.       set_c ( 'e' , 'e' , move_to_last_line_position_command    ) ;
  3985.       set_c ( 'f' , 'f' , find_command                 ) ;
  3986.       set_c ( 'h' , 'h' , help_command                 ) ;
  3987.       set_c ( 'i' , 'i' , insert_command               ) ;
  3988.       set_c ( 'j' , 'j' , jump_command                 ) ;
  3989.       set_c ( 'k' , 'k' , kill_command                 ) ;
  3990.       set_c ( 'l' , 'l' , print_screen_command         ) ;
  3991.       set_c ( 'm' , 'm' , re_margin_command            ) ;
  3992.       set_c ( 'p' , 'p' , advance_page_command         ) ;
  3993.       set_c ( 'q' , 'q' , quit_command                 ) ;
  3994.       set_c ( 'r' , 'r' , replace_command              ) ;
  3995.       set_c ( 's' , 's' , set_stuff_command            ) ;
  3996.       set_c ( 'v' , 'v' , verify_screen_command        ) ;
  3997.       set_c ( 'w' , 'w' , advance_word_command         ) ;
  3998.       set_c ( 'x' , 'x' , enter_exchange_mode          ) ;
  3999.       set_c ( 'y' , 'y' , advance_paragraph_command    ) ;
  4000.       set_c ( 'z' , 'z' , zap_command                  ) ;
  4001.       set_c ( '?' , '?' , help_command                 ) ;
  4002.       set_c ( ' ' , ' ' , advance_character_command    ) ;
  4003.       set_c ( ',' , ',' , set_backward_direction       ) ;
  4004.       set_c ( '<' , '<' , set_backward_direction       ) ;
  4005.       set_c ( '.' , '.' , set_forward_direction        ) ;
  4006.       set_c ( '>' , '>' , set_forward_direction        ) ;
  4007.       set_c ( '+' , '+' , shift_screen_right           ) ;
  4008.       set_c ( ';' , ';' , shift_screen_right           ) ;
  4009.       set_c ( '-' , '-' , shift_screen_left            ) ;
  4010.       set_c ( '!' , '!' , show_other_prompt_command    ) ;
  4011.       set_c ( '/' , '/' , infinity_command             ) ;
  4012.       set_c ( '=' , '=' , jump_to_marked_position_command);
  4013.       for cc in '0' .. '9' loop
  4014.         set_c ( cc , cc , digit_command                ) ;
  4015.       end loop ;
  4016.       -- key_macro ( all ) is handled in the lower levels 
  4017.     end initialize_translate_tables ;
  4018.      
  4019.     procedure initialize_prompt_lines is
  4020.     begin
  4021.     Main_Command_Prompt                :=
  4022. " Edit: A(djst C(opy D(elete F(ind H(elp I(nsrt Q(uit R(place eX(chg '!'" ;
  4023.     Alternate_Command_Prompt           :=
  4024. " Edit: H(elp J(ump K(ill L(inePrntr M(argin P(age S(et V(erify Z(ap '!'" ;
  4025.     Adjust_Command_Prompt              := 
  4026. " Adjust: L(just R(just C(ent <left,right,up,down> [<ACCEPT> to leave]" ;
  4027.     Copy_Command_Prompt                := 
  4028. " Copy: B(uffer, F(ile, or <Reject> to abort ? " ;
  4029.     Delete_Command_Prompt              := 
  4030. " Delete: < > <Moving Commands>, <Append Toggle>, <Accept>, <Reject>  " ;
  4031.     Find_Command_Prompt                := " Find: " ;
  4032.     Help_Command_Prompt                := " Help: Prompt not defined...." ;
  4033.     Insert_Command_Prompt              := 
  4034. " Insert: Text [<bs> a char,<del> a line][<Accept> or <Reject>] " ;
  4035.     Jump_Command_Prompt                := 
  4036. " Jump to B(egin, E(nd, M(arker, or <Reject> to abort ? " ;
  4037.     Kill_Command_Prompt                := 
  4038. "!KILLING! - - Are You Really Sure You Want To Kill All Following Text "
  4039.                                                                 & "(Y/N) ? " ;
  4040.     Line_Printer_Command_Prompt        := 
  4041. "!PRINTING! - - Are You Sure You Want To Print This Screen (Y/N) ? " ;
  4042.     Margin_Command_Prompt              := " " ; 
  4043.     Quit_Command_Prompt                := " Quit Options:      " ;
  4044.     Replace_Command_Prompt             := " Replace: " ;
  4045.     Set_Command_Prompt                 := 
  4046. " Set: E(nvironment, M(arker, T(abs, Z(ap Marker, H(elp or <Reject> ? " ;
  4047.     eXchange_Command_Prompt            :=
  4048. " eXchange TEXT [<bs> a char] [<reject> escapes, <accept> accepts]" ;
  4049.     Zap_Command_Prompt                 :=
  4050. " WARNING! Are you sure you wish to zap ? (y/n) " ;
  4051.     Enter_Input_File_Name_Prompt       :=
  4052. " Enter Input File Name ( or <return> for a new file ) => " ;
  4053.     Enter_Copied_In_File_Name_Prompt   := 
  4054. " Copy: from what file ( or <return> to skip ) => " ;
  4055.     end initialize_prompt_lines ;
  4056.       
  4057.     procedure translate( ch            : in character          ;
  4058.                          special       : in crt.special_keys   ;
  4059.                          new_ch        : out character         ;
  4060.                          edit_special  : out crt_editor_command ) is
  4061.       -- translate an input character and special meaning pair to
  4062.       -- an internal editor character representation and editor
  4063.       -- special meaning pair
  4064.       temp_new_ch : character ;
  4065.       temp_special: crt_editor_command ;
  4066.     begin -- translate
  4067.       case special is
  4068.         when crt.key_function  => 
  4069.                if character'pos(ch) <= maximum_function_keys then
  4070.                  temp_new_ch  := function_key  ( character'pos(ch) ).c       ;
  4071.                  temp_special := function_key  ( character'pos(ch) ).command ;
  4072.                else 
  4073.                  temp_new_ch  := ascii.nul ;
  4074.                  temp_special := illegal_command ;
  4075.                end if ;
  4076.         when crt.key_alternate =>
  4077.                if character'pos(ch) <= maximum_alternate_keys then
  4078.                  temp_new_ch  := alternate_key ( character'pos(ch) ).c       ;
  4079.                  temp_special := alternate_key ( character'pos(ch) ).command ;
  4080.                else 
  4081.                  temp_new_ch  := ascii.nul ;
  4082.                  temp_special := illegal_command ;
  4083.                end if ;
  4084.         when crt.key_character =>
  4085.                  temp_new_ch  := c_to_command  ( character'pos(ch) ).c       ;
  4086.                  temp_special := c_to_command  ( character'pos(ch) ).command ;
  4087.         when others        =>
  4088.                  temp_new_ch  := physical_tran ( special ).c       ;
  4089.                  temp_special := physical_tran ( special ).command ;
  4090.       end case ;
  4091.       if temp_special = word_processor_command then
  4092.         word_processor_command_string_length :=
  4093.                   word_processor_command_list(character'pos(temp_new_ch)).len ;
  4094.         word_processor_command_string        :=
  4095.                   word_processor_command_list(character'pos(temp_new_ch)).str ;
  4096.       end if ;
  4097.       new_ch := temp_new_ch ;
  4098.       edit_special := temp_special ;
  4099.     end translate ;
  4100.         
  4101.   begin -- editor_customization
  4102.     -- EDITVT10 by SAIC/Clearwater Editor Customization  VT100 07 Jan 85
  4103.     initialize_translate_tables ;
  4104.     initialize_prompt_lines ; -- can't put into constants at top because
  4105.                               -- of initialization code limitation on wicat
  4106.   end editor_customization ;
  4107.   
  4108.   begin -- crt_customization
  4109.     -- CRTVIP7705 by SAIC/Clearwater CRT Customization for VT100 07 Jan 85
  4110.     null ;
  4111.   end crt_customization ;
  4112.   
  4113.   --$$$- CRTVIP77
  4114.  
  4115.  
  4116.