!
!	RECCUTPAS.TPU - Eve version of  rectangular cut and paste
!
!		(From DECUS ... EVE_Plus)  P. B. Wischow...12 March 1987
!
! TPU emulation of  rectangular CUT/PASTE including following routines:
!
!	DECUS$DRAW_BOX
!	DECUS$RECTANGULAR_REMOVE
!	DECUS$RECTANGULAR_INSERT_HERE
!	DECUS$RECTANGULAR_SELECT
!	DECUS$PAD_BLANK
!	DECUS$SET_RECTANGULAR
!	DECUS$SET_NORECTANGULAR
!	DECUS$SET_MODE
!	DECUS$BLANK_CHARS
!	DECUS$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
!	decus$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 DECUS$V_BEGIN_SELECT variable when the
! DECUS$SET_RECTANGULAR procedure is executed.  The standard FRED key 
! bindings are restored when the DECUS$SET_NORECTANGULAR procedure is executed.
!

!+
!   Procedure to calculate the current column from the current offset, treating
!   TAB characters as up to 8 blanks.
!-
PROCEDURE decus$_current_column
   LOCAL i,
	line,
	col;

   line := CURRENT_LINE;
   if INDEX (line,ASCII(9)) = 0 then
      decus$_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;
      decus$_current_column := col;
   endif;
ENDPROCEDURE;

!+
!   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.
!-
PROCEDURE decus$_replace_tabs_with_blanks_and_pad(target_length)
   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 (decus$blank_chars (target_length - cur_length));
   endif;

   MOVE_HORIZONTAL (-CURRENT_OFFSET);
ENDPROCEDURE;


PROCEDURE decus$draw_box
   LOCAL saved_mode,
	end_column,
	start_column,
	temp,
	end_select,
	top_bottom_text;

   if decus$v_begin_select = 0 then		!   Check for no select active
      MESSAGE ("Select not active");
      RETURN;
   endif;

   saved_mode := decus$set_mode(INSERT);	!  Set INSERT mode

!+
!   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.
!-
   decus$pad_blank;
   if MARK (none) >= decus$v_begin_select then
      end_select := MARK (none);
   else
      end_select := decus$v_begin_select;
      decus$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 DECUS$V_BEGIN_SELECT.  Figure out
!   the start column.
!-
   end_column := decus$_current_column;
   POSITION (decus$v_begin_select);
   decus$v_begin_select := MARK (none);
   start_column := decus$_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 (decus$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 := '+' + decus$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.
!-
   decus$_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.
!-
      decus$_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.
!-
   decus$_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 (decus$v_begin_select);
   decus$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 decus$rectangular_remove
   LOCAL saved_mode,
	end_select,
	end_column,
	start_column,
	temp,
	pad_chars,
	save_position,
	blank_chars,
	cut_text;

   if decus$v_begin_select = 0 then	! Check for no select active
      MESSAGE ("Select not active");
      RETURN;
   endif;

   saved_mode := decus$set_mode(INSERT);! Set INSERT mode and erase PASTE_BUFFER
   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.
!-
   decus$pad_blank;
   if MARK (none) >= decus$v_begin_select then
      end_select := MARK (none);
   else
      end_select := decus$v_begin_select;
      decus$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 DECUS$V_BEGIN_SELECT.  Figure out
!   the start column.
!-
   end_column := decus$_current_column;
   POSITION (decus$v_begin_select);
   decus$v_begin_select := MARK (none);
   start_column := decus$_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 := decus$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.
!-
      decus$_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 (decus$v_begin_select);
   decus$v_begin_select := 0;
   MOVE_HORIZONTAL (-CURRENT_OFFSET);
   MOVE_HORIZONTAL (start_column);
   SET (saved_mode, CURRENT_BUFFER);
ENDPROCEDURE;



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

   save_buffer := CURRENT_BUFFER;
   save_position := MARK (none);
   start_column := decus$_current_column;
   save_mode := decus$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);
      paste_line := CURRENT_LINE;	! Get the current line of the paste buffer.
      MOVE_VERTICAL (1);

!+
!   Convert tabs to blanks on the line in the current buffer.
!-
      POSITION (save_buffer);
      decus$_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 decus$rectangular_select
   if decus$v_begin_select = 0 then
      decus$pad_blank;
      decus$v_begin_select := MARK (reverse);
      MESSAGE ("Selection started.  Press Remove when finished.");
   else
      decus$v_begin_select := 0;
      MESSAGE ("Selection cancelled");
   endif;
