MODULE TPUPlus_RECT IDENT "900409"
!       
! TPUPlus code module
!       
! Rectangular Cut/Paste utility procedures
!   PROCEDURE EDD_CURRENT_COLUMN
!   PROCEDURE EDD_REPLACE_TABS_WITH_BLANKS_AND_PAD (TARGET_LENGTH)
!   PROCEDURE EVE_DRAW_BOX
!   PROCEDURE EVE_RECTANGULAR_REMOVE
!   PROCEDURE EVE_RECTANGULAR_INSERT_HERE
!   PROCEDURE EVE_RECTANGULAR_SELECT
!   PROCEDURE EVEPLUS_PAD_BLANK
!   PROCEDURE EVE_SET_RECTANGULAR
!   PROCEDURE EVE_SET_NORECTANGULAR
!   PROCEDURE EVEPLUS_SET_MODE (NEW_MODE)
!   PROCEDURE EVEPLUS_BLANK_CHARS (EVEPLUS_V_BLANK_COUNT)
!   PROCEDURE EVEPLUS_ADVANCE_HORIZONTAL (EVEPLUS_V_COLUMNS, EVEPLUS_V_BLANK_CHARS)
!   PROCEDURE PCE_TOGGLE_RECTANGULAR
!   PROCEDURE PCE$RECT_KEYS
!

!****************************************
!+
!    RECCUTPAS.TPU - Eve version of  rectangular cut and paste
!-
!
! TPU emulation of  rectangular CUT/PASTE including following routines:
!    EVE_DRAW_BOX
!    EVE_RECTANGULAR_REMOVE
!    EVE_RECTANGULAR_INSERT_HERE
!    EVE_RECTANGULAR_SELECT
!    EVEPLUS_PAD_BLANK
!    EVE_SET_RECTANGULAR
!    EVE_SET_NORECTANGULAR
!    EVEPLUS_SET_MODE
!    EVEPLUS_BLANK_CHARS
!    EVEPLUS_ADVANCE_HORIZONTAL
!
! Rectangular CUT/PASTE provides a way to select a corner of a rectangular
! region on the screen that is to be CUT.  This select point is highlighted
! in reverse video.  The cursor can then be positioned to the opposite
! corner of the box at which point the CUT can be done to place the rectangular
! region in paste_buffer.  PASTE can then be done to overstrike the
! rectangular region in paste_buffer onto the current_buffer using the
! current position as the upper left corner for the pasted region.  Note
! that no provision is made if there are TAB chars in the current buffer.
! Also, no provision is made if the cut or paste is done with part of the
! region to be cut or pasted over not being visible on the screen.
!
! These procedures can be run with the current buffer set to overstrike
! or insert mode - CUT/PASTE need to switch to insert mode temporarily
! to get the chars replaced properly, but the previous mode setting for
! the current buffer is restored when either the cut or paste routine completes.
!
! GLOBAL VARIABLES created/used
!    eveplus_v_begin_select -    position where selected region begins
!    eve$x_vt200_keypad
!
! GLOBAL VARIABLES used
!    current_buffer
!    paste_buffer
!
! This TPU file rebinds the SELECT/REMOVE/INSERT HERE keys to the included
! routines and initializes the eveplus_v_begin_select variable when the
! eve_set_rectangular procedure is executed.  The standard Eve key bindings
! are restored when the eve_set_norectangular procedure is executed.
!
PROCEDURE EDD_CURRENT_COLUMN

!   Procedure to calculate the current column from the current offset, treating
!   TAB characters as up to 8 blanks.

LOCAL i, line, col;

line := current_line;
IF INDEX (line, ASCII (9)) = 0 THEN
    edd_current_column := current_offset;
ELSE
    i := 1;
    col := 0;
    LOOP
        EXITIF i > current_offset;
        IF SUBSTR (line, i, 1) = ASCII (9) THEN
            col := ((col + 8) / 8) * 8;
        ELSE
            col := col + 1;
        ENDIF;
        i := i + 1;
    ENDLOOP;
    edd_current_column := col;
ENDIF;

ENDPROCEDURE;

