# Perl script not to be run as stand_alone program, but in the context of PFE.
# From PFE define extra command (Options/Preferences/Execute Menu) like
#   Perl c:\Perl\Progs\Pfe\EvalPFE.pfe
# PFE will then call this script using Perl, and communicating via DDE links
#
# This particular script will copy a rectangular area from the current text file
# based on the current selection. The data copied will be put in a file
# %TEMP%\_columns.pfe for further rectangular paste operations.
#
# Script written by C.M. Moerman, April 2001 (c)
#   http://home.hccnet.nl/Kees.Moerman/perl_pfe.html  mailto:moerman@iaehv.nl
#
# PFE by Alan Phillips can be found on: http://www.lancs.ac.uk/people/cpaap/pfe/
# Win32::Editor::PFE by Jenda Krynicky can be found on http://jenda.krynicky.cz/
#
# Note: this script does not yet handle tabs!!

use Win32::Editor::PFE;                 # implicitly also loads Win32::DDE
use Win32::Clipboard;
use strict;                             # strict error checking


my $clip = Win32::Clipboard();          # get clipboard object
my $save_clipboard = $clip->Get();      # save contents for later

my $pfe = new Win32::Editor::PFE;       # get pfe object
message("Can't connect to PFE") if !defined $pfe;
$pfe->Connect();                        # get a connection to PFE


sub message                             # print message, wait for key, and die
{
    print "$_[0]\nScript halted\nPress key to continue.....";
    my $temp = <>;
    $clip->Set($save_clipboard);        # restore clipboard
    exit;
}

sub wait_ready                          # wait until link becomes available
{
    for (0..5)                          # with timeout at 6 seconds
    {
        return if ($pfe->Get('Status') eq 'Ready');
        sleep(1);
    }
    message "PFE does not respond" if ($pfe->Get('Status') ne 'Ready');
}


# Note: top of file: PFE pos (1,1), this script (0,0)
# Selecting a 2x2 character block (2 right, 1 down) makes this PFE(3,2), this(2,1)
wait_ready();
my $column2 = $pfe->Get('ColumnNumber') - 1;

wait_ready();
message "Could not cut" if !$pfe->EditCut(); # place selected text on clipboard

wait_ready();
my $column1 = $pfe->Get('ColumnNumber') - 1;
my $width = $column2 - $column1;

wait_ready();
my $text = $clip->Get();                # retrieve selected text
my $result = "";
my $status;

if(length($text))                       # if non-zero length
{
    my @lines = split (/\n/, $text);    # array of lines captured
    
    $lines[0] =~ s/[\x0A\x0D]//g;       # first line adapted for cursor offset
    $lines[0] = (" " x $column1) . $lines[0];
    
    for (@lines)                        # treat all lines
    {
        s/[\x0A\x0D]//g;
        if(length($_) <= $column1)      # short line, return unmodified
        {
            $result .= (" " x $width) . "\n";
        }
        elsif (length($_) <= $column2)  # (partly) within column
        {                               # substr( string, offset, length, newval)
            $result .= substr($_ . (" " x $width), $column1, $width) . "\n";
        }
        else                            # long line
        {
            $result .= substr($_, $column1, $width) . "\n";
        }
    }

    for (1..10)                         # retry: might be busy or fail otherwise?
    {
        wait_ready();
        $status = $pfe->EditPaste();    # put back data, check if succeeded
        last if $status == 1; 
        print ".";                      # else retry
    }
    message "Could not paste" if ($status != 1);
}

    
my $dirname = $ENV{'TEMP'} || $ENV{'TMP'} || "C:";
open (FILENAME, ">$dirname/_columns.pfe")        # open file for output
|| message "Can't open file '$dirname/_columns.pfe' ($!)";
print FILENAME $result;                 # save rectangle to file
close FILENAME;

undef $pfe;
$clip->Set($save_clipboard);            # restore clipboard

# $result = <>;                         # for debug only

# end of script