#!perl -w

use strict;
use warnings;
use Prima;
use Prima::Application name => "PrLenS";
use Prima::Edit;
use Prima::ExtLists;
use App::PLab::ImageApp;
use App::PLab::Calibrations;
use Prima::IPA qw/Local Misc Point Global Morphology Region/;
use Prima::VB::VBLoader;
use XML::Parser;

$::application-> icon( App::PLab::ImageAppGlyphs::icon( bga::processes));


package LenWindow;
use vars qw(@ISA);
@ISA = qw(App::PLab::Calibrations);

use constant MAXDATASET => 5;

sub win_inidefaults
{
   my $w = $_[0];
   return (
      $w-> SUPER::win_inidefaults,
      PointSize          => 4,
      nLines             => 6,
      autoCrispen        => 0,
      autoStretch        => 0,
      StatisticsWindowRect => '120 120 400 250',
      StatisticsWindowFont => 0,
      SpectrumMin        => 0,
      SpectrumMax        => 50,
      ShowExtras         => 0,
      ShowPrevExtras     => 0,
      C_minUF            => 1,
      C_maxUF            => 5,
      C_stepUF           => 10,
      C_min_area         => 200,
      C_min_rank         => 1,
      C_max_index        => 255,
      C_min_index        => 0,
      C_dilations        => 2,
      C_branch_radius    => 3,
      active_datasets    => 2,
      dataset_0_name     => 'cells',
      dataset_1_name     => 'processes',
      ( map { ( "dataset_${_}_name", "dataset" . ($_+1) ) } 2 .. MAXDATASET ),
      visible_datasets   => 0xffff,
   );
}


sub on_create
{
   my $self = $_[0];
   my $w    = $_[0];
   $self-> SUPER::on_create;
   $self-> {dataExt}            = 'pls';
   
   my $tb  = $self-> ToolBar;
   my $scale = $::application-> uiScaling;
   $scale = 1 if $scale < 1;

   my %btn_profile = (
     glyphs      => 1,
     text        => "",
     selectable  => 0,
     transparent => 1,
     flat        => 1,
     size        => [ map { $_ * $scale } 36, 36],
     borderWidth => 1,
     enabled     => 0,
   );

   $tb-> insert(
      [ SpeedButton =>
         name    => "MarkCells",
         origin  => [120 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::cells),
         onClick => sub { $w-> mark_cells },
         hint    => "Mark cells mode",
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "MarkProcesses",
         origin  => [160 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::processes),
         onClick => sub { $w-> mark_processes} , 
         hint    => "Mark processes mode",
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "DrawProcesses",
         origin  => [200 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::drawprocesses),
         onClick => sub { $w-> draw_processes} ,
         hint    => "Draw processes mode",
         %btn_profile,
      ],
      [ Label =>
         name => "CellsProcesses",
         font => { size => 10, pitch => fp::Fixed}, 
         color => cl::Red,
         origin => [ 249 * $scale, 8 * $scale],
	 size   => [ 80 * $scale, 20 * $scale],
         transparent => 1,
         text   => "???:???",
	 valignment => ta::Middle,
      ],
      [ Widget => 
          name => "MarkStateEx",
          transparent => 1,
          origin  => [ 336 * $scale, 8 * $scale],
          size    => [ 20 * $scale, 20 * $scale],
          color   => 0,
          onPaint => sub {
             my ( $self, $canvas) = @_;
             my $c = $self-> color;
             return unless $c;
             $canvas-> color( cl::Black);
             $canvas-> fill_ellipse( map { $_ * $scale } 10, 10, 10, 10);
             $canvas-> color( $c);
             $canvas-> fill_ellipse( map { $_ * $scale } 10, 10, 8, 8);
          },
      ], 
      [ Label =>
         name => "MarkState",
         autoWidth => 1,
         font => { size => 10, pitch => fp::Variable},  
         transparent => 1,
         color => cl::Black,
         origin => [ 356 * $scale, 8 * $scale],
	 height => 20 * $scale,
	 valignment => ta::Middle,
         onMouseDown => sub {
            my ( $self, $btn, $mod, $x, $y) = @_;
            if ( ! defined( $w-> { markState}) || $w-> { markState} < 16) {
               $w-> reset_mark_state(( $mod & km::Shift) ? 'prev' : 'next');
            }
         }
      ],
   );
   $w-> menu-> EditAutoCrispening-> checked( $w-> {ini}-> {autoCrispen});
   $w-> menu-> EditAutoStretching-> checked( $w-> {ini}-> {autoStretch});
   $w-> reset_mark_state;
   $w-> {layers} = [ map { $w-> {ini}-> {"dataset_${_}_name"}} 0 .. $w->{ini}->{active_datasets} - 1];
}