!****************************************
PROCEDURE EDD_REPLACE_TABS_WITH_BLANKS_AND_PAD (TARGET_LENGTH)

!   Procedure to replace TAB characters by the appropriate number of
!   blanks on the current line, then pad the line out to a given length, if it
!   is shorter.  The routine assumes overstrike mode is in
!   effect.  It leave the current position at the beginning of the line.

LOCAL i, col, cur_length, new_line, eight_blanks;

!+
!   Make sure we're not on the EOB marker.
!-
IF MARK (NONE) <> END_OF (CURRENT_BUFFER) THEN
    IF INDEX (CURRENT_LINE, ASCII(9)) <> 0 THEN
        new_line := '';
        eight_blanks := "        ";
        i := 1;
        col := 0;
        LOOP
            EXITIF i > LENGTH (CURRENT_LINE);
            IF SUBSTR (CURRENT_LINE, i, 1) = ASCII (9) THEN
                col := ((col + 8) / 8) * 8;
                new_line := new_line +
                    SUBSTR (eight_blanks, 1, col-LENGTH (new_line));
            ELSE
                new_line := new_line + SUBSTR (CURRENT_LINE, i, 1);
                col := col + 1;
            ENDIF;
            i := i + 1;
        ENDLOOP;
        MOVE_HORIZONTAL (-CURRENT_OFFSET);
        COPY_TEXT (new_line);
    ENDIF;
ENDIF;

MOVE_HORIZONTAL (-CURRENT_OFFSET);

!+
!   Now pad out the line if we have to
!-
IF MARK (NONE) = END_OF (CURRENT_BUFFER) THEN
    cur_length := 0;
ELSE
    cur_length := LENGTH (CURRENT_LINE);
ENDIF;

IF cur_length < target_length THEN
    MOVE_HORIZONTAL (cur_length);
    COPY_TEXT (eveplus_blank_chars (target_length - cur_length));
ENDIF;

MOVE_HORIZONTAL (-CURRENT_OFFSET);
ENDPROCEDURE;

!****************************************
PROCEDURE EVE_DRAW_BOX

LOCAL  saved_mode, end_column, start_column, temp, end_select, top_bottom_text;

!+
!   Check for no select active
!-
IF eveplus_v_begin_select = 0 THEN
    MESSAGE ("Select not active");
    RETURN;
ENDIF;

!+
!  Set INSERT mode
!-
saved_mode := eveplus_set_mode (INSERT);

!+
!   Make sure there is a character at the corner of the box opposite
!   the begin_select mark.  If the end_select mark is before the
!   begin_select mark, juggle the markers so that begin_select precedes
!   end_select.
!-
eveplus_pad_blank;
IF MARK (NONE) >= eveplus_v_begin_select THEN
    end_select := MARK (NONE);
ELSE
    end_select := eveplus_v_begin_select;
    eveplus_v_begin_select := MARK (NONE);
    POSITION (end_select);
ENDIF;

!+
!   Figure out what column the box ends in and set END_COLUMN there.
!   Then, clear out the video on EVEPLUS_V_BEGIN_SELECT.  Figure out
!   the start column.
!-
end_column := edd_current_column;
POSITION (eveplus_v_begin_select);
eveplus_v_begin_select := MARK (NONE);
start_column := edd_current_column;

!+
!   We may have the upper right and lower left corners of the box
!   selected.  If so, START_COLUMN and END_COLUMN need to be reversed.
!-
IF start_column > end_column THEN
    temp := end_column;
    end_column := start_column;
    start_column := temp;
ENDIF;

!+
!   We may be building the box on the first line of the buffer.  In
!   that case, we must put a new top line in the buffer.
!-
MOVE_HORIZONTAL (-CURRENT_OFFSET);
IF MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER) THEN
    SPLIT_LINE;
    POSITION(BEGINNING_OF (CURRENT_BUFFER));
    COPY_TEXT (eveplus_blank_chars (start_column));
    MOVE_VERTICAL (1);
    MOVE_HORIZONTAL (-CURRENT_OFFSET);
ENDIF;

!+
!   Move back one line and put in the top line of the box
!-
top_bottom_text := '+' +
    eveplus_blank_chars (end_column - start_column + 1) + '+';
