!
! This is another example of viewing and unviewing control characters
! The routines contained within this file are modified versions of the routines
! in the TPU V2.2 manual pp A-2 thru A-4.
!
! See also the file TPUPLUS_CNTL.TPU
!
PROCEDURE VIEW_CONTROLS

constant ctrl_char_str := ascii  (0) + ascii  (1) + ascii  (2) + ascii  (3) +
                          ascii  (4) + ascii  (5) + ascii  (6) + ascii  (7) +
                          ascii  (8) + ascii  (9) + ascii (10) + ascii (11) +
                          ascii (12) + ascii (13) + ascii (14) + ascii (15) +
                          ascii (16) + ascii (17) + ascii (18) + ascii (19) +
                          ascii (20) + ascii (21) + ascii (22) + ascii (23) +
                          ascii (24) + ascii (25) + ascii (26) + ascii (27) +
                          ascii (28) + ascii (29) + ascii (30) + ascii (31);

local   ctrl_char_pattern,
        ctrl_char_range;

translate_buffer := current_buffer;
translate_window := current_window;

ctrl_char_pattern := any (ctrl_char_str);
position (beginning_of (translate_buffer));

loop
    ctrl_char_range := search_quietly (ctrl_char_pattern, forward);
    exitif ctrl_char_range = 0;
    position (ctrl_char_range);
    if not translate_controls (ctrl_char_range) then
        move_horizontal (1);
    endif;
endloop;

position (beginning_of (translate_buffer));

ENDPROCEDURE;

PROCEDURE TRANSLATE_CONTROLS (CHAR_RANGE)

local   replace_text;

if translate_array = tpu$k_unspecified then
    translate_array     := create_array (32, 0);
    translate_array (1) := '<SOH>';
    translate_array (2) := '<STX>';
    translate_array (3) := '<ETX>';
    translate_array (4) := '<EOT>';
    translate_array (5) := '<ENQ>';
    translate_array (6) := '<ACK>';
    translate_array (7) := '<BEL>';
    translate_array (8) := '<BS>';
    translate_array (14) := '<SO>';
    translate_array (15) := '<SI>';
    translate_array (16) := '<DLE>';
    translate_array (17) := '<DC1>';
    translate_array (18) := '<DC2>';
    translate_array (19) := '<DC3>';
    translate_array (20) := '<DC4>';
    translate_array (21) := '<NAK>';
    translate_array (22) := '<SYN>';
    translate_array (23) := '<ETB>';
    translate_array (24) := '<CAN>';
    translate_array (25) := '<EM>';
    translate_array (26) := '<SUB>';
    translate_array (27) := '<ESC>';
    translate_array (28) := '<FS>';
    translate_array (29) := '<GS>';
    translate_array (30) := '<RS>';
    translate_array (31) := '<US>';
endif;

if length (char_range) <> 1 then
    return 0;
endif;

replace_text := translate_array (ascii (str (char_range)));

if replace_text = tpu$k_unspecified then
    return 0;
endif;

erase (char_range);
copy_text (replace_text);
return 1;

ENDPROCEDURE;

PROCEDURE UNVIEW_CONTROLS

!local   unctrl_char_pattern,
!        unctrl_char_range;

translate_buffer := current_buffer;
translate_window := current_window;

unctrl_char_pattern :=  '<SOH>' | '<STX>' | '<ETX>' | '<EOT>' | '<ENQ>' |
    '<ACK>' | '<BEL>' | '<BS>'  | '<SO>'  | '<SI>'  | '<DLE>' | '<DC1>' |
    '<DC2>' | '<DC3>' | '<DC4>' | '<NAK>' | '<SYN>' | '<ETB>' | '<CAN>' |
    '<EM>'  | '<SUB>' | '<ESC>' | '<FS>'  | '<GS>'  | '<RS>'  | '<US>';

position (beginning_of (translate_buffer));

loop
    unctrl_char_range := search_quietly (unctrl_char_pattern, forward);
    exitif unctrl_char_range = 0;
    position (unctrl_char_range);
    if not untranslate_controls (unctrl_char_range) then
        eve_move_by_word;
    endif;
endloop;

position (beginning_of (translate_buffer));

ENDPROCEDURE;

PROCEDURE UNTRANSLATE_CONTROLS (UNCHAR_RANGE)

local   replace_text;

