Commit c2b72501 authored by Stefan Tauner's avatar Stefan Tauner
Browse files

Refine about windows

 - Change FIJIModalDialog to handle markup text with URLs.
 - Add a unified about text in a file.
 - Create a central show_about() and use that in Setup and EE.
parent 9b784aba
......@@ -23,14 +23,92 @@ sub Populate {
my ($self, $args) = @_;
my $image = delete $args->{'-image'};
my $text = delete $args->{'-text'};
my $markuptext = delete $args->{'-markuptext'};
my $wraplength = delete $args->{'-wraplength'};
$self->SUPER::Populate($args);
$self->{'label'} = $self->add('Label', -text => $text, -justify => 'left', )->pack(-side => 'right') if (defined $text);
Tk::FIJIUtils::set_icon($self);
$self->{'label'}->configure(-wraplength => $wraplength) if (defined $wraplength);
$self->{'image'} = $self->add('Label', -image => $image)->pack(-side => 'left') if (defined $image);
$self->add('Label', -image => $image)->pack(-side => 'left') if (defined $image);
if (defined $markuptext) {
# For markup txt we use Tk::Text.
# This allows us to set custom fonts and even add an URL handler
my $t = $self->add('Text',
-wrap => 'word',
# relief = flat would be ideal but there is a bug in Perl::Tk
# on Linux printing that draws a light line left of the widget.
-relief => 'groove',
-borderwidth => 2,
-padx => 15,
-pady => 15
)->pack(
-side => 'right',
-fill => both,
-expand => 1
);
my $tag = "tag000";
foreach ($markuptext) {
chomp;
my (@items) = split (/(https?:\S+)/,$_);
foreach (@items) {
$t->tagConfigure($tag, -font => "Verdana 13");
$t->insert( 'end', $_, $tag );
if (/(https?:\S+)/) {
$t->tagConfigure( $tag, -foreground => 'blue' );
$t->tagBind(
$tag,
'<Any-Enter>' => [ \&manipulate_link, $tag, 'raised', 'hand2' ],
);
$t->tagBind(
$tag,
'<Any-Leave>' => [ \&manipulate_link, $tag, 'flat', 'xterm' ] );
$t->tagBind(
$tag,
'<Button-1>' => [ \&manipulate_link, $tag, 'sunken' ]
);
$t->tagBind(
$tag,
'<ButtonRelease-1>' => [ \&manipulate_link, $tag, 'raised', undef, sub { Tk::FIJIUtils::cross_platform_open($self, $_[1]); } ]
);
}
$tag++;
}
$t->insert( 'end', "\n" );
}
$t->configure(-state => 'disabled');
} elsif (defined $text) {
my $lbl = $self->add('Label', -text => $text, -justify => 'left', )->pack(-side => 'right');
$lbl->configure(-wraplength => $wraplength) if (defined $wraplength);
} else {
$logger->debug("Neither text nor markuptext given for modal dialog");
}
}
sub manipulate_link {
# manipulate the link as you press the mouse key
my ($a) = shift;
my ($tag) = shift;
my ($relief) = shift;
my ($cursor) = shift;
my ($after) = shift;
# by configuring the relief (to simulate a button press)
$a->tagConfigure( $tag, -relief => $relief, -borderwidth => 1 );
# by changing the cursor between hand and xterm
$a->configure( -cursor => $cursor ) if ($cursor);
# and by scheduling the specified action to run "soon"
if ($after) {
my ($s) = $a->get( $a->tagRanges($tag) );
$a->after( 50, [ $after, $a, $s, $tag, @_ ] ) if ($after);
}
}
sub Show {
......
......@@ -3,9 +3,11 @@ package Tk::FIJIUtils;
use Scalar::Util 'blessed';
use Tk::Photo;
use Tk::FIJIModalDialog;
use constant SCROLL => 5;
use Log::Log4perl qw(get_logger);
use FIJI qw(:fiji_dir :fiji_documentation_path :fiji_media_path);
my $about_file = File::Spec->catdir(FIJI_MEDIA_PATH, "about.txt");
use constant SCROLL => 5;
# The next few functions abstract some commonly used image files.
# Due to some bug^Wfeature in the Perl implementation we cannot re-use
......@@ -113,8 +115,34 @@ sub show_documentation {
return cross_platform_open($parent, FIJI_DOCUMENTATION_PATH);
}
sub show_about {
my $logger = get_logger("");
my $parent = shift;
if (!defined($about_text)) {
my $about_fh;
if (!defined(open($about_fh, '<', $about_file))) {
$logger->error("Cannot open file $about_file");
return 1;
}{
local $/;
$about_text = <$about_fh>;
}
close($about_fh);
}
my $logo_image = logo_image($parent);
my $d = $parent->FIJIModalDialog(
-title => "About",
-buttons => ["Close"],
-image => $logo_image,
-markuptext => $about_text,
);
$d->geometry("950x".($logo_image->height()+55)."+0+0");
$d->minsize(950, $logo_image->height()+55);
$d->Show();
}
sub set_icon ($) {
my $mw = shift;
......
......@@ -427,17 +427,7 @@ sub _menu {
$help->command(
-label => 'About',
-underline => 0,
-command => sub {
my $d = $mw->DialogBox(
-title => "About",
-buttons => ["Close"]
);
my $t = $d->Scrolled('Text', -scrollbars => "oe", -width => 80, -height => 16);
$t->pack(-fill => "both", -expand => 1);
$t->Contents("fiji download");
$t->configure(-state => "disabled");
$d->Show();
}
-command => [\&Tk::FIJIUtils::show_about, $mw],
);
$mw->configure(-menu => $menubar);
}
......
......@@ -56,19 +56,6 @@ use constant UNCHANGED_VALUE => "";
use constant APPNAME => 'FIJI Settings Editor';
my $abouttxt = <<'END_ABOUT';
#-------------------------------------------------------------------------------
# University of Applied Sciences Technikum Wien
#
# Department of Embedded Systems
# http://embsys.technikum-wien.at
#
# Josef Ressel Center for Verification of Embedded Computing Systems
# http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
END_ABOUT
my $unsaved_changes = 0;
my $delete_main = 1;
my $current_dir = ".";
......@@ -289,17 +276,7 @@ sub _menu {
$help->command(
-label => 'About',
-underline => 0,
-command => sub {
my $d = $mw->DialogBox(
-title => "About",
-buttons => ["Close"]
);
my $t = $d->Scrolled('Text', -scrollbars => "oe", -width => 80, -height => 16);
$t->pack(-fill => "both", -expand => 1);
$t->Contents($abouttxt);
$t->configure(-state => "disabled");
$d->Show();
}
-command => [\&Tk::FIJIUtils::show_about, $mw],
);
$mw->configure(-menu => $menubar);
}
......
For a description of this application please see the user manual.
University of Applied Sciences Technikum Wien
All rights reserved.
Department of Embedded Systems
http://embsys.technikum-wien.at
Josef Ressel Center for Verification of Embedded Computing Systems
http://vecs.technikum-wien.at
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment