view release on metacpan or  search on metacpan

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

package App::PLab::ImageApp;
use vars qw($testing $VERSION);

$VERSION = '1.00';

use strict;
use Carp;
use Cwd qw(abs_path);

use Prima qw( StartupWindow StdBitmap Widgets StdDlg ImageViewer MsgBox
              IniFile Sliders Utils Notebooks ComboBox Buttons Label Outlines
              ColorDialog KeySelector ImageDialog);
use App::PLab::ButtonGlyphs;
use App::PLab::ImageAppGlyphs;
no Prima::StartupWindow;

package App::PLab::SerOpenDialog;
use vars qw(@ISA);
@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'],
   );
   $dl-> destroy;
   $self-> insert( ListViewer => %pf);

   return %profile;
}

sub Dir_Change
{
   my ( $self, $dir) = @_;
   my $w = $self-> owner;
   my $mask = $self-> {mask};
   my @files = grep { /$mask/i; } $dir-> files( 'reg');
   @files = sort {uc($a) cmp uc($b)} @files if $self->{sorted};

   my %vecs = ();
   my $nums = $w-> {cypherMask};
   for (@files)
   {
      next unless /^(.+)(\d{$nums})\.([^\.]*)$/;
      my ($sername, $num, $ext) = ($1, $2, $3);
      $vecs{ $sername} = [ pack( "b1000", "0" x 100), $ext] unless exists $vecs{ $sername};
      vec( $vecs{ $sername}->[0], $num, 1) = 1;
   }
   my @series = ();
   my $max = 10 ** $nums - 1;
   for my $sername (sort keys %vecs)
   {
      my ($j, $k);
      my $s = unpack( b1000 => $vecs{ $sername}->[0]);    # to exploit string functions
      $j = index( $s, '1');
      while ( $j >= 0)
      {
         $k = index( $s, '0', $j);
         if ( $k < 0)
         {
            $s = '';
            push @series, [ $sername , $vecs{ $sername}->[1],
               sprintf("%0${nums}d",$j), sprintf("%0${nums}d",$max)] if $j < $max;
         }
         else
         {
            $s = ('0' x $k) . substr( $s, $k);
            push @series, [ $sername , $vecs{ $sername}->[1],
               sprintf("%0${nums}d",$j), sprintf("%0${nums}d",$k - 1)] if $j < $k - 1;
         }
         $j = index( $s, '1');
      }
   }

   $self-> {series} = [@series];
   $self-> Files-> items([ map { "$$_[0]$$_[2].$$_[1]"} @series]);
   $self-> Directory_FontChanged( $self-> Directory);
}

sub Files_DrawItem
{
   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;
use vars qw(@ISA);
@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);
}

package App::PLab::MagnifyingGlassWidget;
use vars qw(@ISA);
@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
{
   $_[0]-> {canvas} = App::PLab::TrDeviceBitmap-> create(
      width  => 76,
      height => 50,
      backColor => $_[0]-> owner-> backColor,
   );
}

sub on_paint
{
   $_[1]-> rectangle( 0, 0, 153, 101);
   $_[1]-> stretch_image( 1, 1, 152, 100, $_[0]-> {canvas});
}


package App::PLab::TrImageViewer;
use vars qw(@ISA);
@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( @_);
}

package App::PLab::ImageAppWindow;
use vars qw(@ISA %dlgProfile $ico $pointClickTolerance);
@ISA = qw(Prima::Window);
$pointClickTolerance = 8;