sub xmlload
{
   my ( $w, $file, $recalculate) = @_;
   my %state = ();
   my ( $smin, $smax) = $w-> win_getseriesrange;
   my %totals = ( Branches => 0, Length => 0, Cells => 0, Processes => 0);
   $w-> {branches} = [];
   $w-> {info} = {};
   $w-> {layers} = [qw(cells processes)];

   my $xml = new XML::Parser( Handlers => {
      Start => sub {
         my ($obj, $el, %attrs) = @_;
         return if $state{finished_header};
         if ($el eq 'prlens_data') {
            return if $state{seen_header};
            $state{prlens_data} = {%attrs};
            $state{seen_header} = 1;
            for ( qw( lines filemaskwidth xcalib ycalib )) {
               die "No tag:$_" unless defined $attrs{$_};
            }

            # calibrations
            if ( $attrs{xcalib} != $w->{ ini}->{ XCalibration} ||
                 $attrs{ycalib} != $w->{ ini}->{ YCalibration} ) {
               if ( Prima::MsgBox::message(
                         "Image contains calibrations [$attrs{xcalib}:$attrs{ycalib}] opposite to current [".
                          $w->{ini}->{XCalibration}.':'.$w->{ini}->{YCalibration}.']. '.
                          "Keep current settings?",
                          mb::YesNo|mb::Warning, { buttons => { mb::No , { text => '~Apply new'}}}) == mb::Yes) {
                  $w-> modified( 1);
               } else {
                  $w->{ini}->{XCalibration} = $attrs{xcalib};
                  $w->{ini}->{YCalibration} = $attrs{ycalib};
               }
            }

            # nlines 
            if ( $attrs{lines} != $w->{ ini}->{ nLines}) {
               if ( Prima::MsgBox::message("Image contains $attrs{lines} lines opposite to current $w->{ini}->{nLines} ".
                          "Keep current settings?",
                          mb::YesNo|mb::Warning, { buttons => { mb::No , { text => '~Apply new'}}}) == mb::Yes) {
                  $w-> modified( 1);
               } else {
                  $w->{ini}->{nLines} = $attrs{lines};
               }
            }

            # datasets
            if ( exists $attrs{datasets}) {
               my $id = 2;
               for ( split( ',', $attrs{datasets})) {
                  push @{$w-> {layers}}, $_;
                  $w-> {ini}-> {"dataset_${id}_name"} = $_;
                  $w-> {"total$_"} = $w-> {"n$_"} = 0;
                  $id++;
               }
               $w-> {ini}-> {active_datasets} = ( $id > 10) ? 10 : $id;
            } else {
               $w-> {ini}-> {active_datasets} = 2;
            }
         } elsif ( $el eq 'record') {
            return unless $state{seen_header};
            return if $state{reading_record};
            $state{reading_record} = 1;
            for ( qw( index)) {
               die "No tag:$_" unless defined $attrs{$_};
            }
            $state{record_index} = $attrs{index};
            $state{branch_index} = 0;
            die "Invalid index $attrs{index}" unless $attrs{index} =~ /^\d+$/;
         } elsif ( $el eq 'layer') {
            return unless $state{seen_header} && $state{reading_record};
            return if $state{reading_layer} || $state{reading_branch};
            $state{reading_layer} = 1;
            for ( qw( type number points)) {
               die "No tag:$_" unless defined $attrs{$_};
            }
            my $lctype = lc $attrs{type};
            my $uctype = ucfirst $lctype;
            my @data = split(',', $attrs{points});
            die "Inconsistent number of '$lctype' points in index $state{record_index}" unless
               $attrs{number} =~ /^\d+$/ && $attrs{number} == scalar @data;

            # handle current frame
            if ( $state{record_index} == ($w-> {fileNum} // 0)) {
               $w-> {'n' . $uctype} = scalar @data;
               $w-> { $lctype} = [ @data ];
            } elsif ( $state{record_index} == $smin) {
            # handle first frame
               $w-> {'ex' . $uctype} =  [ @data ];
            } 
	    if ( $state{record_index} == ($w-> {fileNum} // 0 ) - 1) {
            # handle previous frame
               $w-> {'prevex' . $uctype} =  [ @data ];
	    }
            # store record
            $w-> {info}->{$state{record_index}}-> {$lctype} = [@data];
            $totals{$uctype} += scalar @data;
         } elsif ( $el eq 'branch') {
            return unless $state{seen_header} && $state{reading_record};
            return if $state{reading_layer} || $state{reading_branch};
            $state{reading_branch} = 1;
            for ( qw( start outline length)) {
               die "No tag:$_" unless defined $attrs{$_};
            }
            die "Invalid 'length' attribute in branch \#$state{record_index}" unless
               $attrs{length} =~ m/^[\d\.]+$/;
            die "Invalid 'start' attribute in branch \#$state{record_index}" unless
               $attrs{start} =~ m/^\s*(\d+)\s*(\d+)\s*$/;
            my ( $x, $y) = ( $1, $2);
            my @data = ([$x, $y]);
            while ( $attrs{outline} =~ m/([\+\-]\d+)([\+\-]\d+)/g) {
               $x += $1;
               $y += $2;
               push @data, [ $x, $y];
            }
            $w-> {info}->{$state{record_index}}->{branches}->[$state{branch_index}] = \@data;
            $w-> {branches} = $w-> {info}->{$state{record_index}}->{branches} if 
               $state{record_index} == $w-> {fileNum};
            $totals{Branches}++;
            $totals{Length} += $attrs{length};
         }
      }, End => sub {
         my ($obj, $el) = @_;
         $state{finished_header} = 1 if $el eq 'prlens_data';
         $state{reading_record}  = 0 if $el eq 'record';
         $state{reading_layer}  = 0 if $el eq 'layer';
         if ( $el eq 'branch') {
            $state{reading_branch} = 0;
            $state{branch_index}++;
         }
      },
   });
   eval { parsefile $xml $file; };
   if ($@) {
      $w-> win_xmlerror( $file);
      return;
   }
   $w-> {'total' . $_} = $totals{$_} for keys %totals;
}

sub win_abortpacket { $_[0]-> {packetAborted} = 1 }

sub win_xmlerror
{
   # bad
   my ($w, $xmlname) = @_;
   my $at = $@;
   Prima::MsgBox::message("Cannot load $xmlname", mb::OKCancel,
         { buttons => { mb::Cancel => {
            text        => '~Details >>',
            modalResult => 0,
            onClick     => sub {
               Prima::MsgBox::message_box( "XML loader diagnostics", "$xmlname:$at", mb::OK|mb::NoSound);
            },
     }}});
   $w-> win_abortpacket;
}

sub load_info
{
   my ( $w, $recalculate) = ( $_[ 0], $_[ 1]);
   my ( $cpm) = ( $w-> {cypherMask});
   my $file = $w-> win_extname( $w-> {file});
   $file =~ s/\d{$cpm}(\.pls)$/$1/;
   $w-> {info} = {};
   $w-> {layers} = [ 'cells', 'processes'];
   $w-> {ini}-> {active_datasets} = 2;
   $w-> {totalCells} = $w-> {totalProcesses} = $w-> {totalLength} = $w-> {totalBranches} = 0;

   return unless open INFO, $file;

   $_=<INFO>; chomp;
   if ( m/xml/) { # new style
      close INFO;
      return $w-> xmlload( $file, $recalculate);
   } # else first line is skipped, but anyway it's always comment
   
   my $info = $w-> {info};
   my ($totalCells,$totalProcesses,$totalBranches,$totalLength) = (0,0,0,0);
   my ( $smin, $smax) = $w-> win_getseriesrange;

   while (<INFO>)
   {
      s/\r$//;
      next if /^$/;
      if ( /^#\*/) {
          /^#\*([^\:]+)\:\s*(.*)$/;
          my ( $field, $value) = ( $1, $2);
          if ( $field =~ /Calibrations/i) {
              my ( $xcalib, $ycalib) = split ' ', $value, 2;
              $xcalib =~ s/^\s*(\S+)\s*$/$1/;
              $ycalib =~ s/^\s*(\S+)\s*$/$1/;
              if ( ( $xcalib =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) && ( $ycalib =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)) {
                  $xcalib += .0;
                  $ycalib += .0;
                  if (( $xcalib != $w->{ ini}->{ XCalibration})  ||
                      ( $ycalib != $w->{ ini}->{ YCalibration})) {
                      if ( Prima::MsgBox::message("Image contains calibrations [$xcalib $ycalib] opposite to current [".
                          $w->{ini}->{XCalibration}.' '.$w->{ini}->{YCalibration}.']. '.
                          "Keep current settings?",
                          mb::YesNo|mb::Warning, { buttons => { mb::No , { text => '~Apply new'}}}) == mb::Yes) {
                          $w-> modified( 1);
                      } else {
                          $w->{ini}->{XCalibration} = $xcalib;
                          $w->{ini}->{YCalibration} = $ycalib;
                      }
                  }
              } else {
                  Prima::message("Incorrect Calibrations field value");
              }
          }
      }
      next if /^#/;
      next unless m{^\s*            # optional space
                    (\d+)           # number of cells
                    \s+             # space
                    (\d+)           # number of processes (intersections)
                    \s+             # space
                    (\d\d)          # file number
                    ::              # delimiter
                    ([\d_\,]*)     # coordinates of cell marks
                    ::              # delimiter
                    ([\d_\,]*)     # coordinates of processes marks
                    (?:
                    ::              # delimiter
                       ((?:(?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?\&)?) # average process length
                       ([\d_\,\+\-]*)
                       # hand-drawn branches
                   )?
                   $}x;
      my ($nc,$np,$fn,$ccm,$cpm,$abl,$cbm) = ($1,$2,$3,$4,$5,$6,$7);
      $abl = '' unless defined $abl;
      $cbm = '' unless defined $cbm;

      $cbm =~ tr[_][\ ];
      my @branches = split ',', $cbm;
      $abl =~ s{\&$}{};

      $totalCells += $nc;
      $totalProcesses += $np;
      $totalLength += $abl if $abl;
      $totalBranches += scalar( @branches);
      my $fninfo = $info-> {$fn} = {
         cells     => [],
         processes => [],
         branches  => [],
      };
      my ( $isCurrentFrame) = $fn == $w-> {fileNum};
      $ccm =~ tr[_][\ ];
      my @cells = split ',', $ccm;
      Prima::message("Bad number of cells") if scalar @cells != $nc;

      $cpm =~ tr[_][\ ];
      my @processes = split ',', $cpm;
      Prima::message("Bad number of processes") if scalar @processes != $np;

      if ( $fn == $smin && !$isCurrentFrame) {
         $w-> {exCells} = [@cells];
         $w-> {exProcesses} = [@processes];
      }
      if ( $fn + 1 == $w->{fileNum}) {
         $w-> {prevexCells} = [@cells];
         $w-> {prevexProcesses} = [@processes];
      }
      
      if ( $isCurrentFrame) {
         $w-> {nCells} = scalar @cells;
         $w-> {nProcesses} = scalar @processes;
         $w-> {cells}     = [@cells];
         $w-> {processes} = [@processes];
      }

      $fninfo->{cells} = \@cells;
      $fninfo->{processes} = \@processes;

      if ( $isCurrentFrame || $recalculate) {
         $w->{ branches} = [] if $isCurrentFrame;
         my ( $pb) = ( []);
         my ( $branch);
         my ( $bnum) = 0;
         foreach $branch ( @branches) {
            $branch =~ s/^((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?) ((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)(.*)/$3/;
            my ( $x, $y) = ( int( $1), int( $2));
            $pb->[ $bnum]->[ 0] = [ $x, $y];
            while ( length( $branch) > 0) {
               last unless ( $branch =~ s/^([\+\-]\d+)([\+\-]\d+)//);
               my ( $dx, $dy) = ( $1, $2);
               $x += $dx;
               $y += $dy;
               push @{ $pb->[ $bnum]}, [ $x, $y];
            }
            if ( length( $branch) > 0) {
               Prima::message("Bad branches description format");
            }
            $bnum++;
         }
         $w->{ branches} = $pb if $isCurrentFrame;
         $fninfo->{branches} = $pb;
         $abl = sprintf "%.3f", $w-> calc_branches_length( $pb);
         $ccm =~ tr[\ ][_];
         $cpm =~ tr[\ ][_];
         $cbm =~ tr[\ ][_];
         # $info->{ $fn} = "$nc $np $fn\:\:$ccm\:\:$cpm\:\:$abl\&$cbm\n";
         undef @branches;
      }
   }
   close INFO;
   $w-> {totalCells} = $totalCells;
   $w-> {totalProcesses} = $totalProcesses;
   $w-> {totalLength} = $totalLength;
   $w-> {totalBranches} = $totalBranches;
}

sub save_info
{
   my $w = $_[0];
   return 1 unless $w-> modified;
   my $file = $w-> {file};
   return 1 unless defined $file;
   my $info = $w-> {info};
   return 1 unless defined $info;
   my $fnx = '%0' . $$w{cypherMask} . 'd';
   $fnx = sprintf $fnx, ( $w-> {fileNum} || 0);
   $info->{$fnx}->{$_} = $w-> {$_} for (@{$w->{layers}}, 'branches');
   my $xmlname = $w-> win_extname( $w-> {file});
   my ( $cpm) = ( $w-> {cypherMask});
   $xmlname =~ s/\d{$cpm}(\.pls)$/$1/;
   unless ( open F, "> $xmlname") {
      if ( $w->{silence}) {
         $w-> win_abortpacket;
         return 0;
      }
      return 0 if Prima::MsgBox::message(
         "Error saving file $xmlname. Ignore changes?", mb::YesNo|mb::Warning) == mb::No;
   }
   my $datestr = scalar(localtime(time));
   my ($ix,$iy) = $w-> IV-> image-> size;
   my @l = @{$w->{layers}};
   my $sets = join(',', @l[2 .. $#l]) // '';
   my $stats = $w-> generate_statistics_text;

   my $beg = $w->{fileBeg} // '';
   my $end = $w->{fileEnd} // '';

print F <<HEADER;
<?xml version="1.0"?>
<!DOCTYPE prlens_data SYSTEM "prlens_data.dtd">
<!-- This is a generated file.  Do not edit! 
$stats
-->
<prlens_data
  series         = "$beg"
  imageext       = "$end"
  imagewidth     = "$ix"
  imageheight    = "$iy"
  creator        = "PrLenS"
  creationdate   = "$datestr"
  xcalib         = "$w->{ini}->{XCalibration}"
  ycalib         = "$w->{ini}->{YCalibration}"
  filemaskwidth  = "$w->{cypherMask}"
  lines          = "$w->{ini}->{nLines}"
  pointsize      = "$w->{ini}->{PointSize}"
  datasets       = "$sets"
HEADER
   printf F "  total%-10s= \"%d\"\n", ucfirst, $w->{'total'.ucfirst} for @l;
   print F ">\n";
  
   for ( sort keys %$info) {
      print F "<record index=\"$_\">\n";
      my $r = $info->{$_};
      for ( keys %$r) {
         if ( $_ eq 'branches') {
            for ( @{$r->{$_}}) {
               my $br = $_;
               my ( $x, $y) = @{$$br[0]};
               my ( $sx, $sy) = ( $x, $y);
               my $first = 0;
               my $outline = '';
               for ( @$br) {
                  next unless $first++;
                  my ( $nx, $ny) = @$_;
                  $outline .= sprintf("%+d%+d", $nx - $x, $ny - $y);
                  $x = $nx;
                  $y = $ny;
               }
               my $len = sprintf "%.3f", $w-> calc_branch_length( $br);
               print F <<BRANCH;
  <branch start="$sx $sy"
    outline="$outline"
    length="$len"
  />
BRANCH
           }
         } else {
            my $d = $r->{$_};
            my $nd = scalar @$d;
            my $xd = join ',', @$d;
            print F <<LAYER;
  <layer type="$_"
    number="$nd"
    points="$xd"
  />
LAYER
         }
      }
      print F "</record>\n";
   }
   print F "</prlens_data>\n";

   close F;
   return 1;
}


sub generate_statistics_text {
   my ( $w) = @_;

   my ( $nc, $nb, $sbl) = ( $w->{ nCells}, scalar( @{ $w->{ branches}}),
                            $w-> calc_branches_length( $w->{ branches}));
   my ( $np, $tnp) = ( $w-> {nProcesses}, $w-> {totalProcesses});
   my ( $abl) = ( $nb == 0 ? 0 : $sbl / $nb);
   my ( $blr) = ( $nc == 0 ? 0 : $sbl / $nc);

   my ( $tnc, $tnb, $tbl) = ( $w->{ totalCells}, $w->{ totalBranches}, $w->{ totalLength});
   my ( $cpr, $tcpr) = ( $nc ? $np / $nc : 0, $tnc ? $tnp / $tnc : 0);
   my ( $tabl) = ( $tnb == 0 ? 0 : $tbl / $tnb);
   my ( $tblr) = ( $tnc == 0 ? 0 : $tbl / $tnc);

   my $npix = $w-> IV-> image;
   my $inactive = sprintf('%d', $npix-> height / 20);
   $npix = $npix ? ( $npix-> height - $inactive * 2) / $w-> {ini}-> {nLines}: 0;
   my ($fmin, $fmax) = $w-> win_getseriesrange;
   my $n = $fmax - $fmin + 1;
   my $res = 1;

   my ( $fw, $pi2) = ( 10, 1.570796); # Field width

   my @params = (
      "This", "Total", "Average", 
      "frame",

      $w->{ini}->{nLines},
      $npix, 
      $n,
      $res,
      
      $nc, $tnc, $tnc / $n,
      $np, $tnp, $tnp / $n, 
      $cpr, $tcpr, $tcpr / $n,
      $np * $npix * $pi2, $tnp * $npix * $pi2, $tnp * $npix * $pi2 / $n,
      $np * $npix * $pi2 * $res, $tnp * $npix * $pi2 * $res, $tnp * $npix * $pi2  * $res/ $n,
      $cpr * $npix * $pi2, $tcpr * $npix * $pi2, $tcpr * $npix * $pi2 / $n,
      $cpr * $npix * $pi2 * $res, $tcpr * $npix * $pi2 * $res, $tcpr * $npix * $pi2  * $res/ $n,
      
      $nb, $tnb, $tnb / $n,
      $sbl, $tbl, $tbl / $n,
      $abl, $tabl, $tabl / $n,
      $blr, $tblr, $tblr / $n,
   );

   my $ret = sprintf <<STOP_HERE, @params;
                                        %${fw}s  %${fw}s  %${fw}s
                                        %${fw}s

Number of lines                       : %${fw}d
Number of pixels in segment (PX)      : %${fw}.3f
Number of images in the series        : %${fw}d
Resolution, micrometers/pixel         : %${fw}.4f

Number of cells (NC)                  : %${fw}d  %${fw}d  %${fw}.3f
Number of process points (NP)         : %${fw}d  %${fw}d  %${fw}.3f
Processes number/cells ratio (NP/NC)  : %${fw}.3f  %${fw}.3f  %${fw}.3f
Length of processes (NP*PX*pi/2) ,pix : %${fw}.3f  %${fw}.3f  %${fw}.3f
                                 ,mkm : %${fw}.3f  %${fw}.3f  %${fw}.3f
Length/cells ratio (NP*PX*pi/2NC),pix : %${fw}.3f  %${fw}.3f  %${fw}.3f
                                 ,mkm : %${fw}.3f  %${fw}.3f  %${fw}.3f

Number of drawn processes (NDP)       : %${fw}d  %${fw}d  %${fw}.3f
Length of processes (PL)              : %${fw}.3f  %${fw}.3f  %${fw}.3f
Average process length (PL/NDP)       : %${fw}.3f  %${fw}.3f  %${fw}.3f
Process length ratio (PL/NC)          : %${fw}.3f  %${fw}.3f  %${fw}.3f

STOP_HERE

   my $i;
   for ( $i = 2; $i < scalar @{$w->{layers}}; $i++) {
      my $l = $w-> {layers}->[$i];
      my $ul = ucfirst $l;
      my ( $nn, $tn) = ( $w-> {"n$ul"}, $w-> {"total$ul"} );
      my ( $c, $tc) = ( $nc ? $nn / $nc : 0, $tnc ? $tn / $tnc : 0);
      my @params = (
        $nn, $tn, $tn / $n,
        $c, $tc, $tc / $n, 
        $nn * $npix, $tn * $npix, $tn * $npix / $n,
        $c * $npix, $tc * $npix, $tc * $npix / $n,
      );
      
      $ret .= sprintf <<FMT, @params;

Number of points of set $i (N$i)           : %${fw}d  %${fw}d  %${fw}.3f
Processes number/cells ratio (N$i/NC)     : %${fw}.3f  %${fw}.3f  %${fw}.3f
Length of processes by points (N$i*PX)    : %${fw}.3f  %${fw}.3f  %${fw}.3f
Processes length/cells ratio (N$i*PX/NC)  : %${fw}.3f  %${fw}.3f  %${fw}.3f
FMT
   }

   return $ret;
}


sub show_stats {
   my $w = $_[0];
   my ( $update_window) = $_[ 2];

   my ( $sd, $norepaint);
   if ( ! ( $sd = eval { $w->Statistics})) {

      return if $update_window;

      my ( @rect) = split ' ', $w->{ ini}->{ StatisticsWindowRect};
      $sd = Prima::Window->create(
         name => 'Statistics',
         rect => [ @rect],
         owner => $w,
         onClose => sub {
            $w->{ ini}->{ StatisticsWindowRect} = join( ' ', $_[ 0]->rect);
         },
         menuItems => [
            [ '~Copy' => sub { $sd-> StatText-> copy } ],
            [ '~Font' => [
               ['~Increase' , 'Ctrl+Plus' , '^+', sub { 
                  my $f = $sd-> StatText-> font;
                  $f-> size( $f-> size + 1);
                  $w->{ini}->{StatisticsWindowFont} = $f-> size;
               }],
               ['~Decrease' , 'Ctrl+Minus' , '^-', sub { 
                  my $f = $sd-> StatText-> font;
                  $f-> size( $f-> size - 1);
                  $w->{ini}->{StatisticsWindowFont} = $f-> size;
               }],
            ]],
         ],
      );

      my %font = ( pitch => fp::Fixed );
      $font{size} = $w->{ini}->{StatisticsWindowFont} if $w->{ini}->{StatisticsWindowFont};
      $sd->insert(
         'Prima::Edit' =>
         name => 'StatText',
         readOnly => 1,
         hScroll => 1,
         vScroll => 1,
         font => \%font,
         origin => [ 0,0],
         size => [ $sd-> size],
         growMode => gm::Client,
         text => $w-> generate_statistics_text(),
         blockType => bt::Vertical,
      );

      $norepaint = 1;
   }

   $sd->StatText->text( $w-> generate_statistics_text()) unless $norepaint;
}

sub file_backup
{
   my $w = $_[0];
   my ( $cpm, $file) = ( $w-> {cypherMask}, $w-> win_extname( $w-> {file}));
   $file =~ s/\d{$cpm}(\.pls)$/$1/;
   return if Prima::MsgBox::message( "Copy $file to $file.bak?", mb::OKCancel) != mb::OK;
   return if -f "$file.bak" and Prima::MsgBox::message( "$file.bak exists. Overwrite?", mb::OKCancel) != mb::OK;
   require File::Copy;
   return if File::Copy::copy( $file, "$file.bak");
   Prima::MsgBox::message( "Error:$!", mb::OK|mb::Error);
}

sub draw_processes {
   my $w = $_[0];
   $w-> done_draw_mode;
   $w->{ binfo}->{ drawMode} = 0;
   undef $w->{ binfo}->{ nearestBranch};
   undef $w->{ binfo}->{ prevActiveRect};
   $w-> reset_mark_state(( defined( $w-> {markState}) && ( $w-> {markState} == 16) ? undef : 16))
      if defined $w-> {file};
   $w-> reset_mark_state( $w, undef) unless defined $w-> {file};
}

sub mark_cells
{
   my $w = $_[0]; 
   $w-> reset_mark_state( 1) if defined $w-> {file};
   $w-> reset_mark_state( undef) unless defined $w-> {file};
}

sub mark_processes
{
   my $w = $_[0];
   $w-> reset_mark_state( 0) if defined $w-> {file};
   $w-> reset_mark_state( undef) unless defined $w-> {file};
}


sub win_newframe
{
   my $w = $_[0];
   $w-> SUPER::win_newframe;
   for ( @{$w->{layers}}) {
      my $c = ucfirst $_;
      $w-> {$_} = [];
      $w-> {"ex$c"} = [];
      $w-> {"prevex$c"} = [];
      $w-> {"n$c"} = $w-> {"total$c"} = 0;
   }
   $w-> {branches} = [];
   $w-> modified(0);
   $w-> reset_mark_state; 
   $w-> {mirrorImage} = undef;
   $w-> {recWindow}-> RestoreBtn-> enabled( 0) if $w-> {recWindow};

   return unless defined $w-> {file};

   $w-> win_extwarn if defined $w-> {ini}-> {path} &&
      defined $w-> {oldPath} && $w-> {oldPath} ne $w-> {ini}-> {path};
   $w-> {oldPath} = $w-> {ini}-> {path};
   $w-> preprocess;
}

sub win_loadfile
{
   my ($w,$file) = @_;
   return 0 unless $w-> SUPER::win_loadfile( $file);
   $w-> update_state;
   return 1; 
}

sub win_newextras
{
   my $w = $_[0];
   $w-> SUPER::win_newextras;

   return unless defined $w-> {file};
   $w-> load_info();
}

sub win_saveframe
{
   my $w = $_[0];
   return $w-> save_info();
}

sub win_closeframe
{
   my $w = $_[0];
   $w-> SUPER::win_closeframe;
   $w-> reset_mark_state;
}


sub win_framechanged
{
   my $w = $_[0];
   $w-> SUPER::win_framechanged;

   my $tb = $w-> ToolBar;
   my $i = $w-> IV-> image;
   my $canApply = defined $i && $i-> type == im::Byte;

   $w-> menu-> FileStats-> enabled( $i);
   $w-> menu-> FileBackup-> enabled( $i);
   $w-> menu-> EditProcess-> enabled( $canApply);   
   $w-> menu-> EditProcessSeries-> enabled( $canApply);   
   $tb-> MarkCells-> enabled( $i);
   $tb-> MarkProcesses-> enabled( $i);
   $tb-> DrawProcesses-> enabled( $i);
   if ( $w-> {recWindow}) {
      my $r = $w-> {recWindow};
      $r-> ApplyBtn-> enabled( $canApply);
      $r-> RestoreBtn-> enabled( $canApply && defined $w-> {mirrorImage});
      $r-> PD1-> enabled( $canApply);
      $r-> PD2-> enabled( $canApply);
      $r-> PD3-> enabled( $canApply);
   }
   $w-> reset_mark_state;
   $w-> update_state;
}


sub reset_mark_state
{
   my ( $w, $state)  = @_;
   unless ( defined $state) {
      my $x = $w-> {markStateX} || 0;
      $state = defined($w-> {file}) ? $x : ( $x | 0x10000);
   } elsif ( $state =~ /^next|prev$/ && defined $w->{file}) {
      if ( defined $w-> {markStateX} && ($w-> {markStateX} & 0x10)) {
         $state = 0;
      } else {
         $state = ($w->{markState} || 0) + (( $state eq 'next') ? 1 : -1);
         $state = 0 if $state >= $w->{ini}->{active_datasets};
         $state = $w->{ini}->{active_datasets} - 1 if $state < 0;
      }
   } elsif ( $state eq 'draw' && defined $w->{file}) {
      $state = 0x10;
   }

   my $markState = $w-> ToolBar-> MarkState;
   my $markStateEx = $w-> ToolBar-> MarkStateEx;
   if ( $state & 0x10000) {
      $markState-> text( "Nothing to mark");
      $markStateEx-> color( 0);
      return;
   }
   if ( $state & 0x10) {
      $markState-> text( "Drawing processes" . ( $w->{ binfo}->{ drawMode} ? " (drawing)" : "")) ;
      $markStateEx-> color( 0);
   } else {
      my $layer = $w-> {layers}->[$state];
      $markState-> text( "Marking $layer");
      $markStateEx-> color( $w-> {ini}-> {"Color_" . (( $state < 2) ? ucfirst $layer : "Dataset$state")});
   }
   $w-> {markStateX} = $state;
   $w-> {markState} = ($state & 0x10000) ? undef : $state;
}


sub initiate_draw_mode 
{
   my ( $w, $x, $y) = @_;
   my $self = $w-> IV;
   return unless ( $w->{ markState} == 16) && ( ! $w->{ binfo}->{ drawMode});
   $w->{ binfo}->{ drawMode} = 1;
   $w->{ binfo}->{ removeLastPoint} = 1;
   $w-> iv_cancelmagnify( $self);
   $self-> capture(1);
   $w->{ binfo}->{ branchNumber} = scalar @{ $w->{ branches}};
   $w->{ branches}->[ $w->{ binfo}->{ branchNumber}]->[ 0] = [ $self-> screen2point( $x, $y)];
   $w-> modified( 1); 
   $w-> reset_mark_state( 'draw');
}

# Function calculates distance from a point at ( x3, y3)
# to a segment of line defined with coordinates ( x1, y1), ( x2, y2).
sub point_line_distance {
   my ( $x1, $y1, $x2, $y2, $x3, $y3) = @_;
   my ( $c1, $c2);
   my ( $x, $y);
   my ( $d) = -1;

   if ( ( $x1 == $x2) && ( $y1 == $y2)) {
      $d = sqrt( ( $x3 - $x1) ** 2 + ( $y3 - $y1) ** 2);
   }
   else {
      $c1 = ( $x2 - $x1) * $y1 + ( $y1 - $y2) * $x1;
      $c2 = ( $x2 - $x1) * $x3 + ( $y2 - $y1) * $y3;

      if ( $y1 == $y2) {
         $x = $x3;
         $y = $y1;
      }
      else {
         $x = ( $c1 * ( $y1 - $y2) - $c2 * ( $x1 - $x2)) / ( ( $y2 - $y1) ** 2 + ( $x2 - $x1) ** 2);
         $y = - ( ( $c2 + ( $x1 - $x2) * $x) / ( $y1 - $y2));
      }

      ( $x1, $x2) = ( $x2, $x1) unless $x2 >= $x1;
      ( $y1, $y2) = ( $y2, $y1) unless $y2 >= $y1;

      if ( ( $x >= $x1) && ( $x <= $x2)
           && ( $y >= $y1) && ( $y <= $y2)) {
         $d = sqrt( ( $x3 - $x) ** 2 + ( $y3 - $y) **2);
      }
      elsif ( $x < $x1) {
         $d = sqrt( ( $x3 - $x1) ** 2 + ( $y3 - $y1) ** 2);
      }
      else {
         $d = sqrt( ( $x3 - $x2) ** 2 + ( $y3 - $y2) ** 2);
      }
   }

   return $d;
}

sub calc_branch_length {
   my ( $w, $br) = @_;
   my ( $xc, $yc) = ( $w->{ ini}->{ XCalibration}, $w->{ ini}->{ YCalibration});
   my $len = 0;
   my ( $x1,$y1) = @{$br->[0]};
   $x1 *= $xc; $y1 *= $yc;
   for my $c (@$br) {
      my ( $x2,$y2) = @$c;
      $x2 *= $xc; $y2 *= $yc;
      $len += sqrt(($x2-$x1)*($x2-$x1)+($y2-$y1)*($y2-$y1));
      ($x1,$y1)=($x2,$y2);
   }
   return $len;
}

sub calc_branches_length {
   my ( $w, $branches) = @_;
   my $totalLength = 0;
   for my $br ( @{$branches}) {
      $totalLength += $w-> calc_branch_length( $br);
   }
   return $totalLength;
}


sub done_draw_mode {
   my $w = $_[0];
   return unless defined( $w->{ markState}) && ( $w->{ markState} == 16)
       && $w->{ binfo}->{ drawMode};
   $w->{ binfo}->{ drawMode} = 0;
   $w->{ binfo}-> {firstDraw} = 0;
   if ( $w->{ binfo}->{ removeLastPoint}) {
      splice @{ $w->{ branches}->[ $w->{ binfo}->{ branchNumber}]}, -1;
   }
   # removing duplicate sequential point and one point length processes.
   my ( $i, $bn);
   for ( $bn = $#{ $w->{ branches}}; $bn >= 0; $bn--) {
      for ( $i = $#{ $w->{ branches}->[ $bn]} - 1; $i >= 0; $i--) {
         if ( ( $w->{ branches}->[ $bn]->[ $i]->[ 0] == $w->{ branches}->[ $bn]->[ $i + 1]->[ 0])
              && ( $w->{ branches}->[ $bn]->[ $i]->[ 1] == $w->{ branches}->[ $bn]->[ $i + 1]->[ 1])) {
            splice @{ $w->{ branches}->[ $bn]}, $i, 1;
         }
      }
      if ( scalar( @{ $w->{ branches}->[ $bn]}) == 1) {
         splice @{ $w->{ branches}}, $bn, 1;
      }
      else {
         $w->{ totalLength} += $w-> calc_branch_length( $w->{ branches}->[ $bn]);
         $w->{ totalBranches}++;
      }
   }
   $w-> IV-> capture(0);
   $w-> reset_mark_state( 'draw');
   $w-> IV-> repaint;
}

sub preprocess
{
   my $w = $_[0];
   return unless defined $w-> {file};
   my $self = $w-> IV;
   if ($w-> {ini}-> {autoCrispen} ) {
   	my $i = $self-> image;
	unless ( $i-> type == im::Byte ) {
		$i = $i->dup;
		$i->type(im::Byte);
	}
   	$w-> {preprocessedImage} = Prima::IPA::Local::crispening( $i);
   } else {
   	$w-> {preprocessedImage} = undef;
   }
   if ($w-> {ini}-> {autoStretch}) {
      my $i = $w-> {preprocessedImage} || $self-> image;
      $w-> {preprocessedImage} = $i-> dup;
      my ( $lo, $hi, $min, $max) = ( $i-> rangeLo, $i-> rangeHi, $w-> {ini}-> {SpectrumMin}, $w-> {ini}-> {SpectrumMax});
      my $lo1 = ( $lo > $min ) ? $min : $lo;
      my $hi1 = ( $hi < $max ) ? $hi : $max;
      $w-> {preprocessedImage}-> resample( $lo1, $hi1, 0, 255);
   }
}


sub crispen_state_changed
{
   my $w = $_[0];
   $w-> {ini}-> {autoCrispen} = $w-> menu-> EditAutoCrispening-> toggle;
   $w-> preprocess;
   $w-> IV-> repaint;
}

sub stretching_state_changed
{
   my $w = $_[0];
   $w-> {ini}-> {autoStretch} = $w-> menu-> EditAutoStretching-> toggle;
   $w-> preprocess();
   $w-> IV-> repaint;
}

sub remove_frame_data
{
   my $w = $_[0];
   for ( @{$w->{layers}}) {
      my ( $l, $ul) = ( $_, ucfirst $_);
      $w->{$l} = [];
      $w->{"total$ul"} -= $w->{"n$ul"};
      $w->{"n$ul"} = 0;
   }
   $w-> {branches} = [];
   $w-> show_stats( undef, 1);
   $w-> IV-> repaint;
}

sub win_entersubplace
{
   my $w = $_[0];
   $w-> {savePointer} = $::application-> pointer;
   $::application-> pointer( cr::Wait);
   return defined $w-> {mirrorImage} ? $w-> {mirrorImage} : $w-> IV-> image;
}

sub win_leavesubplace
{
   my $w = $_[0];
   $::application-> pointer( $w-> {savePointer});
   $w-> {mirrorImage} = $w-> IV-> image unless defined $w-> {mirrorImage};
   $w-> IV-> image( $_[1]);
   $w-> {recWindow}-> RestoreBtn-> enabled( 1) if $w-> {recWindow};
   $w-> {savePointer} = undef;
   $w-> sb_text('Done');
}

sub win_restore
{
   my ( $w, $i) = @_;
   $w-> IV-> repaint, return unless defined $w-> {mirrorImage};
   $w-> IV-> image($w-> {mirrorImage});
   $w-> {mirrorImage} = undef;
   $w-> {recWindow}-> RestoreBtn-> enabled( 0) if $w-> {recWindow};
}

sub rop_put
{
   my ( $img, $obj, $rop) = @_;
   $img-> put_image_indirect( $obj, 0, 0, 0, 0, $obj-> size, $obj-> size, $rop);
}

sub process
{
   my $w = $_[0];
   my $mode = $_[2] || 0;
   $w-> win_rec_updatevalues;
   my $orgi = $w-> win_entersubplace;

   my ( $minUF, $maxUF, $stepUF, $min_area, $min_rank, $max_index, $min_index, $dilate, $rad) = 
      map { $w-> {ini}-> {$_}} qw(
        C_minUF C_maxUF C_stepUF C_min_area C_min_rank C_max_index C_min_index C_dilations C_branch_radius
   );

   my $maxArea = $orgi-> width * $orgi-> height / 4;
   my $i = $orgi-> dup;
   my $dd = $dilate;
   $dd = int($i-> width / 4); $dd++ unless $i % 2;

   my $rect = Prima::Image-> create( width => $i-> width, height => $i-> height, type => im::Byte);
   $rect-> put_image_indirect( $rect, 
                               4, 4, 0, 0, 
                               $i-> width - 8, $i-> height - 8,
                               $i-> width - 8, $i-> height - 8, rop::Whiteness);
   $i = Prima::IPA::Local::ridge( $i, scale => 16);
   my $centers = Prima::IPA::Point::threshold( $i, minvalue => 1, true => 0, false => 255);
   $centers-> type(im::Byte);
   $i = Prima::IPA::Point::threshold( $i, maxvalue => 255, preserve => 1, false => 255);
   $i-> type( im::Byte);
   $i = Prima::IPA::Local::hysteresis( $i, threshold => [ 20, 255]);
   $i = Prima::IPA::Global::fill_holes( $i);
   rop_put( $i, $rect, rop::AndPut);
   $i = Prima::IPA::Global::area_filter( $i, minArea => $min_area);
   $i = Prima::IPA::Morphology::dilate( $i);
   $i = Prima::IPA::Global::fill_holes( $i);
   $i = Prima::IPA::Morphology::erode( $i);
   rop_put( $centers, $i, rop::AndPut);
   $centers = Prima::IPA::Global::area_filter( $centers, minArea => 5);
   return $w-> win_leavesubplace( $i) if $mode == 1;

   my ( $pct, $step) = (0, 100 / (($maxUF - $minUF) * 3 + 8));
   $pct -= $step;

   $w-> sb_text( sprintf( "%d%% ( find branches )", $pct += $step));

   my $z = $centers-> dup;
   rop_put( $centers, $centers, rop::XorPut); # clear
   rop_put( $z, $z, rop::XorPut); # comment it out if want gamma-centroids also
   my $rz = $i;

   # collect all characteristic radii
   my $scale = 0;
   while ( $rz-> sum) {
      my $e = Prima::IPA::Morphology::erode( $rz, neighborhood => ((($scale++)%2)?4:8));
      if ( $scale < $rad * 2) {
         $rz = $e;
         next;
      }
      # collect all disappeared points
      my $x = Prima::IPA::Morphology::reconstruct( $rz, $e);
      rop_put( $x, $rz, rop::XorPut);
      rop_put( $z, $x, rop::OrPut);
      $rz = $e;
   }
   
   for( @{Prima::IPA::Global::identify_contours( $i)}) {
       my $x = $i-> dup;   
       rop_put( $x, $x, rop::XorPut);
       Prima::IPA::Region::plot( $x, Prima::IPA::Region::contour2region( $_), 0, 0, 255);
       $x = Prima::IPA::Morphology::reconstruct( $z, $x);
       #my $ma = $min_area;
       $scale = 0;
       my @objects;
       my @plot_regions;
       #print "new contour\n";
       while ( $x-> sum) {
          $x = Prima::IPA::Morphology::dilate( $x, neighborhood => ((($scale++)%2)?4:8));
          my $xz = $x-> dup;
          rop_put( $xz, $i, rop::NotSrcAnd);
          next unless $xz-> sum;
          # remove the overlapped objects
          my $objects = Prima::IPA::Morphology::reconstruct( $x, $xz);
          rop_put( $x, $objects, rop::NotSrcAnd);
          # see if max circles are big enough
          $objects = Prima::IPA::Global::area_filter( $objects, minArea => $min_area);
          for( @{Prima::IPA::Global::identify_contours( $objects)}) {
	     my $reg = Prima::IPA::Region::contour2region( $_);
             my $area = Prima::IPA::Region::area( $reg);
	     push @objects, [ $area, $reg ];
	  }
       }
       # sort objects and remove too small
       if ( @objects) {
	  @objects = sort { $$b[0] <=> $$a[0] } @objects;
	  my $a0 = $objects[0]->[0];
	  for ( @objects) {
	     my $a = $$_[0];
	     last if $a < $a0 * 0.6;
	     $a0 = $a;
	     push @plot_regions, $$_[1];
	  }
	  # plot all filtered
	  for ( @plot_regions) {
	     Prima::IPA::Region::plot( $centers, $_, 0, 0, 255);
	  }
       }
   }

   sub weigh_center
   {
      my $c = $_[0];
      my @a = ([], []);
      my $flip = 0;
      for ( @$c) {
         push @{$a[$flip]}, $_;
         $flip = $flip ? 0 : 1;
      }
      @{$a[0]} = sort { $a <=> $b } @{$a[0]};
      @{$a[1]} = sort { $a <=> $b } @{$a[1]};
      return ( $a[0]->[scalar(@{$a[0]})/2], $a[1]->[scalar(@{$a[1]})/2]);
   }

   my $mask  = $i-> dup;
   my @centroids;
   my @processes;
   my @end_excl   = map { int( $_ - $_ / 20) } $i-> size;
   my @start_excl = map { int( $_ / 20) } $i-> size;

   my ( $ww, $hh) = $mask-> size;
   my $ls = int(( $ww * 8 + 31) / 32) * 4;
   my $dy = int($hh / 20);
   my $szy = int(($hh - 2 * $dy) / $w->{ini}->{nLines});
   $i = Prima::IPA::Global::area_filter( $i, minArea => $min_area, maxArea => $maxArea);

   my $lines = Prima::IPA::Morphology::thinning( $i); 
   my $prune_lut = $Prima::IPA::Morphology::transform_luts{prune}->();
   $dd = $rad;
   $lines = Prima::IPA::Morphology::BWTransform( $lines, lookup => $prune_lut) while $dd--;
   $lines = Prima::IPA::Global::area_filter( $lines, minArea => $rad * 2, maxArea => $maxArea);
   rop_put( $lines, $centers, rop::NotSrcAnd);
   rop_put( $centers, Prima::IPA::Morphology::erode( $centers), rop::NotSrcAnd);


   $w-> sb_text( sprintf( "%d%% ( find centroids )", $pct += $step));

   if ( $mode == 3) {
      $i = $orgi-> dup;
      $i = Prima::IPA::Point::remap( $i, lookup => [ 2, 2, ( 2 .. 255)]);
      $i-> rop( rop::NotSrcAnd);
      $i-> put_image( 0, 0, $lines);
      $i = Prima::IPA::Point::remap( $i, lookup => [ 1, ( 1 .. 255)]);
      $i-> rop( rop::NotSrcAnd);
      $i-> put_image( 0, 0, $centers);
      $i-> type( im::bpp8);
      my @ipal = @{$i-> palette};
      splice( @ipal, 0, 6, ( 0,0,255,0,255,0 ));
      $i-> palette(\@ipal);
      $w-> win_leavesubplace( $i);
      return;
   }

   CONTO: for( @{Prima::IPA::Global::identify_contours( $centers)}) {
      my $flip = 0;
      for ( @$_) {
         #next CONTO if $_ >= $end_excl[ $flip] || $_ < $start_excl[$flip];
         next CONTO if $_ < $start_excl[$flip];
         $flip = $flip ? 0 : 1;
      }
      push @centroids, join( ' ', weigh_center( $_));
   }

   my $d = $lines-> data;
   for ( $i = 1; $i <= $w-> {ini}-> {nLines}; $i++) {
      my $ay = $dy + $i * $szy;
      my $scanline = substr( $d, $ls * $ay, $ww);
      my $ax = 0;
      my @localp;
      $scanline =~ s/(?:(\0+)|(.))/push(@localp, $ax) if $2; $ax += length($1||$2); ' '/xeg;
      my $prev = -$rad * 2;
      push @processes, map {"$_ $ay"} grep {
         my $yes = ( $prev + $rad < $_) && ( $_ >= $start_excl[0]) && ( $_ < $end_excl[0]);
         $prev = $_;
         $yes;
      } @localp;
   }

   $w-> {totalCells} -= $w-> {nCells};
   $w-> {cells}  = \@centroids;
   $w-> {nCells} = scalar( @centroids);
   $w-> {totalProcesses} -= $w-> {nProcesses};
   $w-> {processes} = \@processes;
   $w-> {nProcesses} = scalar( @processes);
   
   $w-> show_stats( undef, 1);
   $w-> IV-> repaint;
   $w-> modified(1);
   $w-> update_state;
   $::application-> pointer( $w-> {savePointer});
   $w-> {savePointer} = undef;
}

sub process_series
{
   my $w = $_[0];
   Prima::MsgBox::message( "No series to process"), return if ( !defined $w-> {nextFile} && !defined $w-> {prevFile});
   my $num = $w-> {cypherMask};
   my ( $fn, $tn) = $w-> win_getseriesrange;
   return if Prima::MsgBox::message( "This will process series ".
      $w-> {fileBeg}.('X' x $num).$w-> {fileEnd}." [$fn-$tn] . Proceed?",
      mb::OKCancel|mb::Information) != mb::OK;
   my $fnsave = $w->{fileNum};
   my $f;   
   my $ok = 1;
   $w->{packetAborted} = 0;
   $w->{silence} = 1;

   my $userAborted = 0;
   my $statwin = $w-> insert( Dialog =>
      centered    => 1,
      text        => 'Processing',
      size        => [ 300, 60],
      onKeyDown   => sub {
         my ( $self, $code, $key, $mod) = @_;
         if ( $key == kb::Esc &&
            ( Prima::MsgBox::message("Abort process?", mb::OKCancel|mb::Warning) == mb::OK)) {
            $userAborted = 1;
            $_[0]-> text('Cancelling');
         }
      },
      onClose     => sub {
         $_[0]-> clear_event;
         return if Prima::MsgBox::message("Abort process?", mb::OKCancel|mb::Warning) != mb::OK;
         $userAborted = 1;
         $_[0]-> text('Cancelling');
      },
   );

   my $g = $statwin-> insert( Gauge =>
      origin => [ 5, 5],
      size   => [ $statwin-> width - 10, $statwin-> height - 10],
      min    => $fn,
      max    => $tn,
      value  => $fn,
      font   => {height => $statwin-> height - 16},
   );
   

   $statwin-> execute_shared;
   for my $i ( $fn..$tn) {
       $f = sprintf( "%s%0${num}d%s",$w->{fileBeg}, $i, $w-> {fileEnd});
       $::application-> yield;
       $ok = 0, last, if $userAborted;
       if ( !$w-> win_loadfile( $f) || $w->{packetAborted}) {
          Prima::MsgBox::message("Aborted - error processing file $f", mb::OK|mb::Error);
          $ok = 0;
          last;
       }
       $w-> process('', 0);
       $g-> value( $i);
   }
   $statwin-> destroy;
   $w->{silence} = 0;
   
   if ( $ok) {
      Prima::MsgBox::message("Queue processed", mb::OK|mb::Information);
      $w->win_loadfile( sprintf( "%s%0${num}d%s",$w->{fileBeg}, $fnsave, $w-> {fileEnd}));
   }
}

sub win_rec_updatevalues
{
   my $w = $_[0];
   return unless $w-> {recWindow};
   my ( $r, $i) = ( $w-> {recWindow}, $w-> {ini});
   $i-> {C_minUF}     = $r-> UF-> From-> value;
   $i-> {C_maxUF}     = $r-> UF-> To-> value;
   $i-> {C_stepUF}    = $r-> UF-> Step-> value;
   $i-> {C_min_index} = $r-> FLT-> Min-> value;
   $i-> {C_max_index} = $r-> FLT-> Max-> value;
   $i-> {C_min_area}  = $r-> Area-> value;
   $i-> {C_dilations} = $r-> Dilations-> value;
   $i-> {C_branch_radius}  = $r-> Radius-> value;
}

sub win_showrec
{
  my $w = $_[0];
  unless ( $w-> {recWindow}) {
     my $fi = Prima::Utils::find_image( '', 'App::PLab::prlens.fm');
     unless ( defined $fi) { Prima::message( "Cannot find resource: App::PLab::prlens.fm"); return }
      eval { $w-> {recWindow} = { Prima::VB::VBLoader::AUTOFORM_CREATE( $fi,
         Form1 => {
            onClose => sub { 
               $w-> win_rec_updatevalues;
               $w-> {recWindow} = undef; 
            },
         },
         ApplyBtn   => { onClick => sub { $w-> process('', 0)}},
         PD1        => { onClick => sub { $w-> process('', 1)}},
         PD2        => { onClick => sub { $w-> process('', 2)}},
         PD3        => { onClick => sub { $w-> process('', 3)}},
         RestoreBtn => { onClick => sub { $w-> win_restore; }},
         
         # don't need'em for a while
         UF => { enabled => 0},
         
      )}-> {Form1}};
     if ( $@) { Prima::message("Error in setup resource: $@"); return };
     my ( $r, $i) = ( $w-> {recWindow}, $w-> {ini});
     $r-> UF-> From-> value ($i-> {C_minUF}   ); 
     $r-> UF-> To-> value   ($i-> {C_maxUF}  );
     $r-> UF-> Step-> value ($i-> {C_stepUF}  );
     $r-> FLT-> Min-> value ($i-> {C_min_index});
     $r-> FLT-> Max-> value ($i-> {C_max_index});
     $r-> Area-> value      ( $i-> {C_min_area});
     $r-> Dilations-> value ($i-> {C_dilations});
     $r-> Radius-> value  ( $i-> {C_branch_radius});
     $w-> win_framechanged;
  }
  $w-> {recWindow}-> bring_to_front;
  $w-> {recWindow}-> select;
}


sub IV_MouseDown
{
   my ( $w, $self, $btn, $mod, $x, $y) = @_;
   if ( ( ( $btn & mb::Left) == mb::Left)
           && ( defined $w->{ markState}) && ( $w->{ markState} == 16)
           && ( ( ! defined $w->{ binfo}) || ( ! $w->{ binfo}->{ drawMode}))) {
       $w-> initiate_draw_mode( $x, $y); 
       $self-> clear_event;
       return;
   }

   if ( $btn == mb::Right && !( $mod & km::Ctrl)) 
   {
      if ( ! defined( $w-> { markState}) || $w-> { markState} < 16)
      {
         $w-> reset_mark_state(( $mod & km::Shift) ? 'prev' : 'next');
      }
      else {
         if ( $w->{ binfo}->{ drawMode}) {
            $w-> done_draw_mode();
         }
         elsif ( defined( $w->{ binfo}->{ nearestBranch})) {
            $w->{ totalLength} -= $w-> calc_branch_length( $w->{ branches}->[ $w->{ binfo}->{ nearestBranch}]);
            $w->{ totalBranches}--;
            splice @{ $w->{ branches}}, $w->{ binfo}->{ nearestBranch}, 1;
            $w->{ binfo}->{ nearestBranch} = undef;
            $w-> modified( 1); 
            $self-> repaint;
         }
         $w-> show_stats( undef, 1);
      }
      $self-> clear_event;
      return;
   }
   
   if ( $btn == mb::Right && ($mod & km::Ctrl)) {
      $mod &= !km::Ctrl;
   }
   $w-> SUPER::IV_MouseDown( $self, $btn, $mod, $x, $y); 
}

sub IV_MouseMove
{
   my ( $w, $self, $mod, $x, $y) = @_;

   unless ( $self->{transaction}) {
      if (( $mod & km::Shift) && defined $self-> image) {
         my $i = $self-> image;
         my $pix = $i-> pixel( $self-> screen2point( $x, $y));
         $w-> sb_text((( $i-> type & im::BPP) > 8) ?
            sprintf("%02x %02x %02x", ($pix>>16)&0xFF, ($pix>>8)&0xFF, $pix&0xFF) :
            $pix
         ) if $pix != cl::Invalid;
      }
   }
   
   $w-> SUPER::IV_MouseMove( $self, $mod, $x, $y);

   return if !defined $w-> {binfo} || !defined $w-> {markState} || $w-> {markState} != 16;

   if ( $w->{ binfo}->{ drawMode} == 1) {
      my ( $bn) = $w->{ binfo}->{ branchNumber};
      my ( $ox, $oy) = @{ $w->{ branches}->[ $bn]->[ -1]};
      my ( $ax, $ay) = $self-> screen2point( $x, $y);
      my ( $ms) = $self->get_mouse_state;
      if ( ( scalar( @{ $w->{ branches}->[ $bn]}) == 1) || ( ( $ms & mb::Left) == mb::Left)) {
         push @{ $w->{ branches}->[ $bn]}, [ int($ax), int($ay)];
         $w->{ binfo}->{ removeLastPoint} = 0;
         $w-> {binfo}-> {firstDraw} = 1;
      }
      else {
         return unless $w-> {binfo}-> {firstDraw};
         @{ $w->{ branches}->[ $bn]->[ -1]} = ( $ax, $ay);
         $w->{ binfo}->{ removeLastPoint} = 1;
      }
      if ( scalar( @{ $w->{ branches}->[ $bn]}) > 1) {
         my ( $ex, $ey) = @{ $w->{ branches}->[ $bn]->[ -1]};
         my ( $bx, $by) = @{ $w->{ branches}->[ $bn]->[ -2]};
         my ( $left, $bottom, $right, $top) = ( $ox, $oy, $ox, $oy);
         $left = $ex if $left > $ex;
         $left = $bx if $left > $bx;
         $bottom = $ey if $bottom > $ey;
         $bottom = $by if $bottom > $by;
         $right = $ex if $right < $ex;
         $right = $bx if $right < $bx;
         $top = $ey if $top < $ey;
         $top = $by if $top < $by;
         $self-> invalidate_rect( $self-> point2screen( $left, $bottom, $right + 1, $top + 1));
      }
   }
   else{
      my ( $mindist, $bn, $i);
      my ( $rr);
      for ( $i = 0; $i <= $#{ $w->{ branches}}; $i++) {
         my ( $lmd, $j);
         my ( $left, $bottom, $right, $top) = ( @{ $w->{ branches}->[ $i]->[ 0]}, @{ $w->{ branches}->[ $i]->[ 0]});
         for ( $j = 0; $j < $#{ $w->{ branches}->[ $i]}; $j++) {
            my ( $x1, $y1, $x2, $y2) = ( @{ $w->{ branches}->[ $i]->[ $j]},
                                         @{ $w->{ branches}->[ $i]->[ $j + 1]});
            my ( $dist) = point_line_distance( $x1, $y1, $x2, $y2, $self-> screen2point($x, $y));
            $lmd = $dist unless defined $lmd;
            $lmd = $dist if $lmd > $dist;
            $left = $x1 if $left > $x1;
            $left = $x2 if $left > $x2;
            $bottom = $y1 if $bottom > $y1;
            $bottom = $y2 if $bottom > $y2;
            $right = $x1 if $right < $x1;
            $right = $x2 if $right < $x2;
            $top = $y1 if $top < $y1;
            $top = $y2 if $top < $y2;
         }
         if ( ( ! defined( $mindist)) || ( $mindist > $lmd)) {
            $mindist = $lmd;
            $bn = $i;
            $rr = [ $left, $bottom, $right + 1, $top + 1];
         }
      }
      if ( defined( $mindist) && ( $mindist <= 10)) {
         if ( ( ! defined( $w->{ binfo}->{ nearestBranch})) || ( $w->{ binfo}->{ nearestBranch} != $bn)) {
            $w->{ binfo}->{ nearestBranch} = $bn;
            $self-> invalidate_rect( $self-> point2screen( @{ $w->{ binfo}->{ prevActiveRect}})) 
               if defined $w->{ binfo}->{ prevActiveRect};
            $self->invalidate_rect( $self-> point2screen( @$rr));
            $w->{ binfo}->{ prevActiveRect} = $rr;
         }
      }
      elsif ( defined $w->{ binfo}->{ nearestBranch}) {
         undef $w->{ binfo}->{ nearestBranch};
         $self->invalidate_rect( $self-> point2screen( @{ $w->{ binfo}->{ prevActiveRect}}))
            if defined $w->{ binfo}->{ prevActiveRect};
         undef $w->{ binfo}->{ prevActiveRect};
      }
   }
}

sub IV_MouseClick
{
   my ( $w, $self, $btn, $mod, $x, $y, $dbl) = @_;
   
   $self-> clear_event;
   return unless defined $w-> {file};

   if ( $dbl && $btn == mb::Right && !( $mod & km::Ctrl)) {
      $w-> reset_mark_state(( $mod & km::Shift) ? 'prev' : 'next');
      return;
   }

   return unless $btn == mb::Left;
   return unless defined $w-> {markState};
   my ( $ax, $ay) = $self-> screen2point( $x, $y);
   return unless ( $ax >= 0 && $ay >= 0 && $ax < $w->{IVx} && $ay < $w->{IVy});
   my $ary = undef;
   $ary = ($w->{ markState} == 16) ? $w-> {branches} : $w-> {$w-> {layers}->[$w-> {markState}]};
   return unless defined $ary;

   if ( $w->{ markState} == 16) {
      if ( ! $w->{ binfo}->{ drawMode}) {
         $w-> initiate_draw_mode( $x, $y);
      }

      my ( $bn) = $w->{ binfo}->{ branchNumber};
      push @{ $w->{ branches}->[ $bn]}, [ int($ax), int($ay)];
      $w->{ binfo}->{ removeLastPoint} = 1;
      $w-> modified(1);
   }
   else {
      my ($i,$x1,$x2,$y1,$y2);


      # search for an existing point
      for ( $i = 0; $i < scalar @$ary; $i++)
      {
         ($x1,$y1) = split ' ', $$ary[$i];
         ($x2,$y2) = map { $_ + 6; } ($x1,$y1);
         ($x1,$y1) = map { $_ - 6; } ($x1,$y1);
         last if $ax >= $x1 && $ax <= $x2 && $ay >= $y1 && $ay <= $y2;
      }

      $w-> modified( 1); 
      my $layer = ucfirst $w-> {layers}->[$w-> {markState}];
      if ( $i < scalar @$ary)
      {
         # removing existing point
         ($ax, $ay) = split(' ', splice( @$ary, $i, 1));
         $w-> {"n$layer"}--;
         $w-> {"total$layer"}--;
      }
      else
      {
         # adding new point
	 $ax = int($ax);
	 $ay = int($ay);
         push @$ary, "$ax $ay";
         $w-> {"n$layer"}++;
         $w-> {"total$layer"}++;
      }
      my $zp = $self-> zoom * $w->{ini}->{PointSize};
      $zp = 4 if $zp < 4;
      ($x1, $x2, $y1, $y2) = map { ($_ - $zp - 2, $_ + $zp + 2); } ($ax,$ay);
      $self-> invalidate_rect( $self-> point2screen( $x1, $y1, $x2, $y2));
   }
   $w-> update_state;
}

sub update_state
{
   my $w = $_[0];
   my $cp = $w-> ToolBar-> CellsProcesses;
   if ( !defined $w-> {file})
   {
      $w-> sb_text( "No file loaded");
      $cp-> text( "???:???");
   }
   else
   { 
       my $text1 = '';
       my @text2;
       for ( @{$w->{layers}}) {
          my $u = ucfirst $_;
          $text1 .= "$u: ".$w->{"n$u"}." (".$w->{"total$u"}.") ";
          next if $_ eq 'cells';
          push @text2, "(" . ($w->{totalCells} ? sprintf("%.4g",$w->{"total$u"} / $w->{totalCells}) 
                                               : "NONE") . ")";
       }
       $w-> sb_text( $text1 . ' Ratio: '. join(',',@text2));
       $cp-> text( join( ':', map { sprintf "%03d", $w->{ 'n' . ucfirst $_} } @{$w->{layers}}));
   }
   $w-> show_stats( undef, 1);
}


sub IV_Paint
{
   my ( $w, $self, $canvas) = @_;

   my $image = $self-> {image};
   $self-> {image} = $w-> {preprocessedImage} if $w-> {preprocessedImage};
   $self-> on_paint( $canvas);
   $self-> {image} = $image;

   return unless $image;
   
   my $z  = $self-> zoom;
   my $zp = $z * $w->{ini}->{PointSize};
   $zp = 4 if $zp < 4;
   $canvas-> translate( $self-> point2screen( 0, 0));
   my ($x, $y, $iw, $ih) = ( $self-> size, $image-> size);
   my $dx = sprintf( '%d', $iw / 20);
   my $dy = sprintf( '%d', $ih / 20);
   my $szy = sprintf( '%d', ($ih - 2 * $dy) / $w-> {ini}-> {nLines});

   $dx *= $z;
   $dy *= $z;
   $iw *= $z;
   $ih *= $z;
   $szy *= $z;
   
   $canvas-> set( lineWidth => 2, color => $w-> {ini}-> {Color_Frame});
   $canvas-> line( $dx, $dy, $iw - $dx, $dy);
   $canvas-> line( $iw - $dx, $dy, $iw - $dx, 0);
   $canvas-> line( $dx, $dy, $dx, $ih);
   $canvas-> linePattern( lp::LongDash);
   $canvas-> line( $dx, $ih - $dy, $iw - $dx, $ih - $dy);
   $canvas-> line( $iw - $dx, $ih - $dy, $iw - $dx, $dy);
   $canvas-> set( lineWidth => 1, linePattern => lp::Solid);
   for ( my $i = 1; $i < $w-> {ini}-> {nLines}; $i++) {
      $canvas-> line( $dx, $dy + $szy*$i, $iw - $dx, $dy + $szy*$i);
   }

   for ( 0 .. MAXDATASET) {
      my $layer = $w-> {layers}->[$_];
      last unless defined($layer);
      next unless ( 1 << $_) & $w->{ini}->{visible_datasets};
      my $color = ( $_ < 2 ) ? ucfirst $layer : "Dataset$_";
      $canvas-> color( $w-> {ini}-> {"Color_$color"});
      foreach (@{$w-> {$layer}}) {
         my ($x, $y) = split;
         $canvas-> fill_ellipse( $x * $z, $y * $z, $zp, $zp);
      }
      if ( $w-> {ini}-> {ShowExtras}) {
         foreach (@{$w-> {"ex" . ucfirst $layer}}) {
            my ($x, $y) = split;
            $x *= $z; $y *= $z;
            $canvas-> line( $x - 3, $y - 3, $x + 3, $y + 3);
            $canvas-> line( $x - 3, $y + 3, $x + 3, $y - 3);
         }
      }
      if ( $w-> {ini}-> {ShowPrevExtras}) {
         foreach (@{$w-> {"prevex" . ucfirst $layer}}) {
            my ($x, $y) = split;
            $x *= $z; $y *= $z;
            $canvas-> line( $x - 3, $y - 3, $x + 3, $y + 3);
            $canvas-> line( $x - 3, $y + 3, $x + 3, $y - 3);
         }
      }
   }

   my $lw = $canvas->lineWidth;
   $canvas->lineWidth( 1);
   my ( $i) = 0;
   foreach ( @{ $w->{ branches}}) {
      if ( defined( $w->{ binfo}->{ nearestBranch}) && ( $i == $w->{ binfo}->{ nearestBranch})) {
         $canvas->color( $w->{ini}-> {Color_ActiveProcess});
      }
      else {
         $canvas->color( $w-> {ini}-> {Color_Branches});
      }
      my ( @br) = map { ( $_->[ 0] * $z, $_->[ 1] * $z)} @$_;
      $canvas->polyline( \@br);
      $i++;
   }
   $canvas->lineWidth( $lw);
}

# OPT

sub opt_colors
{
   my $i = $_[0]->{ini} ? $_[0]->{ini} : {$_[0]-> win_inidefaults};
   return {
      'Frame'         => [ cl::LightMagenta, 'Frame'],
      'Processes'     => [ cl::Blue,       'Process'],
      'Branches'      => [ cl::LightGreen, 'Branches'],
      'ActiveProcess' => [ 0x80FF80,       'Active process'],
      'Cells'         => [ cl::LightRed,   'Cells'],
      ( map { ( "Dataset$_", => [ cl::White / $_,   $i->{"dataset_${_}_name"}] ) } 2 .. MAXDATASET )
   };
}

sub opt_keys
{
   return {
      %{$_[0]-> SUPER::opt_keys()},
      EditAutoCrispening => [ kb::Space,           'Automatically crispen the image'],
      EditAutoStretching => [ km::Ctrl|kb::Space,  'Automatically stretch the image color spectrum'],
      EditProcess        => [ '^A',                'Markup processes automatically'],
      EditProcessSeries  => [ kb::NoKey,           'Markup series of processeses automatically'],
      EditRecSetup       => [ '@R',                'Display recognition setup dialog'],
      FileStats          => [ '@S',                'Invoke statistic data dialog'],
      FileBackup         => [ kb::NoKey,           'Backup current series data'],
      HelpAbout          => [ kb::NoKey,           'Standard about box'],
      HelpPlabApps       => [ kb::NoKey,           'Online PlabApps overview'],
      HelpContents       => [ kb::NoKey,           'Online PrLenS overview'],
   },
}

sub opt_propcreate
{
   my ( $w, $dlg, $nb, $nbpages) = @_;
   $w-> SUPER::opt_propcreate( $dlg, $nb, $nbpages);
   $nb-> tabs( @{$nb-> tabs}, 'Stretching');
   $nb-> insert_to_page( 1, [ SpinEdit =>
       origin => [ 10, 105],
       width  => 120,
       name   => 'nLines',
       min    => 2,
       max    => 20,
       hint   => 'Amount of lines in the grid',
   ] , [ Label =>
       origin => [ 10, 125],
       width  => 120,
       text   => 'Number of lines',
   ], [ CheckBox => 
       origin  => [ 10, 190],
       size    => [ 374, 36], 
       name    => 'ShowExtras',
       text    => '~Show first image markings',
       hint    => "If on, the markings on the first image in the series\nwill be displayed as crosses",
   ], [ CheckBox => 
       origin  => [ 10, 155],
       size    => [ 374, 36], 
       name    => 'ShowPrevExtras',
       text    => '~Show previous image markings',
       hint    => "If on, the markings on the previous image\nwill be displayed as crosses",
   ], [ Label => 
       origin  => [ 190, 130 ],
       autoWidth => 1,
       text      => 'Visible datasets',
   ], [ CheckList => 
       origin => [ 190, 55],
       size   => [ 120, 75],
       name   => 'Hyperset',
   ], [ SpinEdit => 
       origin => [ 190, 220],
       width  => 120,
       min    => 4,
       max    => 20,
       name   => 'PointSize',
       hint   => 'Size of point used for cell markings',
   ], [ Label => 
       origin => [ 190, 240],
       autoWidth => 1,
       text      => 'Point size',
   ], [ SpinEdit => 
       origin => [ 190, 160],
       width  => 120,
       min    => 2,
       max    => MAXDATASET,
       name   => 'Datasets',
       hint   => 'Number of visible types of data points sets. By default is 2, cells and processes', 
   ], [ Label => 
       origin => [ 190, 180],
       autoWidth => 1,
       text      => 'Number of datasets',
   ]);
   my $slider = $nb-> insert_to_page( 4, [ Widget => 
       origin  => [ 20, 70],
       size    => [ 262, 100],
       name    => 'StretchSlider',
       designScale => undef,
       onCreate => sub { 
          ( $_[0]-> {min}, $_[0]-> {max}) = (0,255);
       },
       onPaint => sub {
          my ( $self, $canvas) = @_;
          my ( $a, $b) = ($self-> {min}, $self-> {max});
          my @sz = $self-> size;
          $canvas-> color( cl::Black);
          $canvas-> rectangle( 0, 0, $sz[0]-1, $sz[1]-1);
          $canvas-> bar( 1, 1, 2, $sz[1]-2);
          $canvas-> color( cl::White);
          $canvas-> bar( $sz[0]-3, 1, $sz[0]-2, $sz[1]-2);
          my $del = int(($sz[0]-6)/16);
          for ( 0..15) {
             $canvas-> color( $_ * 65793 * 16);
             $canvas-> bar( 3 + $_*$del, 1, 2 + ($_+1)*$del, $sz[1] - 2);
          }
          $canvas-> set( 
            fillPattern => fp::WideDot,
            color       => cl::Gray,
            backColor   => cl::Black,
            rop         => rop::XorPut,
          );
          $canvas-> bar( 1, 1, 2 + $a, $sz[1]-2);
          $canvas-> bar( 2 + $b, 1, $sz[0]-2,$sz[1]-2);
          $canvas-> fillPattern( fp::Solid);
          $canvas-> fill_ellipse( $a, $sz[1] / 2, 6, 6);
          $canvas-> fill_ellipse( 4 + $b, $sz[1] / 2, 6, 6);
          $canvas-> color( cl::White);
          $canvas-> text_out( "$a:$b", 1, 1);
       },
       onMouseDown => sub {
          my ( $self, $btn, $mod, $x, $y) = @_;
          my $found;
          $self-> clear_event;
          if ( $x - 3 <= $self-> {min}) { 
              $found = 'min'; 
              $self-> {minLimit}  = 0;
              $self-> {maxLimit}  = $self-> {max} - 1;
          } elsif ( $x - 3 >= $self-> {max}) { 
              $found = 'max';
              $self-> {maxLimit}  = 255;
              $self-> {minLimit}  = $self-> {min} + 1;
          } else {
             return;
          }
          $self-> {transaction} = $found;
          $self-> {last}   = $x;
          $self-> {anchor} = $x - $self-> {$found};
          $self-> capture(1);
       },
       onMouseMove => sub { 
          my ( $self, $mod, $x, $y) = @_; 
          return if !$self-> {transaction};
          $self-> clear_event;
          if ( $x - $self-> {anchor} < $self-> {minLimit}) {
             $x = $self-> {minLimit} + $self-> {anchor};
          } elsif ( $x - $self-> {anchor} > $self-> {maxLimit}) {
             $x = $self-> {maxLimit} + $self-> {anchor};
          }
          return if $self-> {last} == $x;
          $self-> {last} = $x;
          $self-> {$self-> {transaction}} = $x - $self-> {anchor};
          $self-> repaint;
       },
       onMouseUp => sub {
          my ( $self, $btn, $mod, $x, $y) = @_;
          $self-> clear_event;
          return unless $self-> {transaction};
          $self-> {transaction} = 0;
          $self-> capture(0);
       },
   ]);
   $nb-> insert_to_page( 4, [ Label => 
       origin  => [ 20, 170],
       designScale => undef,
       autoWidth => 1,
       text => 'Define spectrum range',
   ], [ Button => 
       origin  => [ 20, 20],
       designScale => undef,
       text => '~Preview',
       hint => 'Turn on auto-stretching before preview',
       name => 'StretchPreview',
       onClick => sub {
          unless ( $w-> {ini}->{autoStretch}) {
             return if Prima::MsgBox::message("Auto stretch feature is not turned on. Turn it on now?", mb::YesNo|mb::Information) != mb::Yes;
             $w-> stretching_state_changed;
          }
          $w-> {ini}-> {SpectrumMin} = $slider-> {min};
          $w-> {ini}-> {SpectrumMax} = $slider-> {max};
          $w-> preprocess;
          $w-> IV-> repaint;
       },
   ]);  
}

sub opt_proppush
{
   my ( $w, $dlg, $nb, $nbpages) = @_;
   $w-> SUPER::opt_proppush( $dlg, $nb, $nbpages);
   $nbpages-> nLines-> value( $w->{ini}->{nLines});
   $nbpages-> PointSize-> value( $w->{ini}->{PointSize});
   $nbpages-> Datasets-> value( $w->{ini}->{active_datasets});
   $nbpages-> ShowExtras-> checked( $w-> {ini}-> {ShowExtras});
   $nbpages-> ShowPrevExtras-> checked( $w-> {ini}-> {ShowPrevExtras});
   my $hs = $nbpages-> Hyperset;
   $hs-> items( [ map { ucfirst } @{$w->{layers}} ]);
   $hs-> vector( pack( 'I*', $w->{ini}-> {visible_datasets}));
   my $ssl = $nbpages-> StretchSlider;
   $ssl-> {saveMin} = $ssl-> {min} = $w->{ini}->{SpectrumMin};
   $ssl-> {saveMax} = $ssl-> {max} = $w->{ini}->{SpectrumMax};
   for ( qw( min max)) { 
      $ssl-> {$_}  = 0   if $ssl-> {$_} < 0;
      $ssl-> {$_}  = 255 if $ssl-> {$_} > 255;
   }
   my $pi = $nbpages-> pageIndex;
   $nbpages-> pageIndex( 4);
   $nbpages-> StretchPreview-> enabled( defined($w-> {file})); 
   $nbpages-> pageIndex( $pi);
}

sub opt_proppop
{
   my ( $w, $dlg, $nb, $nbpages, $mr) = @_;
   $w-> SUPER::opt_proppop( $dlg, $nb, $nbpages, $mr);
   my $ssl = $nbpages-> StretchSlider;
   if ( $mr) {
      $w->{ini}->{nLines} = $nbpages-> nLines-> value;
      $w->{ini}->{PointSize} = $nbpages-> PointSize-> value;
      my $ad = $w->{ini}->{active_datasets};
      $w->{ini}->{active_datasets} = $nbpages-> Datasets-> value;
      if ( $ad != $w->{ini}->{active_datasets}) {
         $w-> modified(1) if defined $w-> {file};
         $w-> reset_mark_state( 0) if defined $w-> {markState} && $w-> {markState} >= $w->{ini}->{active_datasets};
         $w-> {layers} = [ map { $w-> {ini}-> {"dataset_${_}_name"}} 0 .. $w->{ini}->{active_datasets} - 1];
         for ( @{$w-> {layers}}) {
            my $u = ucfirst $_;
            $w->{$_} ||= [];
            $w->{"ex$u"} ||= [];
            $w->{"prevex$u"} ||= [];
            $w->{"$_$u"} ||= 0 for qw(n total);
         }
      }
      $w-> {ini}-> {ShowExtras} = $nbpages-> ShowExtras-> checked;
      $w-> {ini}-> {ShowPrevExtras} = $nbpages-> ShowPrevExtras-> checked;
      my ( $a, $b) = ($ssl-> {min},$ssl-> {max});
      if ( ($w->{ini}->{SpectrumMin} != $a) ||
           ($w->{ini}->{SpectrumMax} != $b)) {
         $w->{ini}->{SpectrumMin} = $a;
         $w->{ini}->{SpectrumMax} = $b;
         $w-> preprocess;
      }
      $w-> {ini}-> {visible_datasets} = unpack('I*', $nbpages-> Hyperset-> vector);
      $w-> IV-> repaint;
   } else {
      if ( ($w->{ini}->{SpectrumMin} != $ssl-> {saveMin}) ||
           ($w->{ini}->{SpectrumMax} != $ssl-> {saveMax})) {
         $w->{ini}->{SpectrumMin} = $ssl-> {saveMin};
         $w->{ini}->{SpectrumMax} = $ssl-> {saveMax};
         $w-> preprocess;
         $w-> IV-> repaint;
      }
   }
}

# OPT_END

package Run;


my $wfil = App::PLab::ImageAppWindow::winmenu_file();
splice( @{$$wfil[1]}, -1, 0,
   [ '-FileStats'  => "~Statistics"   => q(show_stats)],
   [ '-FileBackup' => "~Backup results" => q(file_backup)],
   [],
   
);

my $wedt = App::PLab::ImageAppWindow::winmenu_edit();
splice( @{$$wedt[2]}, 0, 0,
   [ EditAutoCrispening => "~Auto crispening" => q(crispen_state_changed) ],
   [ EditAutoStretching => "Auto stretching"  => q(stretching_state_changed) ],
   [ EditRemoveAll => "Remove all frame data"  => q(remove_frame_data) ],
   [],
   [ EditRecSetup => "Recognition ~setup"  => q(win_showrec), ],   
   [ -EditProcess => "~Automatic recognition" => q(process)],
   [ -EditProcessSeries => "Automatic ~series recognition" => q(process_series)],
   [],
);

my $w = LenWindow-> create(
   menuItems => [
      $wfil,
      $wedt,
      App::PLab::ImageAppWindow::winmenu_view(),
      [],["~Help" => [
         [ HelpAbout =>  "~About" => sub {Prima::MsgBox::message("PLab application series, Process Lengths, version 2.00", mb::OK|mb::Information)}],
         [ HelpPlabApps => "~PLab Apps" => sub { $_[0]-> open_help(); }],
      ]],
   ],
);
$w-> IV-> delegations(['Paint', 'MouseClick']);
$w-> sb_text("Started OK");
$w-> visible(1);
$w-> select;

$w-> win_extwarn;

$w-> win_loadfile( $ARGV[0]) if @ARGV;

run Prima;

