App-PLab
view release on metacpan or search on metacpan
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?",
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"} = [];
} @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
( run in 0.919 second using v1.01-cache-2.11-cpan-5735350b133 )