TRANSLATE (top_bottom_text, "-", " ");
SET (OVERSTRIKE, current_buffer);
MOVE_VERTICAL (-1);

!+
!   Replace all TABs with blanks on this line and pad it, if we need to.
!-
edd_replace_tabs_with_blanks_and_pad (end_column + 1);

IF start_column <> 0 THEN
    MOVE_HORIZONTAL (start_column - 1);
ENDIF;

COPY_TEXT (top_bottom_text);
MOVE_VERTICAL (1);
MOVE_HORIZONTAL (-CURRENT_OFFSET);

!+
!   Step through the selected lines, putting vertical bars on either side
!   of the selected text.
!-
LOOP
    EXITIF MARK (NONE) > end_select;

!+
!   Replace all TABs with blanks on this line, if we need to.
!-
    edd_replace_tabs_with_blanks_and_pad (end_column + 1);

!+
!   If START_COLUMN is zero, we must insert a vertical bar to do the
!   left column, then put the right vertical bar one column farther out
!   than normal.
!-
    IF start_column = 0 THEN
        SET (INSERT, CURRENT_BUFFER);
        COPY_TEXT ("|");
        SET (OVERSTRIKE, CURRENT_BUFFER);
        MOVE_HORIZONTAL (end_column + 1);
    ELSE
        MOVE_HORIZONTAL (start_column - 1);
        COPY_TEXT ("|");
        MOVE_HORIZONTAL (end_column - CURRENT_OFFSET + 1);
    ENDIF;

    COPY_TEXT ("|");
    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    MOVE_VERTICAL (1);
ENDLOOP;

!+
!   Now put in the bottom line of the box.
!-

!+
!   Replace all TABs with blanks on this line, if we need to.
!-
edd_replace_tabs_with_blanks_and_pad (end_column + 1);
IF start_column <> 0 THEN
    MOVE_HORIZONTAL (start_column - 1);
ENDIF;

COPY_TEXT (top_bottom_text);

!+
!   Position to the beginning of the cut area, reset BEGIN_SELECT,
!   restore old insert/overstrike setting
!-
POSITION (eveplus_v_begin_select);
eveplus_v_begin_select := 0;
MOVE_HORIZONTAL (-CURRENT_OFFSET);
IF start_column = 0 THEN
    MOVE_HORIZONTAL (1);
ELSE
    MOVE_HORIZONTAL (start_column);
ENDIF;

SET (saved_mode, CURRENT_BUFFER);
ENDPROCEDURE;

!****************************************
PROCEDURE EVE_RECTANGULAR_REMOVE

LOCAL saved_mode, end_select, end_column, start_column, temp,
        pad_chars, save_position, blank_chars, cut_text;

!+
!   Check for no select active
!-
IF eveplus_v_begin_select = 0 THEN
    MESSAGE ("Select not active");
    RETURN
ENDIF;

!+
!   Set INSERT mode and erase PASTE_BUFFER
!-
saved_mode := eveplus_set_mode (INSERT);
ERASE (paste_buffer);

!+
!   Make sure there is a character at the corner of the box opposite
!   the begin_select mark.  If the end_select mark is before the
!   begin_select mark, juggle the markers so that begin_select precedes
!   end_select.
!-
eveplus_pad_blank;
IF MARK (NONE) >= eveplus_v_begin_select THEN
    end_select := MARK (NONE);
ELSE
    end_select := eveplus_v_begin_select;
    eveplus_v_begin_select := MARK (NONE);
    POSITION (end_select);
ENDIF;

!+
!   Figure out what column the box ends in and set END_COLUMN there.
!   Then, clear out the video on EVEPLUS_V_BEGIN_SELECT.  Figure out
!   the start column.
!-
end_column := edd_current_column;
POSITION (eveplus_v_begin_select);
eveplus_v_begin_select := MARK (NONE);
start_column := edd_current_column;

!+
!   We may have the upper right and lower left corners of the box
!   selected.  If so, START_COLUMN and END_COLUMN need to be reversed.
!-
IF start_column > end_column THEN
    temp := end_column;
    end_column := start_column;
    start_column := temp;
ENDIF;