ENDPROCEDURE;
    


!+
! 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.
!-       
PROCEDURE decus$pad_blank
   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 decus$set_rectangular
   decus$v_begin_select := 0;
   SET (informational,off);
   if decus$x_rectangular_set = 0 then
      decus$x_rectangular_set := 1;
      ADD_KEY_MAP (eve$x_key_map_list, eve$kt_first, fred$x_reccutpas_keys);
      MESSAGE ("Rectangular CUT/PASTE mode selected.");
   else
      decus$x_rectangular_set := 0;
      REMOVE_KEY_MAP (eve$x_key_map_list, fred$x_reccutpas_keys, ALL);
      MESSAGE ("Standard REMOVE/INSERT mode selected.");
   endif;
   SET (informational,on);
   eve$update_status_lines;
ENDPROCEDURE;


!+
! This procedure returns the current mode for the current buffer
! and sets it to the value in NEW_MODE.
!-
PROCEDURE decus$set_mode (new_mode)
   decus$set_mode := GET_INFO (CURRENT_BUFFER,"mode");
   SET (new_mode, CURRENT_BUFFER);
ENDPROCEDURE;



!+
! This procedure returns a string of decus$v_blank_count blank chars.
!-
PROCEDURE decus$blank_chars (decus$v_blank_count)
   LOCAL decus$v_blank_chars,
	decus$v_oldlen,
	decus$v_blanks_so_far;	! Length of blank char string so far

   if decus$v_blank_count = 0 then
      RETURN "";
   endif;

   decus$v_blank_chars := " ";
   decus$v_blanks_so_far := 1;
   loop
      exitif decus$v_blanks_so_far >= decus$v_blank_count;
      decus$v_oldlen := LENGTH (decus$v_blank_chars);
      decus$v_blank_chars := decus$v_blank_chars + decus$v_blank_chars;
      decus$v_blanks_so_far := decus$v_blanks_so_far + decus$v_oldlen;
   endloop;
    
   if decus$v_blanks_so_far > decus$v_blank_count then
      decus$v_blank_chars :=
	    SUBSTR(decus$v_blank_chars,1,decus$v_blank_count);
   endif;
   RETURN decus$v_blank_chars;
ENDPROCEDURE;



!+
! This procedure advances current_offset to be decus$v_columns from
! current_offset.  decus$v_blanks_chars must be
! a string of blank chars of at least length decus$v_columns.
!-
PROCEDURE decus$advance_horizontal (decus$v_columns,decus$v_blank_chars)
   LOCAL decus$v_save_offset,		! current_offset on entry to this procedure
	decus$v_eol_columns;		! Number of columns to [EOL]

   decus$v_save_offset := CURRENT_OFFSET;
   if decus$v_columns <= 0 then
      MOVE_HORIZONTAL (decus$v_columns);
   else
!+
! Find out how far to [EOL].
!-
      decus$v_eol_columns := LENGTH (CURRENT_LINE) - CURRENT_OFFSET;
      if decus$v_eol_columns >= decus$v_columns then
         MOVE_HORIZONTAL (decus$v_columns);
      else
	 MOVE_HORIZONTAL (decus$v_eol_columns);
         COPY_TEXT (SUBSTR (decus$v_blank_chars,1,
			     decus$v_columns-decus$v_save_offset));
      endif;
   endif;
ENDPROCEDURE;

PROCEDURE tpu$local_init
   decus$v_begin_select := 0;
   decus$x_rectangular_set := 0;
   if (fred$test_for_key_map("fred$reccutpas_keys") = 0) then
      fred$x_reccutpas_keys := CREATE_KEY_MAP ("fred$reccutpas_keys");
      DEFINE_KEY ("decus$draw_box",ctrl_d_key,
		" draw_box",fred$x_reccutpas_keys);
      DEFINE_KEY ("decus$rectangular_remove", e3,
		" rectangular_cut",fred$x_reccutpas_keys);
      DEFINE_KEY ("decus$rectangular_insert_here", e2, 
		" rectangular_paste",fred$x_reccutpas_keys);
      DEFINE_KEY ("decus$rectangular_select", e4,
		" rectangular_select",fred$x_reccutpas_keys);
   else
      fred$x_reccutpas_keys := "fred$reccutpas_keys";
   endif;
ENDPROCEDURE