MODULE TPUPlus_LINE IDENT "900409"
!****************************************
! This linedraw TPU code was written by :-
!                                        
!   Steve Graham
!   British Telecom
!   Royston House
!   34 Upper Queen Street
!   Belfast
!   BT1 6FD
!   Northern Ireland
!   U.K.
!
! Modified by:
!   Rick Stacks - 901211 - incorporated some of Steve Travis's line drawing
!                           code as found in DEC PROFESSIONAL, Dec 1990,
!                           Vol. 9, No. 13, pgs. 70-74
!
! The code is placed in the public domain. It has been tested as completely as
! possible but you are advised that NO WARRANTY, EITHER EXPRESSED OR IMPLIED,
! IS CONVEYED WITH THIS SOFTWARE.
!
!   PROCEDURE eve_change_graphic
!   PROCEDURE EVE_SET_LINEDRAWING
!   PROCEDURE EVE_SET_NOLINEDRAWING
!   PROCEDURE eve$copy_over(the_text)
!   PROCEDURE up_or_down(which_way)
!   PROCEDURE plus_line
!   PROCEDURE plus_char
!   PROCEDURE left_dangling
!   PROCEDURE right_dangling
!   PROCEDURE above_dangling
!   PROCEDURE below_dangling
!   PROCEDURE down_vert
!   PROCEDURE up_vert
!   PROCEDURE left_horiz
!   PROCEDURE right_horiz
!   PROCEDURE graph_char
!   PROCEDURE line_leftwards
!   PROCEDURE line_rightwards
!   PROCEDURE line_downwards
!   PROCEDURE line_upwards
!   PROCEDURE sg_write_ln03_sequence
!   PROCEDURE PCE_TOGGLE_LINEDRAW
!   PROCEDURE EVE$LINEDRAW_STATUS_FIELD (THE_LENGTH, THE_FORMAT)
!   PROCEDURE SG$LINEDRAW_KEYS
!

!****************************************
PROCEDURE eve_change_graphic

local   start_position,
        ch_gr_range,
        pat;

ON_ERROR
    [TPU$_STRNOTFOUND]:
ENDON_ERROR;

IF current_window = eve$command_window THEN
    eve$$exit_command_window;
else
    start_position := mark (none);
    ch_gr_range := select_range;
    IF ch_gr_range = 0 THEN
        message('Nothing selected.');
        return (0);
    endif;

    position(beginning_of(ch_gr_range));

    pat := any("+|-");

    loop
        EXITIF mark (none) >= end_of (ch_gr_range);
        EXITIF mark (none) = end_of (current_buffer);
        EXITIF search(pat,FORWARD,EXACT) = 0;

        IF index("+|-", current_character) <> 0 THEN
            sg$lds := sg$lds + "+-";
            sg$rds := sg$rds + "+-";
            sg$ads := sg$ads + "+|";
            sg$bds := sg$bds + "+|";
            graph_char;
         else
            plus_char;
         endif;
     endloop;
     ch_gr_range := 0;
     eve$x_select_position := 0;
     position(start_position);
endif;

ENDPROCEDURE
               
!****************************************
PROCEDURE EVE_SET_LINEDRAWING

LOCAL loop_window;

IF sg$line_drawing = "TRUE" then
    eve_set_nolinedrawing;
    return;
endif;

sg$line_drawing := "TRUE";
sg$previous_mode := get_info (current_buffer, "mode");
set (overstrike, current_buffer);

loop_window := get_info (window, "first");
loop
    EXITIF loop_window = 0;
!    set (scrolling, loop_window, ON, 0, 0, 0);
    st_line := get_info(loop_window, "status_line");
    IF st_line <> 0 THEN
        eve$set_status_line(loop_window);
    endif;
    loop_window := get_info (window, "next");
endloop;

sg$uparrow      := lookup_key (up, program);
sg$downarrow    := lookup_key (down, program);
sg$leftarrow    := lookup_key (left, program);
sg$rightarrow   := lookup_key (right, program);

add_key_map (eve$x_key_map_list, "first", sg$x_linedraw_keys);
pce$linedraw_mode := "LINEDRAW";
!set (text, message_window, no_translate);
!message (sg$select_1);
!message (sg$select_2);
!message ("");
!set (text, message_window, blank_tabs);
sct_gset;
message ("Cursor keys will now draw lines using line drawing set");
eve$update_status_lines;

ENDPROCEDURE;
!****************************************
PROCEDURE EVE_SET_NOLINEDRAWING

local loop_window;

