view release on metacpan or  search on metacpan

ZooZ/Options.pm  view on Meta::CPAN

      $types = [
		['GIF Files',    '.gif'],
		['PGM Files',    '.pgm'],
		['PPM Files',    '.ppm'],
		['Bitmap Files', '.bmp'],
		['Pixmap Files', '.xpm'],
		['All Files',    '*'   ],
	       ];
    }

    my $file;
    $frame->Entry(-textvariable       => \$file,
		  -state              => 'disabled',
		  -disabledforeground => 'black',
		 )->grid(-column => $col + 1,
			 -row    => $row,
			 -sticky => 'ew',
			);
    $frame->Button(-text    => '...',
		   -padx    => 0,
		   -pady    => 0,
		   -command => sub {
		     my $ans = $frame->getOpenFile(-title     => 'Select Image',
						   -filetypes => $types);
		     return unless $ans;
		     $file = $ans;

		     my $type;
		     if      ($file =~ /\.(?:gif|pgm|ppm)$/) {
		       $type = 'Photo';
		     } elsif ($file =~ /\.bmp$/) {
		       $type = 'Bitmap';
		     } elsif ($file =~ /\.xpm$/) {
		       $type = 'Pixmap';
		     } else { # reset
		       $$ref = 'image-zooz';
		       return;
		     }
		     $$ref = $frame->$type(-file => $file);
		   })->grid(-column => $col + 2,
			    -row    => $row,
			    -padx   => 1,
			    -sticky => 'ew',
			   );

  } elsif ($type eq 'Hash') {
    my %h   = @list;
    my $key = $$ref ? do {
      (grep $h{$_} eq $$ref => keys %h)[0]
    } : $list[0];
    $$ref   = $h{$key};

    my $e = $frame->BrowseEntry(
				-choices            => [sort {$h{$a} <=> $h{$b}} keys %h],
				-state              => 'readonly',
				-variable           => \$key,
				-disabledforeground => 'black',
				-browsecmd          => sub { $$ref = $h{$key} },
			       )->grid(-column     => $col + 1,
				       -row        => $row,
				       -columnspan => 2,
				       -sticky     => 'ew',
				      );

  } elsif ($type eq 'List') {
    my $e = $frame->BrowseEntry(
				-choices            => [@list],
				-state              => 'readonly',
				-variable           => $ref,
				-disabledforeground => 'black',
			       )->grid(-column     => $col + 1,
				       -row        => $row,
				       -columnspan => 2,
				       -sticky     => 'ew',
				      );

  } elsif ($type eq 'Integer') {
    my $pos = shift @list || 0;
    my $rgx = $pos ? qr/^\d$/ : qr/^(?:-|\d|\.)$/;

    $frame->Entry(
		  -textvariable    => $ref,
		  -validate        => 'key',
		  -validatecommand => sub {
		    return 1 unless $_[4] == 1 || $_[4] == 8;  # Tk800 and Tk804
		    return 0 unless $_[1] =~ /$rgx/;
		    return 1;
		  },
		 )->grid(-column     => $col + 1,
			 -row        => $row,
			 -columnspan => 2,
			 -sticky     => 'ew',
			);

  } elsif ($type eq 'String') {
    $frame->Entry(
		  -textvariable      => $ref,
		 )->grid(-column     => $col + 1,
			 -row        => $row,
			 -columnspan => 2,
			 -sticky     => 'ew',
			);

  } elsif ($type eq 'Boolean') {
    $frame->Checkbutton(-text     => 'On/Off',
			-variable => $ref,
			-anchor   => 'w',
		       )->grid(-column     => $col + 1,
			       -row        => $row,
			       -columnspan => 2,
			       -sticky     => 'ew',
			      );

  } elsif ($type eq 'Font') {
    $$ref ||= 'Default';
    $frame->Entry(-textvariable  => $ref,
		  -relief        => 'flat',
		  -state         => 'disabled',
		  -disabledforeground => 'black',
		 )->grid(-column => $col + 1,
			 -row    => $row,
			 -sticky => 'ew',
			);
    $frame->Button(
		   -bitmap  => 'transparent',
		   -fg      => Tk::NORMAL_BG,
		   -height  => 9,
		   -width   => 9,
		   -command => sub {
		     my $f = ZooZ::Forms->chooseFont;
		     return unless $f;

		     $$ref = $f;
		     #$l->configure(-text => $f);
		   },
		  )->grid(-column => $col + 2,
			  -row    => $row,
			  -padx   => 1,
			  -sticky => 'ew',
			 );

  } elsif ($type eq 'Callback') {
    #$$ref = 'Select Callback' unless $$ref;
    my $b;

    $b = $frame->Button(-text         => $$ref || 'Select Callback',
			-pady         => 0,
			-command      => sub {
			  my $cb = ZooZ::Forms->chooseCallback;
			  return unless $cb;

			  if ($cb eq 'UNSET') {
			    $b->configure(-text => 'Select Callback');
			    $$ref = undef;
			    return;
			  }

			  $b->configure(-text => '\&' . $cb);
			  $$ref = eval "\\&$cb";

			  $::CALLBACKOBJ->name2code($cb, $$ref);
			},
		       )->grid(-column     => $col + 1,
			       -row        => $row,
			       -columnspan => 2,
			       -sticky     => 'ew',
			      );

  } elsif ($type eq 'VarRef') {
    $$ref = 'Select Variable' unless $$ref;
    my $b;

    $b = $frame->Button(-text    => $$ref,
			-pady    => 0,
			-command => sub {
			  my $vr = ZooZ::Forms->chooseVar;
			  return unless $vr;

			  if ($vr eq 'UNSET') {
			    $b->configure(-text => 'Select Variable');
			    $$ref = '';

			    # if a textvariable, reset the -text.
			    # it doesn't happen automatically.
			    if ($option eq '-textvariable') {
			      $ {$args[0]} .= '';  # it is tied.
			    }

			    return;
			  }

			  $b->configure(-text => "\\" . $vr);

			  my $cp = $vr;
			  # create the var
			  {
			    $vr =~ s/^.//;
			    no strict;
			    $$ref = \${"main::$vr"};
			  }

			  $::VARREFOBJ->name2ref($cp, $$ref);

			})->grid(-column     => $col + 1,
				 -row        => $row,
				 -columnspan => 2,
				 -sticky     => 'ew',
				);

  } elsif ($type eq 'Name') {
    $frame->Entry(
		  -textvariable      => $ref,
		  -validate          => 'key',
		  -validatecommand   => sub { #disallow spaces
		    return 1 unless $_[4] == 1 || $_[4] == 8;  # Tk800 and Tk804
		    return 0 if     $_[1] =~ /\s/;
		    return 1;
		  })->grid(-column     => $col + 1,
			 -row        => $row,
			 -columnspan => 2,
			 -sticky     => 'ew',
			);

    $label->configure(-font => 'Default', -relief => 'solid', -bg => $args[0] || Tk::NORMAL_BG);
  }

  # configure the row to make it look nice.
  $frame->gridRowconfigure($row, -minsize => $maxHeight, -weight => 2);

  return $label;
}

sub _chooseColor {
  my ($f, $ref, $b) = @_;

  my $color = $f->chooseColor;
  $color or return;

  $$ref = $color;
  $$b->configure(-bg => $color);
}

1;