%dlgProfile = (
   centered    => 1,
   visible     => 0,
   designScale => [7, 16],
);
$ico = Prima::Icon-> create;
$ico-> combine(
   Prima::Image-> create(
      width   => 32,
      height  => 32,
      type    => im::Mono,
      palette => [0,0,0,255,255,255],
      data    => pack( 'C*' ,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8,0,0,15,244,0,0,3,194,0,0,15,250,
0,0,31,253,0,0,63,253,0,0,127,254,128,0,127,254,128,0,231,255,64,0,215,255,64,1,182,219,64,1,
86,219,64,0,142,219,64,0,13,183,0,0,29,182,0,0,59,180,0,0,55,104,0,0,11,96,0,0,0,128,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
      ),
   ),
   Prima::Image-> create(
      width   => 32,
      height  => 32,
      type    => im::Mono,
      palette => [0,0,0,255,255,255],
      data    => pack( 'C*',
255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
255,255,255,255,255,240,7,255,255,224,3,255,255,224,1,255,255,224,1,255,255,192,0,255,255,128,0,
255,255,0,0,127,255,0,0,127,254,0,0,63,254,0,0,63,252,0,0,63,252,32,0,63,254,96,0,63,255,224,0,
127,255,192,0,255,255,128,1,255,255,128,3,255,255,192,15,255,255,252,31,255,255,255,255,255,255,
255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
      ),
   ),
);

sub dlg_okcancel
{
   my ( $w, $self) = @_;
   $self-> insert( Button =>
      origin => [ 10, 20],
      size   => [ 96, 36],
      text   => '~Ok',
      name   => 'OK',
      default => 1,
      modalResult => mb::Ok,
   );
   $self-> insert( Button =>
      origin => [ 116, 20],
      size   => [ 96, 36],
      text   => 'Cancel',
      modalResult => mb::Cancel,
   );
}

lib/App/PLab/ImageApp.pm  view on Meta::CPAN

   my @o = $self-> pointerPos;
   $j-> {override} = [ -$o[0] + 38, -$o[1] + 25];
   $j-> translate( 0, 0);
   $w-> IV_Paint( $self, $j);
   $j-> {override} = [ 0, 0];
   $j-> translate( 0, 0);
   $w-> {magnify}-> repaint;
}

sub iv_magnify
{
   my ( $w, $self) = @_;
   return if $w-> {magnify};
   my $x = $self-> insert( 'App::PLab::MagnifyingGlassWidget' );
   $x-> focus;
   $w-> IV-> capture(1);
   $w-> {magnify} = $x;
   $w-> ivm_repaint( $self, $self-> pointerPos);
}

sub iv_cancelmagnify
{
   my ( $w, $self) = @_;
   return unless $w->{magnify};
   $w->{magnify}-> destroy;
   $w->{magnify} = undef;
   $w-> IV-> capture(0);
}

# IV_END
# SB

sub sb_text
{
   my ( $w, $text, $color) = @_;
   my $self = $w-> StatusBar;
   $self-> color( defined $color ? cl::LightRed : cl::Fore);
   $self-> set(
      text  => $text,
      raise => 1,
   );
   $self-> update_view;
   $self-> { timer} = $self-> insert( Timer =>
      onTick  => sub {
         $_[0]-> stop;
         $_[0]-> owner-> set(
            text  => '',
            raise => 0,
         );
      },
   ) unless $self-> { timer};
   $self-> { timer}-> stop;
   $self-> { timer}-> timeout(  $w-> {ini}-> {statusDelay} * 1000);
   $self-> { timer}-> start;
}

# SB_END

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",
      origin    => [ 2, $y - 2 - 38 * $scale],
      size      => [ $x - 4, 38 * $scale],
      raise     => 1,
      image     => App::PLab::ImageAppGlyphs::image( bga::tile_m),
      growMode  => gm::GrowHiX | gm::GrowLoY,
   );

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

   $w-> ToolBar-> insert(
      [ SpeedButton =>
         origin    => [1, 1],
         image     => App::PLab::ButtonGlyphs::icon( bg::fldropen),
         hint      => 'Open file',
         onClick   => sub { $w-> win_openfile; },
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "PrevImage",
         origin  => [42 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::prev),
         enabled => 0,
         hint    => 'Previous image',
         onClick => sub { $w-> win_prevfile; },
         %btn_profile,
      ],
      [ SpeedButton =>
         name    => "NextImage",
         origin  => [78 * $scale, 1],
         image   => App::PLab::ImageAppGlyphs::icon( bga::next),
         enabled => 0,
         hint    => 'Next image',
         onClick => sub { $w-> win_nextfile; },
         %btn_profile,
      ],
   );

   $w-> insert( "Panel",
      text  => "",
      name     => "StatusBar",
      rect     => [0, 0, $w-> width, 22],
      indent   => 2,