sg$line_drawing := "FALSE";
loop_window := get_info (window, "first");
loop
    EXITIF loop_window = 0;
    st_line := get_info(loop_window, "status_line");
    if st_line <> 0 THEN
        eve$set_status_line(loop_window);
    endif;
    loop_window := get_info (window, "next");
endloop;
!set (scrolling, eve$main_window, ON, 5, 5, 0);    ! statusline => edit window

set (sg$previous_mode, current_buffer);

remove_key_map (eve$x_key_map_list, sg$x_linedraw_keys, ALL);
pce$linedraw_mode := "NORMAL";
!set(text, message_window, no_translate);
!message(sg$select_1);
!message(sg$select_3);
!message("");
!set(text, message_window, blank_tabs);
message ("Cursor keys are now reset to original definitions ");
eve$update_status_lines;

ENDPROCEDURE;

!****************************************
PROCEDURE eve$copy_over(the_text)        ! Copy_text in overstrike mode

LOCAL    old_mode;

old_mode := get_info(current_buffer, "mode");
set(OVERSTRIKE, current_buffer);
copy_text(the_text);
set(old_mode, current_buffer);

ENDPROCEDURE;

!****************************************
PROCEDURE up_or_down(which_way)

LOCAL   temp_col,
        last_col,
        new_col,
        eob,
        buf;

buf := current_buffer;
EOB := end_of(buf);

last_col := get_info(buf,'offset_column');

IF (last_col <> sg$_prev_column) THEN
    sg$_target_column := last_col;
ENDIF;
move_vertical(which_way);
new_col := get_info(buf,'offset_column');

! Now get as close to the target as possible

IF new_col <> sg$_target_column THEN
    IF new_col < sg$_target_column THEN
        loop
            EXITIF mark(none) = EOB;
            EXITIF current_character = '';
            EXITIF new_col >= sg$_target_column;
            move_horizontal(1);
            temp_col := get_info(buf,'offset_column');
            IF temp_col > sg$_target_column THEN
                move_horizontal(-1);
                exitif
            else
                new_col:=temp_col
            endif;
        endloop;
    else
        loop
            EXITIF current_offset = 0;
            EXITIF new_col <= sg$_target_column;
            move_horizontal(-1);
            new_col := get_info(buf,'offset_column');
        endloop;
    endif;
endif;

sg$_prev_column := new_col;

ENDPROCEDURE;
!****************************************
PROCEDURE plus_line

! Move down one row, staying in the same column.  Scroll if necessary.
up_or_down(+1);

ENDPROCEDURE;
!****************************************
PROCEDURE plus_char

IF mark(NONE) <> end_of(current_buffer) THEN
    IF current_offset <> length(current_line) THEN
        move_horizontal(+1);
    ELSE
        plus_line;
        move_horizontal(-current_offset);
    endif;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE left_dangling

LOCAL c;

IF current_offset <> 0 THEN
    move_horizontal(-1);
    c := current_character;
    move_horizontal(1);
    RETURN (index(sg$lds, c) <> 0);
else
    return 0;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE right_dangling

LOCAL c;

IF current_offset <> length(current_line) THEN
    move_horizontal(1);
    c := current_character;
    move_horizontal(-1);
    RETURN (index(sg$rds, c) <> 0);
ELSE
    return 0;
    endif;

ENDPROCEDURE;
!****************************************
PROCEDURE above_dangling
LOCAL here, beg_line, c;

ON_ERROR
    RETURN 0;
ENDON_ERROR;

here := mark(none);
position(search(line_begin, reverse));
beg_line := mark(none);
position(here);

IF beg_line <> beginning_of(current_buffer) THEN
    cursor_vertical(-1);
    c := current_character;
    cursor_vertical(1);
    RETURN (index(sg$ads, c) <> 0);
else
    return 0;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE below_dangling
LOCAL here, end_line, c;

ON_ERROR
    RETURN 0;
ENDON_ERROR;

here := mark(none);
position(search(line_end, forward));
end_line := mark(none);
position(here);

IF end_line <> end_of(current_buffer) THEN
    cursor_vertical(1);
    c := current_character;
    cursor_vertical(-1);
    RETURN (index(sg$bds, c) <> 0);
else
    return 0;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE down_vert
LOCAL l_d, r_d, a_d;

l_d := left_dangling;
r_d := right_dangling;
a_d := above_dangling;

IF a_d THEN
    IF l_d THEN
        IF r_d THEN
            eve$copy_over(sg$cross);
        else
            eve$copy_over(sg$teeleft);
        endif;
    else
        IF r_d THEN
            eve$copy_over(sg$teeright);
        else
            eve$copy_over(sg$linevert);
        endif;
    endif;
