App-PLab
view release on metacpan or search on metacpan
$_[0]-> text('Cancelling');
},
);
my $g = $statwin-> insert( Gauge =>
origin => [ 5, 5],
size => [ $statwin-> width - 10, $statwin-> height - 10],
min => 0,
max => ( abs( $to - $curr) - 1) * 2,
value => 0,
font => {height => $statwin-> height - 16},
);
my $jump;
my @ambiguity;
$statwin-> execute_shared;
my $incr = $w-> {ini}->{forwardLookup} ? 1 : -1;
while ( $curr != $to + $incr) {
# loading cen file
my $cenname = $w-> win_extname( $w-> win_formfilename( $curr));
my $cck = $tb-> insert( Label =>
origin => [ 120 * $scale, 1],
size => [ $tb-> width - 138 * $scale, 36 * $scale],
name => 'PointRef',
text => '0:0',
growMode => gm::Client,
transparent => 1,
color => $self-> {ini}-> {Color_Label},
alignment => ta::Right,
valignment => ta::Center,
font => { style => fs::Bold },
);
$tb-> insert( Widget =>
origin => [ $tb-> width - 18 * $scale, 1],
size => [ 16 * $scale, 36 * $scale],
transparent => 1,
growMode => gm::Right,
name => 'Lookup',
onPaint => sub {
my ( $self, $canvas) = @_;
my ( $x, $y) = $canvas-> size;
bin/MorphometryI view on Meta::CPAN
$_[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("Calibration aborted - error processing file $f", mb::OK|mb::Error);
bin/MorphometryI view on Meta::CPAN
);
$dlg-> insert( Edit =>
origin => [ 1, 1],
size => [ $dlg-> width - 2, $dlg-> height - 2],
text => $texts,
growMode => gm::Client,
hScroll => 1,
vScroll => 1,
readOnly => 1,
font => { pitch => fp::Fixed},
wordWrap => 0,
syntaxHilite => 1,
hiliteNumbers => undef,
hiliteQStrings => undef,
hiliteQQStrings => undef,
hiliteIDs => undef,
hiliteChars => undef,
hiliteREs => [ '(N\/A)', cl::Red,
'(([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?\*)', cl::Red],
);
bin/MorphometryI view on Meta::CPAN
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],
name => 'CalcBrightness',
size => [ 300, 27],
text => 'Calculate ~brightness',
onCheck => sub {
$nbpages-> EqualBrightness-> set(
checked => ($_[0]-> checked ? $nbpages-> EqualBrightness-> checked : 0),
bin/PrAverB view on Meta::CPAN
sub win_printframe
{
my ( $w, $usedlg) = @_;
if ( $usedlg) {
my $d = $w-> {printerDialog};
$w-> {printerDialog} = $d = Prima::PrintSetupDialog-> create( owner => $w) unless $d;
$w-> iv_cancelmode( $w-> IV);
return unless $d-> execute;
}
my $p = $::application-> get_printer;
$p-> font-> size( 9);
if ( !$p-> begin_doc) {
Prima::MsgBox::message_box( $w->name, "Error starting print document", mb::Ok|mb::Error);
return;
}
my $ww = Prima::Window-> create(
borderIcons => 0,
borderStyle => bs::None,
size => [300, 100],
centered => 1,
);
$ww-> insert( Label =>
x_centered => 1,
text => 'Printing...',
font => {size => 18},
height => $ww-> height,
bottom => 0,
valignment => ta::Center,
);
$ww-> bring_to_front;
$ww-> update_view;
my @sz = $p-> size;
my $i = $w-> IV-> image;
my @isz = $i-> size;
my ( $x, $y) = ( $sz[0] / $isz[0], $sz[1] / $isz[1]);
my $z = $x < $y ? $x : $y;
$p-> stretch_image( 0, 0, $isz[0] * $z, $isz[1] * $z, $i);
my $fh = $p-> font-> height;
for ( @{$w-> {rects}}) {
my @rc = @{$_->{rect}};
$_ *= $z for @rc;
push @rc, @rc[0,1];
$p-> color( cl::White);
$p-> fillpoly( \@rc);
$p-> color( cl::Black);
$p-> polyline( \@rc);
@rc = @{$_->{bounds}};
[ 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,
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');
}
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;
}
$_[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);
message("You can save results only in '$exp_path' folder" . $w->DirList->path);
$w->DirList->path($exp_path);
});
}
}
$w = Prima::MainWindow->create(
size => [1060, 620],
minSize => [1060, 620],
text => 'MOREC 2',
font => {size => 12},
growMode => gm::Center,
menuItems => [
['~Commands' => [
["~Create directory in $exp_path.." => sub {
my $dir = input_box('Please enter new directory name','Directory name','');
return unless defined $dir;
if (mkdir "$exp_path/$dir") {
$disable_check_dir = 1;
$w->DirList->init_tree;
$w->DirList->path("$exp_path/$dir");
return unless $live_video;
read_frame();
my $t = time;
my $dt = $t - $last_time;
$last_time = $t;
$fps = sprintf("%.1f", 1/$dt);
$w->Video->repaint;
},
)->start;
my $fs = $w->font->height;
$w->insert( Label=>
origin => [10, 15],
text => "",
name => 'will',
);
$w->insert(Label=>
origin => [10, 50],
name => 'msg',
origin => [ 270, 24],
backColor => 0,
alignment => ta::Center,
valignment => ta::Center,
growMode => gm::YCenter|gm::GrowLoX,
onPaint => sub {
my ( $self, $canvas ) = @_;
$self->on_paint($canvas);
if ($w->menu->FPS->checked) {
$canvas->color(cl::LightGreen);
$canvas->text_out( $fps, 5, $canvas->height - $canvas->font->height - 5);
}
},
onMouseDown => \&iv_mousedown,
onMouseUp => \&iv_mouseup,
onMouseMove => \&iv_mousemove,
onMouseWheel => \&iv_mousewheel,
);
sub zoom
{
my $zoom = shift;
$w->msg->text("zoom: ".int($zoom * 100 + .5)."%");
$w->Video->zoom($zoom);
}
$w->insert( Button =>
text => '+',
origin => [ 982, 604 ],
size => [ 15, 15 ],
font => { height => 10 },
growMode => gm::GrowLoX|gm::GrowLoY,
onClick => sub { zoom($w->Video->zoom * 1.1) },
);
$w->insert( Button =>
text => '-',
origin => [ 1002, 604 ],
size => [ 15, 15 ],
font => { height => 10 },
growMode => gm::GrowLoX|gm::GrowLoY,
onClick => sub { zoom($w->Video->zoom * 0.9) },
);
$w->insert( Button =>
text => '0',
origin => [ 1022, 604 ],
size => [ 15, 15 ],
font => { height => 10 },
growMode => gm::GrowLoX|gm::GrowLoY,
onClick => sub { zoom(1) },
);
init_video();
run Prima;
bin/select_button_glyph view on Meta::CPAN
my $h = abs( $size[1] * $zoom);
$maxH = $h if $h > $maxH;
push ( @isz, [ abs($size[0] * $zoom), abs($size[1] * $zoom)]);
$maxIW = abs($size[0] * $zoom) if $maxIW < abs($size[0] * $zoom);
}
$i = 0;
my $a = $::application;
$a-> begin_paint_info;
my $fh = $a-> font-> height;
for ( @isz) {
my $tw = $a-> get_text_width( $inames[$i]);
$maxW = $tw if $maxW < $tw;
$i++;
}
$maxW += $maxIW + 4;
$maxH = $fh if $maxH < $fh;
$a-> end_paint_info;
lib/App/PLab/ButtonGlyphs.pm view on Meta::CPAN
use constant fileopen => 57;
use constant filesave => 58;
use constant find => 59;
use constant firstaid => 60;
use constant fldr2opn => 61;
use constant fldrmany => 62;
use constant fldropen => 63;
use constant fldrshut => 64;
use constant floppy => 65;
use constant foldrdoc => 66;
use constant font => 67;
use constant fontbold => 68;
use constant fontital => 69;
use constant fontsize => 70;
use constant form => 71;
use constant gears => 72;
use constant globe => 73;
use constant group => 74;
use constant grphbar => 75;
use constant grphline => 76;
use constant grphpie => 77;
use constant harddisk => 78;
use constant help => 79;
use constant helpindx => 80;
lib/App/PLab/ImageApp.pm view on Meta::CPAN
my ( $dlg, $me, $canvas, $index, $left, $bottom, $right, $top, $hilite, $focused) = @_;
return unless $dlg-> {series};
my $backColor = $hilite ? $me-> hiliteBackColor : $me-> backColor;
my $color = $hilite ? $me-> hiliteColor : cl::Fore | wc::ListBox;
$canvas-> color($backColor);
$canvas-> bar( $left, $bottom, $right, $top);
$canvas-> color($color);
my @ser = @{$dlg->{series}->[$index]};
my $text = "$ser[0]$ser[2].$ser[1]";
my $series = "$ser[2]-$ser[3]";
my $font = $canvas-> font;
my $h = $canvas-> font-> height;
my $w = $canvas-> get_text_width( $text);
$canvas-> text_out( $text, $left + 2, ($top + $bottom + 1 - $h) / 2);
$canvas-> font( height => $canvas-> font-> height - 2, pitch => fp::Fixed, style => fs::Bold);
$h = $canvas-> font-> height;
my $x = $left + $canvas-> get_text_width(' ') + $w;
$w = $canvas-> get_text_width( "9");
$canvas-> text_out( $series, $x + 1, ($top + $bottom + 1 - $h) / 2);
$canvas-> rectangle( $x, ($top + $bottom + 1 - $h) / 2, $x + $w * length( $series) + 2, ($top + $bottom + $h) / 2);
$canvas-> font( $font);
}
sub Files_MeasureItem
{
my ( $dlg, $self, $index, $sref) = @_;
$$sref = $self->get_text_width( $self-> get_item_text( $index)) + $self->get_text_width('m') * 8;
$self-> clear_event;
}
package App::PLab::TrDeviceBitmap;
lib/App/PLab/ImageApp.pm view on Meta::CPAN
name => 'ShowHint',
hint => 'Enables these little pop-ups like the one you are looking at right now',
);
my $optColors = $w-> opt_colors;
my @colorNames = map { $optColors->{$_}->[1] } sort keys %$optColors;
my @colorKeys = map { "Color_$_" } sort keys %$optColors;
if ( scalar keys %$optColors) {
my $x1 = $nb-> insert_to_page( 1, ComboBox =>
origin => [ 10, 10],
size => [ 170, $nb-> font-> height + 2],
style => cs::DropDownList,
name => 'NameSel',
items => \@colorNames,
onChange => sub {
my $colors = $dlg-> {page2}-> {colors};
$nbpages-> {deprecate} = 1;
$nbpages-> ColorSel-> value( $$colors[ $w->{nameSelFoc} = $_[0]-> focusedItem]);
$nbpages-> {deprecate} = undef;
},
);
$nb-> insert_to_page( 1, Label =>
origin => [ 10, 12 + $x1-> height],
size => [ 300, 28],
text => 'Color setup',
focusLink => $x1,
);
$nb-> insert_to_page( 1, ColorComboBox =>
name => 'ColorSel',
origin => [ 190, 10],
size => [ 56, $nb-> font-> height + 2],
onChange => sub {
my $self = shift;
if ( !$nbpages-> {deprecate} && $self->enabled) {
my $colors = $dlg-> {page2}-> {colors};
$$colors[ $nbpages-> NameSel-> focusedItem] = $self-> value;
my $i;
for ( $i = 0; $i < scalar @colorKeys; $i++) {
$w->{ini}->{$colorKeys[$i]} = $colors->[$i];
}
$w-> opt_colormount;
lib/App/PLab/ImageApp.pm view on Meta::CPAN
sub opt_properties
{
my $w = $_[0];
unless ( $w-> {propertySheet}) {
my $dlg = Prima::Window-> create(
size => [ 420, 460],
text => 'Properties',
owner => $w,
ownerShowHint => 0,
# font => $::application-> get_message_font,
%dlgProfile,
);
my $nb;
$w-> dlg_okcancel( $dlg);
$dlg-> OK-> set(
modalResult => 0,
onClick => sub {
$dlg-> ok if $w-> opt_propvalid( $dlg, $nb, $nb-> Notebook);
},
lib/App/PLab/ImageApp.pm view on Meta::CPAN
);
$w-> insert( "Panel",
text => "",
name => "StatusBar",
rect => [0, 0, $w-> width, 22],
indent => 2,
raise => 0,
buffered => 1,
growMode => gm::GrowHiX,
font => { name => "System VIO", height => 18,},
);
$w-> insert( 'App::PLab::TrImageViewer' =>
name => "IV",
rect => [ 2, $w-> StatusBar-> height + 2, $x - 2, $y - $w-> ToolBar-> height - 8],
hScroll => 1,
vScroll => 1,
growMode => gm::Client,
delegations => [qw(Size MouseUp MouseDown MouseMove Paint)],
( run in 2.614 seconds using v1.01-cache-2.11-cpan-5735350b133 )