                { --- Block command subroutines }

procedure block_hide_display;
begin
block_flag:=not block_flag;
display_rest_page(page_top_index,SCREENLEFT,SCREENTOP);
end; { block_hide_display }

procedure begin_block;
begin
block_begin:=index; block_flag:=(block_begin<=block_end);
display_rest_page(page_top_index,SCREENLEFT,SCREENTOP);
end; { begin_block }

procedure end_block;
begin
block_end:=index-1; block_flag:=(block_begin<=block_end);
display_rest_page(page_top_index,SCREENLEFT,SCREENTOP);
end; { end_block }

procedure mark_single_word;
begin
block_begin:=index;
while (block_begin>TEXTSTART) and (text[block_begin-1] in alphanums) do
    block_begin:=block_begin-1;
block_end:=index-1;
while (block_end<text_end) and (text[block_end+1] in alphanums) do
    block_end:=block_end+1;
block_flag:=(block_begin<=block_end);
display_rest_page(page_top_index,SCREENLEFT,SCREENTOP);
end; { mark_single_word }

procedure copy_block;
var i,l,cr_count:integer;
begin
if block_flag and ((index<=block_begin) or (block_end<index)) then
    begin
    l:=block_end-block_begin+1;
    if l>0 then
        begin
        if text_end+l>TEXTLIMIT then
            prompt_for_esc('Text buffer too short. Block not copied.')
        else
            begin
            cr_count:=0;
            for i:=block_begin to block_end do
                if eol(i) then cr_count:=cr_count+1;
            if index<block_begin then
                begin block_begin:=block_begin+l; block_end:=block_end+l; end;
            for i:=text_end downto index do text[i+l]:=text[i];
            for i:=0 to l-1 do text[index+i]:=text[block_begin+i];
            text_end:=text_end+l; n_lines:=n_lines+cr_count;
            block_begin:=index; block_end:=block_begin+l-1;
            restore_page(index,cx,cy);
            end;
        end;
    end;
end; { copy_block }

procedure quick_move(l:integer);
{copy block behind text, move intermediate portion, copy block back into text}
var i:integer;
begin
for i:=0 to l-1 do text[text_end+1+i]:=text[block_begin+i];
if index<block_begin then                 {move intermediate portion down}
    for i:=block_begin-1 downto index do text[i+l]:=text[i]
else                                      {move intermediate portion up}
    begin
    for i:=block_end+1 to index-1 do text[i-l]:=text[i];
    index:=index-l;
    end;
for i:=0 to l-1 do text[index+i]:=text[text_end+1+i];
end; { quick_move }

procedure slow_move(l:integer);
{save block character, move intermediate portion, restore block character}
var i,j:integer;
begin
prompt('Moving slowly. Please wait...');
for j:=0 to l-1 do
    begin
    if index<block_begin then                 {move intermediate portion down}
        begin
        ch:=text[block_begin+j];
        for i:=block_begin-1+j downto index+j do text[i+1]:=text[i];
        text[index+j]:=ch;
        end
    else                                      {move intermediate portion up}
        begin
        ch:=text[block_end-j]; index:=index-1;
        for i:=block_end+1-j to index do text[i-1]:=text[i];
        text[index]:=ch;
        end;
    end;
unprompt;
end; { slow_move }

procedure move_block;
var l:integer;
begin
if (block_flag) and ((index<block_begin) or (block_end<index)) then
    begin
    l:=block_end-block_begin+1;
    if l>0 then
        begin
        if text_end+l<=TEXTLIMIT then quick_move(l) else slow_move(l);
        block_begin:=index; block_end:=block_begin+l-1;
        restore_page(index,cx,cy);
        end;
    end;
end; { move_block }

procedure delete_block;
var l:integer;
begin
if block_flag then
    begin
    l:=block_end-block_begin+1;
    if l>0 then
        begin
        index:=block_begin; find_page(index,cx,cy);
        delete_chars(l,true); block_flag:=false;
        end;
    end;
end; { delete_block }

procedure read_block_from_disk;
var i:integer;
begin
repeat
    prompt_for_filename(blockname,'Read block from file: ');
    if not empty_string(blockname) then
        begin
        open_readfile(blockname,blockfile);
        if file_flag then
            begin
            i:=text_end+1; read_text_from_file(blockfile);
            block_begin:=i; block_end:=text_end;
            for i:=block_begin to block_end do
                 if eol(i) then n_lines:=n_lines+1;
            block_flag:=true; move_block;
            end;
        end;
until file_flag or empty_string(blockname);
end; { read_block_from_disk }

procedure write_block_to_disk;
var i:integer;
begin
repeat
    prompt_for_filename(blockname,'Write block to file: ');
    if not empty_string(blockname) then
        begin
        open_writefile(blockname,blockfile,true);
        if file_flag then write_text_to_file(blockfile,block_begin,block_end);
        end;
until file_flag or empty_string(blockname);
end; { write_block_to_disk }