else
    IF l_d THEN
        IF r_d THEN
            eve$copy_over(sg$teedown);
        else
            eve$copy_over(sg$topright);
        endif;
    else
        IF r_d THEN
            eve$copy_over(sg$topleft);
        else
            eve$copy_over(sg$linevert);
        endif;
    endif;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE up_vert
LOCAL l_d, r_d, b_d;

l_d := left_dangling;
r_d := right_dangling;
b_d := below_dangling;

IF b_d THEN
    IF l_d THEN
        IF r_d THEN
            eve$copy_over(sg$cross);
        else
            eve$copy_over(sg$teeleft);
        endif;
    else
        IF r_d THEN
            eve$copy_over(sg$teeright);
        else
            eve$copy_over(sg$linevert);
        endif;
    endif;
else
    IF l_d THEN
        IF r_d THEN
            eve$copy_over(sg$teeup);
        else
            eve$copy_over(sg$bottomright);
        endif;
    else
        IF r_d THEN
            eve$copy_over(sg$bottomleft);
        else
            eve$copy_over(sg$linevert);
        endif;
    endif;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE left_horiz
LOCAL r_d, a_d, b_d;

r_d := right_dangling;
a_d := above_dangling;
b_d := below_dangling;

IF r_d THEN
    IF a_d THEN
        IF b_d THEN
            eve$copy_over(sg$cross);
        else
            eve$copy_over(sg$teeup);
        endif;
    else
        IF b_d THEN
            eve$copy_over(sg$teedown);
        else
            eve$copy_over(sg$linehoriz);
        endif;
    endif;
else
    IF a_d THEN
        IF b_d THEN
            eve$copy_over(sg$teeleft);
        else
            eve$copy_over(sg$bottomright);
        endif;
    else
        IF b_d THEN
            eve$copy_over(sg$topright);
        else
            eve$copy_over(sg$linehoriz);
        endif;
    endif;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE right_horiz
LOCAL l_d, a_d, b_d;

l_d := left_dangling;
a_d := above_dangling;
b_d := below_dangling;

IF l_d THEN
    IF a_d THEN
        IF b_d THEN
            eve$copy_over(sg$cross);
        else
            eve$copy_over(sg$teeup);
        endif;
    else
        IF b_d THEN
            eve$copy_over(sg$teedown);
        else
            eve$copy_over(sg$linehoriz);
        endif;
    endif;
else
    IF a_d THEN
        IF b_d THEN
            eve$copy_over(sg$teeright);
        else
            eve$copy_over(sg$bottomleft);
        endif;
    else
        IF b_d THEN
            eve$copy_over(sg$topleft);
        else
            eve$copy_over(sg$linehoriz);
        endif;
    endif;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE graph_char
LOCAL vector;

vector := 0;

IF left_dangling  THEN vector := vector + 8;ENDIF;
IF right_dangling THEN vector := vector + 4;ENDIF;
IF above_dangling THEN vector := vector + 2;ENDIF;
IF below_dangling THEN vector := vector + 1;ENDIF;

CASE vector from 0 to 15
    [0]  : plus_char;
    [1]  : eve$copy_over(sg$teedown);
    [2]  : eve$copy_over(sg$teeup);
    [3]  : eve$copy_over(sg$linevert);
    [4]  : eve$copy_over(sg$linehoriz);
    [5]  : eve$copy_over(sg$topleft);
    [6]  : eve$copy_over(sg$bottomleft);
    [7]  : eve$copy_over(sg$teeright);
    [8]  : eve$copy_over(sg$linehoriz);
    [9]  : eve$copy_over(sg$topright);
    [10] : eve$copy_over(sg$bottomright);
    [11] : eve$copy_over(sg$teeleft);
    [12] : eve$copy_over(sg$linehoriz);
    [13] : eve$copy_over(sg$teedown);
    [14] : eve$copy_over(sg$teeup);
    [15] : eve$copy_over(sg$cross);
EndCase;

ENDPROCEDURE;

!****************************************
PROCEDURE line_leftwards

left_horiz;
cursor_horizontal(-2);
                                                              
ENDPROCEDURE;                                                  
!****************************************
PROCEDURE line_rightwards

right_horiz;

ENDPROCEDURE;
!****************************************
PROCEDURE line_downwards
                                                               
IF mark(NONE) <> end_of(current_buffer) THEN
    IF get_info (current_window, "current_row") =
        get_info (current_window, "visible_bottom") THEN
        scroll (current_window, 1);
        cursor_vertical (-1);
    endif;
    down_vert;
    cursor_horizontal (-1);
    cursor_vertical (1);
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE line_upwards