!+
!   Get a string of the appropriate number of blanks to paste back in
!-
pad_chars := eveplus_blank_chars (end_column - start_column + 1);

!+
!   Step through the selected lines, copying the text to the paste buffer
!   and replacing it with blanks as we go.  Replace all TABs with blanks
!   before we look at it so we get the columns straight.
!-
MOVE_HORIZONTAL (-current_offset);
SET (OVERSTRIKE, current_buffer);
LOOP
    EXITIF MARK (NONE) > end_select;

!+
!   Replace all TABs with blanks on this line, if we need to.
!-
    edd_replace_tabs_with_blanks_and_pad (end_column + 1);

!+
!   Obtain the text we're cutting
!-
    cut_text := SUBSTR (CURRENT_LINE, start_column + 1,
        end_column - start_column + 1);

!+
!   Replace the text with blanks
!-
    MOVE_HORIZONTAL (start_column);
    COPY_TEXT (pad_chars);

!+
!   Copy the text to the paste buffer
!-
    save_position := MARK (NONE);
    POSITION (paste_buffer);
    COPY_TEXT (cut_text);
    MOVE_HORIZONTAL (1);

!+
!   Reposition to the other buffer and move to the next line
!-
    POSITION (save_position);
    MOVE_HORIZONTAL (-CURRENT_OFFSET);
    MOVE_VERTICAL (1);
ENDLOOP;

!+
!   Position to the beginning of the cut area, reset BEGIN_SELECT,
!   restore old insert/overstrike setting
!-
POSITION (eveplus_v_begin_select);
eveplus_v_begin_select := 0;
MOVE_HORIZONTAL (-CURRENT_OFFSET);
MOVE_HORIZONTAL (start_column);
SET (saved_mode, CURRENT_BUFFER);

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_RECTANGULAR_INSERT_HERE
!+
!   This procedure pastes the rectangular region in the paste buffer
!   using the current position in the current buffer as the upper left corner.
!-
LOCAL save_position, start_column, paste_line, save_buffer, save_mode;

save_buffer := CURRENT_BUFFER;
save_position := MARK (NONE);
start_column := edd_current_column;
save_mode := eveplus_set_mode (OVERSTRIKE);
POSITION (BEGINNING_OF (paste_buffer));
IF MARK (NONE) = END_OF (paste_buffer) THEN
    MESSAGE ("Paste buffer is empty");
    RETURN;
ENDIF;

!+
!   Loop through lines in the paste buffer, putting them at the
!   appropriate offset in the current buffer.
!-
LOOP
    EXITIF MARK (NONE) = END_OF (paste_buffer);

!+
!   Get the current line of the paste buffer.
!-
    paste_line := CURRENT_LINE;
    MOVE_VERTICAL (1);

!+
!   Convert tabs to blanks on the line in the current buffer.
!-
    POSITION (save_buffer);
    edd_replace_tabs_with_blanks_and_pad (start_column + 1);

!+
!   Position at the correct offset and overwrite the text there.
!-
    MOVE_HORIZONTAL (start_column);
    COPY_TEXT (paste_line);
    MOVE_VERTICAL (1);
    POSITION (paste_buffer);
ENDLOOP;

!+
!   Position to start of pasted text and restore old mode setting.
!-
POSITION (save_position);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
MOVE_HORIZONTAL (start_column);
SET (save_mode, CURRENT_BUFFER);

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_RECTANGULAR_SELECT

if eveplus_v_begin_select = 0 then
    eveplus_pad_blank;
    eveplus_v_begin_select := mark (REVERSE);
    message ("Selection started.  Press Remove when finished.");
else
    eveplus_v_begin_select := 0;
    message ("Selection cancelled");
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_PAD_BLANK

!+
! This procedure drops a space at the current position if the current
! character is null so that any mark will be for an existing character.
! In EDD, we really want a mark in a particular screen column.  In TPU,
! an EOL mark would move if the line were extended.  Also in EDD, we
! want to highlight the select point so we need a character there.
! The cursor is returned to its original position after the space is
! copied to the current position in the current buffer.
!-
IF MARK (NONE) = END_OF (CURRENT_BUFFER) THEN
    copy_text (" ");
    move_horizontal (-1)