if untranslate_array = tpu$k_unspecified then
    untranslate_array     := create_array (32, 0);
    untranslate_array (1) :=  ascii  (1);
    untranslate_array (2) :=  ascii  (2);
    untranslate_array (3) :=  ascii  (3);
    untranslate_array (4) :=  ascii  (4);
    untranslate_array (5) :=  ascii  (5);
    untranslate_array (6) :=  ascii  (6);
    untranslate_array (7) :=  ascii  (7);
    untranslate_array (8) :=  ascii  (8);
    untranslate_array (9) :=  ascii  (9);
    untranslate_array (10) := ascii (10);
    untranslate_array (11) := ascii (11);
    untranslate_array (12) := ascii (12);
    untranslate_array (13) := ascii (13);
    untranslate_array (14) := ascii (14);
    untranslate_array (15) := ascii (15);
    untranslate_array (16) := ascii (16);
    untranslate_array (17) := ascii (17);
    untranslate_array (18) := ascii (18);
    untranslate_array (19) := ascii (19);
    untranslate_array (20) := ascii (20);
    untranslate_array (21) := ascii (21);
    untranslate_array (22) := ascii (22);
    untranslate_array (23) := ascii (23);
    untranslate_array (24) := ascii (24);
    untranslate_array (25) := ascii (25);
    untranslate_array (26) := ascii (26);
    untranslate_array (27) := ascii (27);
    untranslate_array (28) := ascii (28);
    untranslate_array (29) := ascii (29);
    untranslate_array (30) := ascii (30);
    untranslate_array (31) := ascii (31);
endif;

replace_text := tpu$k_unspecified;
replace_text := str (unchar_range);
if replace_text = translate_array (1) then 
    replace_text := untranslate_array (1);
endif;
if replace_text = translate_array (2) then 
    replace_text := untranslate_array (2);
endif;
if replace_text = translate_array (3) then 
    replace_text := untranslate_array (3);
endif;
if replace_text = translate_array (4) then 
    replace_text := untranslate_array (4);
endif;
if replace_text = translate_array (5) then 
    replace_text := untranslate_array (5);
endif;
if replace_text = translate_array (6) then 
    replace_text := untranslate_array (6);
endif;
if replace_text = translate_array (7) then 
    replace_text := untranslate_array (7);
endif;
if replace_text = translate_array (8) then 
    replace_text := untranslate_array (8);
endif;
if replace_text = translate_array (9) then 
    replace_text := untranslate_array (9);
endif;
if replace_text = translate_array (10) then 
    replace_text := untranslate_array (10);
endif;
if replace_text = translate_array (11) then 
    replace_text := untranslate_array (11);
endif;
if replace_text = translate_array (12) then 
    replace_text := untranslate_array (12);
endif;
if replace_text = translate_array (13) then 
    replace_text := untranslate_array (13);
endif;
if replace_text = translate_array (14) then 
    replace_text := untranslate_array (14);
endif;
if replace_text = translate_array (15) then 
    replace_text := untranslate_array (15);
endif;
if replace_text = translate_array (16) then 
    replace_text := untranslate_array (16);
endif;
if replace_text = translate_array (17) then 
    replace_text := untranslate_array (17);
endif;
if replace_text = translate_array (18) then 
    replace_text := untranslate_array (18);
endif;
if replace_text = translate_array (19) then 
    replace_text := untranslate_array (19);
endif;
if replace_text = translate_array (20) then 
    replace_text := untranslate_array (20);
endif;
if replace_text = translate_array (21) then 
    replace_text := untranslate_array (21);
endif;
if replace_text = translate_array (22) then 
    replace_text := untranslate_array (22);
endif;
if replace_text = translate_array (23) then 
    replace_text := untranslate_array (23);
endif;
if replace_text = translate_array (24) then 
    replace_text := untranslate_array (24);
endif;
if replace_text = translate_array (25) then 
    replace_text := untranslate_array (25);
endif;
if replace_text = translate_array (26) then 
    replace_text := untranslate_array (26);
endif;
if replace_text = translate_array (27) then 
    replace_text := untranslate_array (27);
endif;
if replace_text = translate_array (28) then 
    replace_text := untranslate_array (28);
endif;
if replace_text = translate_array (29) then 
    replace_text := untranslate_array (29);
endif;
if replace_text = translate_array (30) then 
    replace_text := untranslate_array (30);
endif;
if replace_text = translate_array (31) then 
    replace_text := untranslate_array (31);
endif;

if replace_text = tpu$k_unspecified then
    return 0;
endif;

erase (unchar_range);
copy_text (replace_text);
return 1;

ENDPROCEDURE;