view release on metacpan or  search on metacpan

bin/PrLenS  view on Meta::CPAN

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) {