ELSE
    if current_character = "" then
        copy_text (" ");
        move_horizontal (-1);
    endif;
ENDIF;

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_SET_RECTANGULAR

eveplus_v_begin_select := 0;

add_key_map (eve$x_key_map_list, "first", pce$x_rect_keys);

eve$update_status_lines;

ENDPROCEDURE;
!****************************************
PROCEDURE EVE_SET_NORECTANGULAR

eveplus_v_begin_select := 0;

remove_key_map (eve$x_key_map_list, pce$x_rect_keys, ALL);

eve$update_status_lines;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_SET_MODE (NEW_MODE)

!+
! This procedure returns the current mode for the current buffer
! and sets it to the value in NEW_MODE.
!-

eveplus_set_mode := get_info (current_buffer, "MODE");
set (new_mode, current_buffer);

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_BLANK_CHARS (EVEPLUS_V_BLANK_COUNT)

!+
! This procedure returns a string of eveplus_v_blank_count blank chars.
!-
local eveplus_v_blank_chars, eveplus_v_oldlen, eveplus_v_blanks_so_far;

IF eveplus_v_blank_count = 0 THEN
    RETURN "";
ENDIF;

eveplus_v_blank_chars := " ";
eveplus_v_blanks_so_far := 1;

loop
    exitif eveplus_v_blanks_so_far >= eveplus_v_blank_count;
    eveplus_v_oldlen := LENGTH (eveplus_v_blank_chars);
    eveplus_v_blank_chars := eveplus_v_blank_chars + eveplus_v_blank_chars;
    eveplus_v_blanks_so_far := eveplus_v_blanks_so_far + eveplus_v_oldlen;
endloop;

IF eveplus_v_blanks_so_far > eveplus_v_blank_count THEN
    eveplus_v_blank_chars :=
        SUBSTR (eveplus_v_blank_chars, 1, eveplus_v_blank_count);
ENDIF;
RETURN eveplus_v_blank_chars;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS_ADVANCE_HORIZONTAL (EVEPLUS_V_COLUMNS, EVEPLUS_V_BLANK_CHARS)

!+
! This procedure advances current_offset to be eveplus_v_columns from
! current_offset.  eveplus_v_blanks_chars must be
! a string of blank chars of at least length eveplus_v_columns.
!-
local
    eveplus_v_save_offset,        ! current_offset on entry to this procedure
    eveplus_v_eol_columns;        ! Number of columns to [EOL]

eveplus_v_save_offset := current_offset;
if eveplus_v_columns <= 0 then
    move_horizontal (eveplus_v_columns);
else
!+
! Find out how far to [EOL].
!-
    eveplus_v_eol_columns := length (current_line) - current_offset;
    if eveplus_v_eol_columns >= eveplus_v_columns then
        move_horizontal (eveplus_v_columns);
    else
        move_horizontal (eveplus_v_eol_columns);
        copy_text (substr (eveplus_v_blank_chars, 1,
                 eveplus_v_columns - eveplus_v_save_offset));
    endif;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE PCE_TOGGLE_RECTANGULAR

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

if pce$select_mode = "RECTANGULAR" then
    pce$select_mode := "NORMAL";
    eve_set_norectangular;
else
    pce$select_mode := "RECTANGULAR";
    eve_set_rectangular;
endif;

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

if pce$select_mode = "RECTANGULAR" then
    return (fao (the_format, "Rect"));
else
    return "";
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE PCE$RECT_KEYS

pce$x_rect_keys := "pce$rect_key_map";

create_key_map (pce$x_rect_keys);

define_key ("eve_rectangular_remove",        
            e3,                             "edd_remove (rectangular remove)",
            pce$x_rect_keys);
define_key ("eve_rectangular_insert_here",
            e2,                             "edd_insert_here (rectangular insert)",
            pce$x_rect_keys);
define_key ("eve_rectangular_select",
            e4,                             "edd_select (rectangular select)",
            pce$x_rect_keys);

ENDPROCEDURE;

pce$x_rect_keys := "pce$rect_key_map";

ENDMODULE;

pce$rect_keys;
compile("procedure pce$rect_keys endprocedure");