IF get_info (current_window, "current_row") =
    get_info (current_window, "visible_top") THEN
    scroll (current_window, -1);
    cursor_vertical (1);
endif;
up_vert;
cursor_horizontal (-1);
cursor_vertical (-1);

ENDPROCEDURE;

!****************************************
PROCEDURE sg_write_ln03_sequence

if sg$ln03_write_sequence = "OFF" then
    copy_text(sg$select_1 + sg$select_2);
    message("Control code to switch on line graphics on a LN03");
    sg$ln03_write_sequence := "ON";
else
    copy_text(sg$select_1 + sg$select_3);
    message("Control code to switch off line graphics on a LN03");
    sg$ln03_write_sequence := "OFF";
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE PCE_TOGGLE_LINEDRAW

if (get_info (pce$linedraw_mode, "type") = UNSPECIFIED) then
    pce$linedraw_mode := "NORMAL";
endif;

if pce$linedraw_mode = "LINEDRAW" then
    eve_set_nolinedrawing;
else
    eve_set_linedrawing;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE SCT_GFILE

local g_mark;

on_error
    return;
endon_error;

g_mark := mark (none);
g_buffer := create_buffer ('g_file');
position (g_buffer);
copy_text ("+0|");                    ! esc + 0 esc |
set (no_write, g_buffer, on);
set (modified, g_buffer, off);
set (system, g_buffer);
position (g_mark);

ENDPROCEDURE;

!****************************************
PROCEDURE SCT_GSET

local g_mark;

g_mark := mark (none);
set (screen_update, off);
write_file (g_buffer, 'sys$output');
message ("");
message ("");
set (screen_update, on);
position (g_mark);

ENDPROCEDURE;     

!****************************************
PROCEDURE EVE$LINEDRAW_STATUS_FIELD (THE_LENGTH, THE_FORMAT)

if pce$linedraw_mode = "LINEDRAW" then
    return (fao (the_format, "Line Draw"));
else
    return "";
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE SG$LINEDRAW_KEYS

create_key_map  ("sg$line_draw_keys");

define_key      ("line_leftwards",  left,   "<-[",  "sg$line_draw_keys");
define_key      ("line_rightwards", right,  "]->",  "sg$line_draw_keys");
define_key      ("line_downwards",  down,   "Down", "sg$line_draw_keys");
define_key      ("line_upwards",    up,     "Up",   "sg$line_draw_keys");

ENDPROCEDURE;

sg$x_linedraw_keys      := "sg$line_draw_keys";
sg$previous_mode        := "";

sg$_prev_column         := 1;
sg$_target_column       := 1;
sg$uparrow              := lookup_key (up, program);
sg$downarrow            := lookup_key (down, program);
sg$leftarrow            := lookup_key (left, program);
sg$rightarrow           := lookup_key (right, program);
sg$select_1             := ascii(27) + ")0";
sg$select_2             := ascii(27) + "*0";
sg$select_3             := ascii(27) + "*<";
sg$line_drawing         := "FALSE";
sg$linedraw_on          := "FALSE";
sg$ln03_write_sequence  := "OFF";

sg$bottomright  := ascii (234);
sg$topright     := ascii (235);
sg$topleft      := ascii (236);
sg$bottomleft   := ascii (237);
sg$cross        := ascii (238);
sg$linehoriz    := ascii (241);
sg$teeright     := ascii (244);
sg$teeleft      := ascii (245);
sg$teeup        := ascii (246);
sg$teedown      := ascii (247);
sg$linevert     := ascii (248);

sg$lds  := sg$linehoriz + sg$teeright + sg$teeup + sg$teedown + sg$cross +
            sg$bottomleft + sg$topleft;
sg$rds  := sg$linehoriz + sg$teeleft + sg$teeup + sg$teedown + sg$cross +
            sg$bottomright + sg$topright;
sg$ads  := sg$linevert + sg$teedown + sg$teeleft + sg$teeright + sg$cross +
            sg$topleft + sg$topright;
sg$bds  := sg$linevert + sg$teeup + sg$teeleft + sg$teeright + sg$cross +
            sg$bottomleft + sg$bottomright;

sct_gfile;

ENDMODULE;

sg$linedraw_keys;
compile("procedure sg$linedraw_keys endprocedure");

define_key ("pce_toggle_linedraw",
            key_name ('d', shift_key),      "TPUPLUS pce_toggle_linedraw (LineDrw)", 
            eve$x_user_keys);
define_key ("pce_toggle_linedraw",
            key_name ('d', shift_key),      "TPUPLUS pce_toggle_linedraw (LineDrw)", 
            eve$x_edt_keys);