App-PLab
view release on metacpan
or search on metacpan
bin/ManCen
view on Meta::CPAN
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | @ISA = qw(App::PLab::Calibrations) ;
sub win_inidefaults
{
my $w = $_ [0];
return (
$w -> SUPER::win_inidefaults,
forwardLookup => 0,
lookupEnabled => 0,
StdPointerShape => 0,
);
}
sub win_newframe
{
my $w = $_ [0];
$w -> SUPER::win_newframe;
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};
my $cenname = $w -> win_extname( $w -> {file});
if ( open F, "< $cenname" ) {
$w -> {points} = $w -> rpt_read( *F );
close F;
|
bin/ManCen
view on Meta::CPAN
347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 | $w -> IV-> repaint;
Prima::MsgBox::message( "Queue processed" , mb::OK|mb::Information);
} elsif ( defined $jump ) {
$w -> {ambiguity} = \ @ambiguity if $w -> win_loadfile( $jump ) && scalar ( @ambiguity );
}
}
sub win_closeframe
{
my $w = $_ [0];
$w -> SUPER::win_closeframe;
$w -> rpt_clear();
}
sub win_framechanged
{
my $w = $_ [0];
$w -> SUPER::win_framechanged;
$w -> sb_points();
$w -> win_untemp(0);
}
sub win_newextras
{
my $w = $_ [0];
$w -> SUPER::win_newextras;
my $cenname = $w ->{ini}-> {forwardLookup} ? $w -> {nextFile} : $w -> {prevFile};
if ( defined $cenname ) {
$cenname = $w -> win_extname( $cenname );
if ( open F, "< $cenname" ) {
$w -> {extraPoints} = $w -> rpt_read( *F );
close F;
}
}
}
sub win_closeextras
{
my $w = $_ [0];
$w -> SUPER::win_closeextras;
$w -> rptex_clear();
}
sub win_extraschanged
{
my $w = $_ [0];
$w -> win_untemp;
$w -> SUPER::win_extraschanged;
$w -> sb_points();
}
sub win_extpathchanged
{
my $w = $_ [0];
if ( defined $w -> {file}) {
my $i ;
my @pt = defined $w -> {points} ? @{ $w ->{points}} : ();
|
bin/ManCen
view on Meta::CPAN
412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 | $w -> win_newextras;
$w -> win_extraschanged;
$w -> IV-> repaint;
}
}
sub on_create
{
my $self = $_ [0];
my $w = $_ [0];
$self -> SUPER::on_create;
$self -> {dataExt} = 'cen' ;
$self -> win_pointerchanged();
my $scale = $::application-> uiScaling;
$scale = 1 if $scale < 1;
my $tb = $self -> ToolBar;
my $cck = $tb -> insert( Label =>
origin => [ 120 * $scale , 1],
size => [ $tb -> width - 138 * $scale , 36 * $scale ],
|
bin/ManCen
view on Meta::CPAN
534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | 'Points' => [ cl::LightGreen, 'Points' ],
'ExtraPoints' => [ cl::LightRed, 'Crosses' ],
'Pointer' => [ cl::Black, 'Cursor and selection' ],
'Label' => [ cl::Black, 'Label' ],
}
}
sub opt_keys
{
return {
%{ $_ [0]-> SUPER::opt_keys()},
EditClearPoints => [ kb::NoKey, 'Remove all points' ],
EditToggleLookup => [ kb::Space, 'Turn on or off neighbour points lookup' ],
HelpAbout => [ kb::NoKey, 'Standard about box' ],
HelpPlabApps => [ kb::NoKey, 'Online PlabApps overview' ],
HelpContents => [ kb::NoKey, 'Online ManCen overview' ],
}
}
sub opt_propcreate
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
$w -> SUPER::opt_propcreate( $dlg , $nb , $nbpages );
my $mh = 0;
for ( $nbpages -> widgets_from_page(1)) {
my $y = $_ -> top;
$mh = $y if $mh < $y ;
}
$nb -> insert_to_page( 1, CheckBox =>
origin => [ 10, $mh + 10],
size => [ 300, 36],
text => 'Default ~cursor shape' ,
name => 'CursorShape' ,
|
bin/ManCen
view on Meta::CPAN
577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 | size => [ 300, 36],
text => '~Display neighbour .cen' ,
name => 'LookupEnabled' ,
hint => 'Draws next or previous data points with crosses' ,
]);
}
sub opt_proppush
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
$w -> SUPER::opt_proppush( $dlg , $nb , $nbpages );
$nbpages -> CursorShape-> checked( $w ->{ini}->{StdPointerShape});
$nbpages -> ForwardLookup-> checked( $w ->{ini}->{forwardLookup});
$nbpages -> LookupEnabled-> checked( $w ->{ini}->{lookupEnabled});
}
sub opt_proppop
{
my ( $w , $dlg , $nb , $nbpages , $mr ) = @_ ;
$w -> SUPER::opt_proppop( $dlg , $nb , $nbpages , $mr );
if ( $mr ) {
$w ->{ini}->{StdPointerShape} = $nbpages -> CursorShape-> checked;
$w -> win_pointerchanged;
my $newlookup = $nbpages -> ForwardLookup-> checked;
if ( $newlookup != $w ->{ini}->{forwardLookup}) {
$w ->{ini}->{forwardLookup} = $newlookup ;
$w -> ToolBar-> Lookup-> repaint;
if ( $w ->{file}) {
$w -> win_closeextras;
$w -> win_newextras;
|
bin/ManCen
view on Meta::CPAN
754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 | if ( $btn == mb::Right && ! $self ->{transaction} && defined $w -> rpt_is( $self -> screen2point( $x , $y ))) {
$w -> {lastPopupPoint} = [ $self -> screen2point( $x , $y )];
$w -> iv_cancelmode( $self );
$self -> PointPopup-> popup( $self -> pointerPos);
$self -> clear_event;
return ;
}
$w -> SUPER::IV_MouseDown( $self , $btn , $mod , $x , $y );
return unless $self -> eventFlag;
if ( $btn == mb::Left && ! $self ->{transaction}) {
my ( $ax , $ay ) = $self -> screen2point( $x , $y );
if ( $ax >= 0 && $ay >= 0 && $ax < $w ->{IVx} && $ay < $w ->{IVy}) {
if ( $w -> rpt_toggle( $ax , $ay )) {
$self -> begin_paint;
$self -> color( $w ->{ini}->{Color_Points});
my $p = ( 6 * $self -> zoom < 1) ? 1 : ( 6 * $self -> zoom);
|
bin/ManCen
view on Meta::CPAN
801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | $r [2] = $x ;
$r [3] = $y ;
@r [0,2] = @r [2,0] if $r [0] > $r [2];
@r [1,3] = @r [3,1] if $r [1] > $r [3];
@r = $self -> screen2point( @r );
$w -> rpt_exclude( @r );
$self -> repaint;
return ;
}
$w -> SUPER::IV_MouseUp( $self , $btn , $mod , $x , $y );
}
sub IV_MouseMove
{
my ( $w , $self , $mod , $x , $y ) = @_ ;
if ( $self ->{transaction} && $self ->{transaction} == 4) {
$w -> IV_xorrect( $self );
$self -> {xorData}-> [2] = $x ;
$self -> {xorData}-> [3] = $y ;
$w -> IV_xorrect( $self );
$self -> clear_event;
}
$w -> SUPER::IV_MouseMove( $self , $mod , $x , $y );
}
sub IV_Paint
{
my ( $w , $self , $canvas ) = @_ ;
$self -> on_paint( $canvas );
my $wl = $w -> {points};
my $z = $self -> zoom;
my $p = ( 6 * $z < 1) ? 1 : ( 6 * $z );
$canvas -> translate( $self -> point2screen( 0, 0));
|
bin/MorphometryI
view on Meta::CPAN
316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 | $self -> {ini}-> { 'LW' . $self -> {currentSet}} = $width ;
$self -> sb_text( "Line width set:$width" );
}
sub win_inidefaults
{
my $w = $_ [0];
my $calcopt = '' ;
vec ( $calcopt , 0, 32) = ocq::Files | ocq::Basics;
return (
$w -> SUPER::win_inidefaults,
RecWindowPos => '100 100' ,
RecWindowVisible => 0,
UFThreshold => 40,
BinThreshold => 128,
EdgeSize => 3,
MinArea => 0,
MaxArea => 0,
LW0 => 1,
LW1 => 1,
LW2 => 3,
|
bin/MorphometryI
view on Meta::CPAN
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | FrameColor => 0,
InvertImage => 0,
);
}
sub on_create
{
my $self = $_ [0];
$self -> SUPER::on_create;
my $w = $self ;
$w -> {dataExt} = 'xml' ;
my $i = $w -> {ini};
my $xref = [
[ '*0' => "~Features" => \ &win_objectsetsmenuaction ],
[ '1' => "~Background" => \ &win_objectsetsmenuaction ],
[ '2' => "~Remove" => \ &win_objectsetsmenuaction ],
[],
[ LineWidthIncrement => '~Increase line width' => sub {
|
bin/MorphometryI
view on Meta::CPAN
422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 | borderWidth => 1,
);
$iv -> {drawmode} = $cck -> checked ? 1 : undef ;
init_convex( $w ->{ini}->{NumberOfRotations});
}
sub on_destroy
{
my ( $w , $i ) = ( $_ [0], $_ [0]->{ini});
$i -> {RecWindowVisible} = defined $w -> {recWindow} ? 1 : 0;
$w -> SUPER::on_destroy;
}
sub win_closeframe
{
my $w = $_ [0];
$w -> SUPER::win_closeframe;
$w -> pt_clear_all();
$w -> rpt_clear();
}
sub win_framechanged
{
my $w = $_ [0];
$w -> SUPER::win_framechanged;
$w -> {mirrorImage} = undef ;
my $i = $w -> IV-> image;
my $canApply = defined $i && $i -> type == im::Byte;
$w -> menu-> EditToggleMode-> enabled( defined $i );
$w -> menu-> EditApplyContours-> enabled( $canApply );
$w -> menu-> EditValidate-> enabled( defined $i );
$w -> menu-> EditImport-> enabled( defined $i );
$w -> ToolBar-> Contours-> enabled( defined $i );
if ( $w -> {recWindow}) {
my $r = $w -> {recWindow};
|
bin/MorphometryI
view on Meta::CPAN
793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 | if ($@) {
$w -> win_xmlerror( $xmlname );
return 0;
}
return \ %state ;
}
sub win_newframe
{
my $w = $_ [0];
$w -> SUPER::win_newframe;
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};
my $img = $w -> IV-> image;
|
bin/MorphometryI
view on Meta::CPAN
1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 | }
return 0 if Prima::MsgBox::message(
"Error saving file $xmlname. Ignore changes?" , mb::YesNo|mb::Warning) == mb::No;
}
return 1;
}
sub win_newextras
{
my $w = $_ [0];
$w -> SUPER::win_newextras;
return unless defined $w -> {prevFile};
my $num = $w ->{cypherMask};
my $xmlname ;
my ( $min , $max ) = $w -> win_getseriesrange;
$xmlname = $w -> win_formfilename( $min );
$xmlname = $w -> win_extname( $xmlname );
return unless -f $xmlname ;
|
bin/MorphometryI
view on Meta::CPAN
1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 | }
return unless $x ;
$w -> pt_updatemenu;
$w -> IV-> repaint;
$w -> modified(1);
}
sub win_closeextras
{
my $w = $_ [0];
$w -> SUPER::win_closeextras;
$w -> rptex_clear();
}
sub win_extraschanged
{
my $w = $_ [0];
$w -> SUPER::win_extraschanged;
$w -> menu-> EditOptCalib-> enabled( defined $w -> {nextFile} || defined $w -> {prevFile});
}
sub opt_colors
{
return {
|
bin/MorphometryI
view on Meta::CPAN
1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 | sub opt_colormount
{
my $w = $_ [0];
$w -> IV-> {bone}-> backColor( $w -> {ini}-> { $w -> {setColors}->[ $w -> {currentSet}]});
}
sub opt_keys
{
return {
%{ $_ [0]-> SUPER::opt_keys()},
EditImport => [ kb::NoKey , "Import another contours into document" ],
EditOptCalib => [ kb::NoKey , "Recalculate series" ],
EditCalcStats => [ '@C' , "Calculate and display statistics" ],
Undo1 => [ kb::Backspace , "Undo drawing" ],
Undo2 => [ km::Alt|kb::Backspace , "Undo group of lines" ],
Undo3 => [ '@U' , "Show undo dialog" ],
EditInvertImage => [ kb::NoKey , "Invert image" ],
EditClearAll => [ kb::NoKey , "Clear all drawings" ],
EditRemovePoints => [ kb::NoKey , "Remove all points" ],
EditToggleMode => [ 'F11' , "Toggle drawings/points mode" ],
|
bin/MorphometryI
view on Meta::CPAN
1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 | '(([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\*)' , cl::Red],
);
$dlg -> select ;
}
sub opt_propcreate
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
$w -> SUPER::opt_propcreate( $dlg , $nb , $nbpages );
$nb -> tabs( @{ $nb -> tabs}, 'Calculations' , 'Frame' );
$nb -> insert_to_page( $nb -> pageCount - 2,
[ Label =>
text => 'By default , only the area, the perimeter, the formfactor and centroid locations are calculated,though the program is perfectly capable of calculating all other parameters. The reason for disabling the rest is that it normally ta...
wordWrap => 1,
designScale => [ $nbpages -> font-> width, $nbpages -> font-> height],
valignment => ta::Top,
name => 'TopText' ,
],[ CheckBox =>
origin => [ 5, 185],
|
bin/MorphometryI
view on Meta::CPAN
1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 | $nbpages -> LineWidth-> value( $dlg -> {page2}-> {widths}-> [ $_ [0]-> focusedItem]);
$nbpages -> {deprecate} = undef ;
});
}
my %widcolors = ( Features => 1, Background => 1, Remove => 1);
sub opt_proppush
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
$w -> SUPER::opt_proppush( $dlg , $nb , $nbpages );
my $nbc = $nbpages -> pageIndex;
$nbpages -> pageIndex(3);
for ( qw( CalcBrightness EqualBrightness CalcConvex CalcHoles) ) {
$nbpages ->bring( $_ )->checked( $w ->{ini}->{ $_ });
}
$nbpages -> CalcBrightness-> notify( q(Check) );
$nbpages -> CalcHoles-> notify( q(Check) );
for ( qw( HolesPercent NumberOfRotations) ) {
$nbpages ->bring( $_ )->value( $w ->{ini}->{ $_ });
}
|
bin/MorphometryI
view on Meta::CPAN
1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 | $widths [ $ids {Remove}] = $w -> {ini}-> {LW2};
$dlg -> {page2}-> {widths} = \ @widths ;
$nbpages -> LineWidth-> value( $widths [ $nbpages -> NameSel-> focusedItem]);
$nbpages -> FrameWidth-> value( $w -> {ini}-> {FrameWidth});
$nbpages -> FrameColor-> index ( $w -> {ini}-> {FrameColor} ? 1 : 0);
}
sub opt_proppop
{
my ( $w , $dlg , $nb , $nbpages , $mr ) = @_ ;
$w -> SUPER::opt_proppop( $dlg , $nb , $nbpages , $mr );
if ( $mr ) {
for ( qw( EqualBrightness CalcBrightness CalcConvex CalcHoles) ) {
$w ->{ini}->{ $_ } = $nbpages -> bring( $_ )-> checked;
}
for ( qw( HolesPercent NumberOfRotations) ) {
$w ->{ini}->{ $_ } = $nbpages -> bring( $_ )-> value;
}
my $i = 0;
my %colors = %{ $w -> opt_colors};
my %ids = map { ( $_ , $i ++ ) } keys %colors ;
|
bin/MorphometryI
view on Meta::CPAN
2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 | $_ [0]-> {extraPoints} = undef ;
}
sub IV_MouseDown
{
my ( $w , $self , $btn , $mod , $x , $y ) = @_ ;
$w -> SUPER::IV_MouseDown( $self , $btn , $mod , $x , $y );
return unless $self -> eventFlag;
$self -> clear_event, return if $btn != mb::Left;
if ( $self ->{transaction}) {
if ( $self ->{transaction} == 2) {
my ( $ax , $ay ) = $self -> screen2point( $x , $y );
$self -> {transaction} = 1;
$w -> pt_add( $ax , $ay );
$w -> sb_text( "Freehand: $ax $ay" );
|
bin/MorphometryI
view on Meta::CPAN
2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 | $w -> iv_cancelmode( $self ) if $self -> {transaction} == 2;
$self -> clear_event;
return ;
}
}
sub IV_MouseUp
{
my ( $w , $self , $btn , $mod , $x , $y ) = @_ ;
return unless $self ->{transaction};
$w -> SUPER::IV_MouseUp( $self , $btn , $mod , $x , $y );
return unless $self -> eventFlag;
if ( $btn == mb::Left and $self -> {transaction} == 1) {
$self -> {transaction} = 2;
$self -> {xors} = undef ;
$w -> sb_text( "Lineplot:" );
$self -> clear_event;
}
}
sub IV_MouseMove
|
bin/MorphometryI
view on Meta::CPAN
2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 | 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 unless $self -> eventFlag && $self -> {transaction};
if ( $self -> {transaction} == 1) {
my ( $x1 , $y1 ) = $self -> point2screen( @{ $w -> pt_lines->[-1]}[-2,-1]);
$w -> pt_add( $self -> screen2point( $x , $y ));
$self -> begin_paint;
$self -> color( $w -> {ini}-> { $w ->{setColors}->[ $w ->{currentSet}]});
$self -> lineWidth( $self -> zoom * $w -> {ini}-> { 'LW' . $w ->{currentSet}});
$self -> line( $x , $y , $x1 , $y1 );
$self -> end_paint;
$w -> sb_text( "Freehand: $x1 $y1" );
|
bin/MorphometryI
view on Meta::CPAN
2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 | $canvas -> line( $x * $z - $p , $y * $z - $p , $x * $z + $p , $y * $z + $p );
$canvas -> line( $x * $z + $p , $y * $z - $p , $x * $z - $p , $y * $z + $p );
}
}
}
sub iv_cancelmode
{
my ( $w , $self ) = @_ ;
my $t = $self ->{transaction};
$w -> SUPER::iv_cancelmode( $self );
$w -> pt_close() if $t ;
}
sub iv_togglemode
{
my ( $w , $self ) = @_ ;
return if ! $ImageApp::testing and ! defined $self -> image;
$w -> iv_cancelmode( $self );
$self -> {drawmode} = defined $self -> {drawmode} ? undef : 1;
$w -> ToolBar-> Contours-> checked( defined $self -> {drawmode});
|
bin/MorphometryI
view on Meta::CPAN
2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 | }
@ISA = qw(Prima::Dialog) ;
sub profile_default
{
my $def = $_ [ 0]-> SUPER::profile_default;
my %prf = (
borderIcons => bi::SystemMenu | bi::TitleBar,
width => 207,
height => 306,
sizeDontCare => 0,
text => 'Parameters' ,
visible => 0,
);
@$def { keys %prf } = values %prf ;
return $def ;
}
sub init
{
my $self = shift ;
my %profile = $self -> SUPER::init( @_ );
my $image = Prima::Icon->create( width =>16, height =>16, type => im::bpp1,
palette => [ 0,0,0,0,0,0],
data =>
"\x01\x00\x00\x00A\x08\x00\x00\!\x10\x00\x00\x10 \x00\x00\x07\xc0\x00\x00" .
"\x080\x00\x001\x88\x00\x00C\xc0\x00\x00\x03\xc4\x00\x00\!\x88\x00\x00" .
"\x18p\x00\x00\x07\x80\x00\x00\x10\x10\x00\x00\!\x08\x00\x00A\x04\x00\x00" .
"\x01\x00\x00\x00" .
'' );
|
bin/MorphometryI
view on Meta::CPAN
2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 | my $self = $_ [0];
my $w = $self -> owner;
$w -> {recWindow} = undef ;
my $i = $w -> {ini};
$i -> {RecWindowPos} = join ( ' ' , $self -> origin);
$i -> {UFThreshold} = $self -> Union-> value;
$i -> {BinThreshold} = $self -> Binary-> value;
$i -> {EdgeSize} = $self -> Edge-> value;
$i -> {MinArea} = $self -> Min-> value;
$i -> {MaxArea} = $self -> Max-> value;
$self -> SUPER::cleanup();
}
my $wfil = App::PLab::ImageAppWindow::winmenu_file();
splice ( @{ $$wfil [1]}, -2, 0,
[],
[ EditImport => "~Import contours" => q(win_importextras) ],
[ '-EditOptCalib' => "~Recalculate series" => q(opt_changecalib) ],
[ EditCalcStats => "~Calculate statistics" => q(opt_statistics) ],
|
bin/PrAverB
view on Meta::CPAN
464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | }
@ISA = qw(App::PLab::ImageAppWindow) ;
sub win_inidefaults
{
my $w = $_ [0];
return (
$w -> SUPER::win_inidefaults,
PropShowMode => '1' ,
);
}
sub on_create
{
my $self = $_ [0];
my $w = $_ [0];
$self -> SUPER::on_create;
$self -> {dataExt} = 'pab' ;
$w -> {selectedRect} = undef ;
$w -> {rects} = [];
$w -> insert( Popup =>
autoPopup => 0,
selected => 0,
name => 'FigurePopup' ,
items => [
[ '~Duplicate' => 'Ctrl+D' => kb:: NoKey => q(win_figdup) ],
|
bin/PrAverB
view on Meta::CPAN
528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | onClick => sub { $w -> win_printframe(0); },
%btn_profile ,
],
);
}
sub win_closeframe
{
my $w = $_ [0];
$w -> SUPER::win_closeframe;
$w -> fig_clear();
}
sub win_newextras
{
my $w = $_ [0];
$w -> SUPER::win_newextras;
my $pabname = $w -> win_extname( $w ->{file});
if ( open F, "< $pabname" ) {
$_ = <F>;
return unless /Average\sbrightness\sdata/;
return unless /extinfo/;
my $i ;
LOOP: while (<F>) {
my $comments ;
chomp ;
|
bin/PrAverB
view on Meta::CPAN
719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | my ( $w ) = @_ ;
$w -> fig_clear;
$w -> IV-> repaint;
$w -> pointer( cr::Default);
$w -> modified( 1);
}
sub win_framechanged
{
my $w = $_ [0];
$w -> SUPER::win_framechanged;
$w -> menu-> FilePrint-> enabled( defined $w -> {file});
$w -> menu-> FileSave-> enabled( defined $w -> {file});
$w -> ToolBar-> FilePrint-> enabled( defined $w -> {file});
$w -> ToolBar-> FileSave-> enabled( defined $w -> {file});
}
sub fig_clear
{
|
bin/PrAverB
view on Meta::CPAN
950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 | $self -> capture( 1);
$self -> {anchor} = [ $x , $y ];
$self -> {xorData} = [ $x , $y , $x , $y , $x , $y , $x , $y ];
$w -> IV_xorrect( $self );
$self -> clear_event;
$w -> sb_text( "Draw a region" );
return ;
}
}
$w -> SUPER::IV_MouseDown( $self , $btn , $mod , $x , $y );
return unless $self -> eventFlag;
$self -> clear_event;
}
sub IV_MouseClick
{
my ( $w , $self , $btn , $mod , $x , $y , $dbl ) = @_ ;
|
bin/PrAverB
view on Meta::CPAN
977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 | }
}
}
sub IV_MouseUp
{
my ( $w , $self , $btn , $mod , $x , $y ) = @_ ;
return unless $self ->{transaction};
$w -> SUPER::IV_MouseUp( $self , $btn , $mod , $x , $y );
return unless $self -> eventFlag;
if ( $self ->{transaction} == tran::init && $btn == mb::Left) {
$self -> {transaction} = undef ;
$self -> capture( 0);
$w -> IV_xorrect( $self );
$self -> clear_event;
if ( $self -> {anchor}->[0] != $x && $self -> {anchor}->[1] != $y ) {
my $ix = $w -> fig_add( $self -> screen2point( @{ $self -> {xorData}}));
|
bin/PrAverB
view on Meta::CPAN
1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 | $self -> clear_event;
return ;
}
}
}
sub IV_MouseMove
{
my ( $w , $self , $mod , $x , $y ) = @_ ;
$w -> SUPER::IV_MouseMove( $self , $mod , $x , $y );
return unless $self -> eventFlag;
if ( $self ->{transaction} && $self ->{transaction} == tran::init) {
$w -> IV_xorrect( $self );
$self -> {xorData}-> [3] = $y ;
$self -> {xorData}-> [4] = $x ;
$self -> {xorData}-> [5] = $y ;
$self -> {xorData}-> [6] = $x ;
$w -> IV_xorrect( $self );
$self -> clear_event;
|
bin/PrAverB
view on Meta::CPAN
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 | {
return {
'Selection' => [ cl::Gray, 'Selection' ],
'AreaBorder' => [ cl::Cyan, 'Area border' ],
};
}
sub opt_keys
{
return {
%{ $_ [0]-> SUPER::opt_keys()},
FileSave => [ kb::F2, 'Save frame layout' ],
FilePrint => [ '^P' , 'Print current frame layout' ],
EditDuplicate => [ '^D' , 'Duplicate selected rectange' ],
EditDelete => [ kb::Delete , 'Delete selected rectange' ],
EditDeleteAll => [ kb::NoKey , 'Delete all rectanges' ],
},
}
|
bin/PrLenS
view on Meta::CPAN
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | @ISA = qw(App::PLab::Calibrations) ;
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,
|
bin/PrLenS
view on Meta::CPAN
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | ( 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,
|
bin/PrLenS
view on Meta::CPAN
753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 | {
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;
|
bin/PrLenS
view on Meta::CPAN
778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 | $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 );
|
bin/PrLenS
view on Meta::CPAN
1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 | }
$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 )];
|
bin/PrLenS
view on Meta::CPAN
1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 | '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],
|
bin/PrLenS
view on Meta::CPAN
1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 | $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};
|
bin/PrLenS
view on Meta::CPAN
1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 | }
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];
|
lib/App/PLab/Calibrations.pm
view on Meta::CPAN
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | @ISA = qw(App::PLab::ImageAppWindow) ;
sub win_inidefaults
{
my $w = $_ [0];
my @rc = $w -> rect;
return (
$w -> SUPER::win_inidefaults,
XCalibration => 1.0,
YCalibration => 1.0,
);
}
sub opt_propcreate
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
my @nbpages = @{ $nb -> tabs};
$nb -> set(
tabs => [ @nbpages , 'Calibrations' ],
pageCount => scalar ( @nbpages ) + 1,
);
my $pg = $nb -> pageCount;
$w -> SUPER::opt_propcreate( $dlg , $nb , $nbpages );
my %spinPrf = (
size => [ 265, 20],
min => 0.0001,
max => 10,
step => 0.01,
);
$nb -> insert_to_page( $pg , [
SpinEdit =>
origin => [ 5, 65],
|
lib/App/PLab/Calibrations.pm
view on Meta::CPAN
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | size => [ 265, 20],
autoWidth => 0,
text => '~Size of 1 vertical pixel, mkm' ,
focusLink => $nbpages -> YC,
]);
}
sub opt_proppush
{
my ( $w , $dlg , $nb , $nbpages ) = @_ ;
$w -> SUPER::opt_proppush( $dlg , $nb , $nbpages );
$nbpages -> XC-> value( $w ->{ini}->{XCalibration});
$nbpages -> YC-> value( $w ->{ini}->{YCalibration});
}
sub opt_proppop
{
my ( $w , $dlg , $nb , $nbpages , $mr ) = @_ ;
$w -> SUPER::opt_proppop( $dlg , $nb , $nbpages , $mr );
if ( $mr ) {
my ( $xc , $yc ) = ( $nbpages -> XC->value, $nbpages -> YC->value);
$w -> modified( 1) if
$w ->{ini}->{XCalibration} != $xc ||
$w ->{ini}->{XCalibration} != $yc ;
$w ->{ini}->{XCalibration} = $xc ;
$w ->{ini}->{YCalibration} = $yc ;
}
}
|
lib/App/PLab/ImageApp.pm
view on Meta::CPAN
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | no Prima::StartupWindow;
@ISA = qw(Prima::ImageOpenDialog) ;
sub init
{
my $self = shift ;
my %profile = $self -> SUPER::init( @_ );
my $dl = $self -> Files;
my %pf = (
name => 'Files' ,
rect => [ $dl -> rect],
items => $dl -> items,
designScale => undef ,
delegations => [ @{ $dl -> delegations}, $self , 'DrawItem' , 'MeasureItem' ],
);
|
lib/App/PLab/ImageApp.pm
view on Meta::CPAN
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | $self -> clear_event;
}
package App::PLab::TrDeviceBitmap;
@ISA = qw(Prima::DeviceBitmap) ;
sub translate
{
unless ( $#_ ) {
my @a = $_ [0]-> SUPER::translate;
if ( $_ [0]-> { override }) {
$a [ $_ ] -= $_ [0]-> { override }->[ $_ ] for 0,1;
}
return @a ;
}
my ( $self , $trx , $try ) = @_ ;
if ( $self -> { override }) {
$trx += $self -> { override }-> [0];
$try += $self -> { override }-> [1];
}
$self -> SUPER::translate( $trx , $try );
}
sub clipRect
{
unless ( $#_ ) {
my @a = $_ [0]-> SUPER::clipRect;
if ( $_ [0]-> { override }) {
$a [ $_ ] -= $_ [0]-> { override }->[ $_ ] for 0,1;
$a [ $_ +2] -= $_ [0]-> { override }->[ $_ ] for 0,1;
}
return @a ;
}
my ( $self , $trx , $try , $tax , $tay ) = @_ ;
if ( $self -> { override }) {
$trx += $self -> { override }-> [0];
$try += $self -> { override }-> [1];
$tax += $self -> { override }-> [0];
$tay += $self -> { override }-> [1];
}
$self -> SUPER::clipRect( $trx , $try , $tax , $tay );
}
@ISA = qw(Prima::Widget) ;
sub profile_default
{
my $def = $_ [ 0]-> SUPER::profile_default;
my %prf = (
width => 154,
height => 102,
syncPaint => 0,
);
@$def { keys %prf } = values %prf ;
return $def ;
}
sub on_create
|
lib/App/PLab/ImageApp.pm
view on Meta::CPAN
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 | @ISA = qw(Prima::ImageViewer) ;
sub invalidate_rect
{
my ( $self , @r ) = @_ ;
my $w = $self -> owner;
$w -> ivm_repaint( $self ) if $w -> {magnify};
$self -> SUPER::invalidate_rect( @r );
}
sub end_paint
{
my $self = $_ [0];
$self -> SUPER::end_paint;
my $w = $self -> owner;
$w -> ivm_repaint( $self ) if $w -> {magnify};
}
sub capture
{
return $_ [0]-> SUPER::capture unless $#_ ;
my ( $self , $capFlag , @rest ) = @_ ;
$self -> owner-> iv_cancelmagnify( $self )
if ! $capFlag && $self -> owner-> {magnify};
$self -> SUPER::capture( $capFlag , @rest );
}
sub screen2point
{
return map { int } shift -> SUPER::screen2point( @_ );
}
sub point2screen
{
return map { int } shift -> SUPER::point2screen( @_ );
}
use vars qw(@ISA %dlgProfile $ico $pointClickTolerance) ; @ISA = qw(Prima::Window) ;
$pointClickTolerance = 8;
%dlgProfile = (
centered => 1,
visible => 0,
|
lib/App/PLab/ImageApp.pm
view on Meta::CPAN
1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 | ) unless $self -> { timer};
$self -> { timer}-> stop;
$self -> { timer}-> timeout( $w -> {ini}-> {statusDelay} * 1000);
$self -> { timer}-> start;
}
sub profile_default
{
my $def = $_ [ 0]-> SUPER::profile_default;
my %prf = (
name => 'MainWindow' ,
size => [ 531, 594],
text => $::application-> name,
widgetClass => wc::Dialog,
);
@$def { keys %prf } = values %prf ;
return $def ;
}
sub init
{
my $self = shift ;
my %profile = $self -> SUPER::init( @_ );
my $w = $self ;
my ( $x , $y ) = $w -> size;
my $scale = $::application-> uiScaling;
$scale = 1 if $scale < 1;
$w -> insert( "Panel" ,
text => "" ,
name => "ToolBar" ,
|