package orac_Font;
use strict;
@orac_Font::ISA = qw{orac_Base};
=head1 NAME
orac_Font.pm - Orac Font Selector
=head1 DESCRIPTION
This code is provides a way of altering fonts
on the main configurable background widgets.
=head1 PUBLIC METHODS
&new()
&orac_fonter()
=cut
use vars qw( $curr_font @widths
@fonts @sizes @weights @slants @old_font_bits
);
=head2 new
Sets up the blessed object. Sets the window reference and screen title.
Picks up all the systems fonts.
=cut
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my ($l_window, $l_text, $l_screen_title) = @_;
my $self = orac_Base->new("Font", $l_window, $l_text, $l_screen_title);
bless($self, $class);
# Pick up all the systems fonts, and other stuff.
my @unsort_fonts = $self->{Text_var}->fontFamilies();
@fonts = sort @unsort_fonts;
my $width = 0;
foreach my $font (@fonts)
{
if (length($font) > $width)
{
$width = length($font);
}
}
@sizes = (8, 10, 12, 14, 16, 18, 20, 22, 24, );
@weights = ('normal','bold');
@slants = ('roman','italic');
@widths = ($width, 2, 6, 6, );
return $self;
}
=head2 orac_fonter
The function called, when in use from the main Orac menu. Pumps up
the screen, and sets up the required font.
=cut
sub orac_fonter {
my $self = shift;
my ($balloon_ref, $font_button_ref) = @_;
# Set up window, menus etc
$self->{window} = $self->{Main_window}->Toplevel();
$self->{window}->title( $self->{Version} );
my(@fontsel_lay) = qw/-side top -expand no -fill both/;
my $fontsel_menu = $self->{window}->Frame->pack(@fontsel_lay);
my @font_names = $self->{Text_var}->fontNames();
$curr_font =
main::font_button_message ($balloon_ref, $font_button_ref, );
$self->top_left_message( \$fontsel_menu, $main::lg{font_message } );
$self->top_right_ball_message( \$fontsel_menu,
\$curr_font,
\$self->{window}
);
# Now start the work
my $balloon;
$self->balloon_bar(\$balloon, \$self->{window}, 60, );
my $f0 = $self->{window}->Frame(-relief=>'ridge',
-bd=>2,
)->pack( -side=>'top',
-expand => 'n',
-fill => 'both'
);
my @values;
my $app_but = $f0->Button(-text => $main::lg{apply},
-command => sub {
$self->apply_font( \@values,
$balloon_ref,
$font_button_ref
)
}
)->pack(-side => 'left', -padx=>2, -fill => 'both');
$balloon->attach($app_but, -msg => $main::lg{font_warning});
$self->orac_image_label(\$f0, \$self->{window}, );
$self->window_exit_button(\$f0, \$self->{window}, 1, \$balloon,);
# Now we can do the original frame work
my $f1 = $self->{window}->Frame;
$f1->pack(-side=>'top', -expand => 'y', -fill => 'both');
my @labels;
my @entrys;
my @txt_labs;
$txt_labs[0] = 'Font';
$txt_labs[1] = 'Size';
$txt_labs[2] = 'Weight';
$txt_labs[3] = 'Slant';
$values[0] = $main::font{family};
$values[1] = $main::font{size};
$values[2] = $main::font{weight};
$values[3] = $main::font{slant};
@old_font_bits = @values;
my @options = (\@fonts, \@sizes, \@weights, \@slants);
# Go Grid crazy! Assign the widgets to starting
# racetrack postitions. Haven't I seen this somewhere
# before? :)
foreach my $i (0..3)
{
$labels[$i] = $f1->Label(-text=>$txt_labs[$i] . ':',
-anchor=>'e',
-justify=>'right');
$entrys[$i] = $f1->BrowseEntry(-state=>'readonly',
-variable=>\$values[$i],
-foreground=>$main::fc,
-background=>$main::ec,
-width=>$widths[$i],
-choices=>$options[$i],
);
Tk::grid( $labels[$i],
-row=>$i,
-column=>0,
-sticky=>'e',
-padx=>10,
-pady=>10
);
Tk::grid( $entrys[$i],
-row=>$i,
-column=>1,
-sticky=>'w',
-padx=>10,
-pady=>10
);
}
$f1->gridRowconfigure(1,-weight=>1);
$entrys[0]->focusForce;
main::iconize( $self->{window} );
}
sub apply_font {
my $self = shift;
my ( $vals_ref,
$balloon_ref,
$font_button_ref,
) = @_;
my @vals = @$vals_ref;
$main::font{family} = $vals[0];
$main::font{size} = $vals[1];
$main::font{weight} = $vals[2];
$main::font{slant} = $vals[3];
my $font_command =
' $main::font{name} = ' .
' $self->{Text_var}->fontCreate( -family => $main::font{family}, ' .
' -size => $main::font{size}, ' .
' -weight => $main::font{weight}, ' .
' -slant => $main::font{slant}, ' .
' ); ';
eval $font_command;
if ($@) {
warn $@;
main::mes($self->{window}, 'jesus wept' );
} else {
main::bc_upd();
$curr_font =
main::font_button_message ($balloon_ref, $font_button_ref, );
}
return;
}
1;