#!/usr/pkg/bin/perl
# gus_calibrate.pl version 2005-01-20
# Copyright 2004 by Gan Uesli Starling
# Program presents a formated way to record calibration records.
# Lines of code = 1811; Comment lines = 415
# See POD at EOF for full description.

# BEGIN { $diagnostics::PRETTY = 1 }
# use diagnostics;

our $formal_name      = 'Calibration Record';    # Plain language name of program.
our $formal_date      = '2005-01-20';            # Version ID = date of modification
our $debug_flag       = 0;                       # For building, debugging and upgrading.
our $browser_filepath = '';                      # May put in user config area instead.

use English;     # Because I forget the cryptic names of format special variables.
use Cwd;
use Tk;
use Tk::Pane;
use Tk::Balloon;
use strict;
use warnings;    # Complains of ininitialized strings, etc.

###########################################
# End template header. Begin script body. #
###########################################

use vars qw (
    @buffer
    $stack_foo
    $balloon $balloons $feedback
    $color_bg_balloon $color_fg_balloon $help_info
    $path_input $path_output
    $frame_fields @filetypes $format
    @upper_field_hashrefs 
    $frame_ratio $ratio_flag
);

BEGIN { print "\n\n\n\n\n\n\n\n\n\nNEW TRIAL RUN\n\n"; }

############################################
############################################
###                                      ###
###  Begin stuff the user may configure  ###
###                                      ###
############################################
############################################

# Start out with a hint to the user.
$feedback = "Version date = $formal_date";
$format   = "%8.1f";        # How many significant decimal points?
our $cal_runs = 2;          # How many data runs to display?
our $readings = 10;         # How many readings to take?
our $interval = 100;        # What interval between readings?
our $lines_per_page = 50;   # Form break on printed pages.
our $run_frames = 2;        # How many rows of runs shown at start.
our $runs_per_frame = 2;    # How many data runs shown per row frame.

############################################
############################################
###                                      ###
###   End stuff the user may configure   ###
###                                      ###
############################################
############################################

###################
# Begin GUI stuff #
###################

# Used and reference copies so can make temp changes.
my $label_width = my $label_width_default = 12;
my $entry_width = my $entry_width_default = 50;

$color_bg_balloon = 'darkseagreen';
$color_fg_balloon = 'black';

# First declare the main GUI frame and all her daughters.

my $mw = MainWindow->new( -title => " $formal_name", );

# Provide help info as balloon widgets.
$help_info = $mw->Label(
    -borderwidth => 2,
    -relief      => 'groove',
    -background  => $color_bg_balloon,
    -foreground  => $color_fg_balloon,
);

$balloon = $mw->Balloon(
    -statusbar       => $help_info,
    -balloonposition => 'mouse',
    -background      => $color_bg_balloon,
    -foreground      => $color_fg_balloon,
);

$balloon->attach( $help_info, -msg => 'Hover mouse on any widget then read here.' );

# Begin MENU CONFIG

# Begin MENU BAR -- Note: this method left out when you do... $mw->setPalette('darkseagreen');
$mw->configure( -menu => my $menubar = $mw->Menu );

my $menu_config = $menubar->cascade( -label => '~Config' );
$menu_config->command(
    -label   => "Configure",
    -command => sub { GUS::user_config::start_MainLoop(); },
);

# Begin MENU HELP
my $menu_help = $menubar->cascade( -label => '~Help' );
$menu_help->command(
    -label   => "About",
    -command => sub { GUS::help_about::start_MainLoop() },
);

# Outermost frame because Pane can't be sunken.
my $frame_top = $mw->Frame(
    -relief      => 'sunken',
    -borderwidth => 5
);

# To accomodate over-sized space if user configures many datapoints.
my $pane_top = $frame_top->Scrolled(
    'Pane', -scrollbars => 'soe',
    -sticky => 'we'
);

# List of supported file patterns
@filetypes = ( [ 'Text', '.txt' ], [ 'Data', '.dat' ], [ 'Any', '*.*' ] );

# Pack the upper template frames.
$frame_top->pack( -side => 'top', -expand => 1, -fill => 'both' );
$pane_top->pack( -side  => 'top', -expand => 1, -fill => 'both' );

################################
# Begin non-template GUI stuff #
################################

#############################
# Begin upper fields labels #
#############################

my @field_labels_head = (
    'Calibrating Agency',
    'Verification Method',
    'Temperature',
    'Humidity',
    'This Cal Date',
    'Next Cal Due',
    'Technician',

);

my @field_balloons_msg_head = ( @field_labels_head,
);

my @field_balloons_status_head = ( @field_labels_head,
);

my @field_labels_indicator = (
    'Make',
    'Model',
    'Serial',
    'Channel',
    'In-house ID',
    'Last Cal Date',
    'Last Cal Due',
    'Certificate',

);

my @field_labels_xdcr = (
    'Make',
    'Model',
    'Serial',
    'In-house ID',
    'Last Cal Date',
    'Last Cal Due',
    'Certificate',
);

my @field_balloons_msg_lft = ( @field_labels_indicator, @field_labels_xdcr
);

my @field_balloons_status_lft = ( @field_labels_indicator, @field_labels_xdcr
);

my @field_balloons_msg_rgt = ( @field_labels_indicator, @field_labels_xdcr
);

my @field_balloons_status_rgt = ( @field_labels_indicator, @field_labels_xdcr
);

################################
# End right hand fields labels #
################################

sub max_string_length {
    my $max = 0;
    foreach (@_) {
        my $len = length $_;
        $max = $len if $max < $len;
    }
    return $max;
}

use vars qw(
    $frame_fields $frame_a
    $frame_b $frame_b1 $frame_b2
    $frame_c $frame_c1 $frame_c2
    @scale_fs_uut @scale_fs_std $full_scale_uut $full_scale_std
    @units_uut @units_std $units_uut $units_std );

sub build_upper_fields {

    $frame_fields->destroy() if Tk::Exists($frame_fields);

    # A separate frame for adding input file widget sets.
    $frame_fields = $pane_top->Frame(
        -relief      => 'flat',
        -borderwidth => 5
    );

    # A separate frame for adding input file widget sets.
    $frame_a = $frame_fields->Frame(
        -relief      => 'groove',
        -label       => 'HEADER',
        -borderwidth => 5
    );

    $frame_b = $frame_fields->Frame(
        -relief      => 'flat',
        -borderwidth => 0
    );

    $frame_c = $frame_fields->Frame(
        -relief      => 'flat',
        -borderwidth => 0
    );

    $frame_b1 = $frame_b->Frame(
        -relief      => 'groove',
        -label       => 'INDICATOR UNDER CAL',
        -borderwidth => 5
    );

    $frame_c1 = $frame_c->Frame(
        -relief      => 'groove',
        -label       => 'TRANSDUCER UNDER CAL',
        -borderwidth => 5
    );

    $frame_b2 = $frame_b->Frame(
        -relief      => 'groove',
        -label       => 'INDICATOR STANDARD',
        -borderwidth => 5
    );

    $frame_c2 = $frame_c->Frame(
        -relief      => 'groove',
        -label       => 'TRANSDUCER STANDARD',
        -borderwidth => 5
    );

    $frame_fields->pack( -side => 'top',  -expand => 1, -fill => 'x' );
    $frame_a->pack( -side => 'top',  -expand => 1, -fill => 'x' );
    $frame_b->pack( -side    => 'top', -expand => 1, -fill => 'x' );
    $frame_c->pack( -side    => 'top', -expand => 1, -fill => 'x' );
    $frame_b1->pack( -side    => 'left', -expand => 1, -fill => 'x' );
    $frame_b2->pack( -side    => 'left', -expand => 1, -fill => 'x' );
    $frame_c1->pack( -side    => 'left', -expand => 1, -fill => 'x' );
    $frame_c2->pack( -side    => 'left', -expand => 1, -fill => 'x' );

    # Build the label and entry widgets for string input
    push @upper_field_hashrefs,
        mk_upper_field( $frame_a, \@field_labels_head, \@field_balloons_msg_head,
        \@field_balloons_status_head );

    push @upper_field_hashrefs,
        mk_upper_field( $frame_b1, \@field_labels_indicator, \@field_balloons_msg_lft,
        \@field_balloons_status_lft );
    push @upper_field_hashrefs,
        mk_upper_field( $frame_c1, \@field_labels_xdcr, \@field_balloons_msg_lft,
        \@field_balloons_status_lft );

    push @upper_field_hashrefs,
        mk_upper_field( $frame_b2, \@field_labels_indicator, \@field_balloons_msg_rgt,
        \@field_balloons_status_rgt );
    push @upper_field_hashrefs,
        mk_upper_field( $frame_c2, \@field_labels_xdcr, \@field_balloons_msg_rgt,
        \@field_balloons_status_rgt );

    # Two arrays for auto-picking max scale of Tk scales for FS.
    our $units_all = [ 'mm', 'cm', 'in',    'N', 'kN',  'lbf', 'klbf',  'N-m', 'Ohms', 'mV/V'];
    our $units_max = [  250,   25,   10, 25_000,  250, 50_000,    250,  1_200,   4.4, ];

    # Pick a max fs appropriate to chosen unit-of-measure. This is a convenience
    # because scale widget is zoomable. Nice for starters, though.
    sub max_scale {
        my ($unit, $units_max_aref, $units_all_aref ) = @_;

        # Undefined till radiobutton selected...purposely so.
        $unit = $units_all_aref->[0] unless defined($unit);

        # Example use: $foo = max_scale('mm', \@units_max, \@units_all );
        my $max_fs;
        for ( 0 ... $#{ $units_max_aref } ) {
            $max_fs = $units_max_aref->[$_];
            last if $unit eq $units_all_aref->[$_];

        }
        return $max_fs;
    }

    sub mk_fs_scale_uut {

        # Build a scale widget with appropriate max value for unit-of-measure.
        $scale_fs_uut[0]->destroy if Tk::Exists( $scale_fs_uut[0] );
        @scale_fs_uut =
            GUS::tk::frame_label_zoom( $frame_c1, 'Full Scale:', 1,
                max_scale( $units_uut, $units_max, $units_all ), 0, 500_000, 0.01 
            );
            $balloon->attach(
                $scale_fs_uut[2],
                -balloonmsg => "Range of UUT?",
                -statusmsg => 'Adjust for the full scale range to use for this calibration.',
            );
            $balloon->attach(
                $scale_fs_uut[3], -balloonmsg => "Zoom out?",
                -statusmsg => 'Recenter and coarsen the scale by twice its current span.',
            );
            $balloon->attach(
                $scale_fs_uut[4], 
                -balloonmsg => "Zoom in?",
                -statusmsg => 'Recenter and sharpen the scale by half its current span.',
            );

    }

    sub mk_fs_scale_std {

        # Build a scale widget with appropriate max value for unit-of-measure.
        $scale_fs_std[0]->destroy if Tk::Exists( $scale_fs_std[0] );
        @scale_fs_std =
            GUS::tk::frame_label_zoom( $frame_c2, 'Full Scale:', 1,
                max_scale( $units_std, $units_max, $units_all ),
                0, 500_000, 0.01 
            );
            $balloon->attach(
                $scale_fs_std[2], 
                -balloonmsg => "Range of Cal Std?",
                -statusmsg => 'Adjust for the full scale range to use for this calibration.',
            );
            $balloon->attach(
                $scale_fs_uut[3], -balloonmsg => "Zoom out?",
                -statusmsg => 'Recenter and coarsen the scale by twice its current span.',
            );
            $balloon->attach(
                $scale_fs_uut[4], 
                -balloonmsg => "Zoom in?",
                -statusmsg => 'Recenter and sharpen the scale by half its current span.',
            );
    }

    @units_uut = GUS::tk::frame_label_radio( 4,
        $frame_c1, 'Units:', $units_all, \$units_uut, \&mk_fs_scale_uut );

    @units_std = GUS::tk::frame_label_radio( 4,
        $frame_c2, 'Units:', $units_all, \$units_std, \&mk_fs_scale_std );

    &mk_fs_scale_uut();
    &mk_fs_scale_std();
        
    if ( $debug_flag ) {
        $units_uut[2]->select();
        $units_std[2]->select();
        $scale_fs_uut[2]->set(100);
        $scale_fs_std[2]->set(2);
    }
}

sub mk_upper_field {
    my $parent         = $_[0];
    my @labels         = @{ $_[1] };
    my @balloon_msg    = @{ $_[2] };
    my @balloon_status = @{ $_[3] };

    # Don't let labels crowd up. Make temporary width change.
    $label_width = max_string_length(@labels);
    $entry_width = 10;

    my %hash = ();

    foreach ( 0 ... $#labels ) {
        my $key = $labels[$_];
        my @widgets = GUS::tk::frame_label_entry( $parent, $labels[$_], \$hash{$key} );
        $balloon->attach(
            $widgets[2],
            -balloonmsg => $balloon_msg[$_],
            -statusmsg  => $balloon_status[$_],
        );

        $hash{$key} = "$key" if $debug_flag;

    }
    return \%hash;
}

# A pop-up field for when UUT FS != Std FS...as if for an unequal bellcrank, etc.
# Refer to sub compensate_uut within sub calc_errors
sub mk_ratio_radio {
    $frame_ratio = $frame_fields->Frame(
        -relief      => 'groove',
        -label       => 'RATIO OF COMPARISON',
        -borderwidth => 5
    )->pack( -side  => 'top', -expand => 1, -fill => 'both' );
    
    my @ratio_radio = GUS::tk::frame_label_radio( 5, 
        $frame_ratio, 'Unit Ratio:', ['1:1','FS:FS'], \$ratio_flag,
    );
    $balloon->attach(
        $ratio_radio[2], -balloonmsg => 'UUT:Std = 1:1.',
        -statusmsg => "Check if ratio of UUT:Standard = 1:1 despite their full scales being unequal."
    );
    $balloon->attach(
        $ratio_radio[3], -balloonmsg => 'UUT:Std = FS:FS.',
        -statusmsg => "Check if ratio of UUT:Standard != 1:1 because their full scales are unequal."
    );
}

####################################
# End subs for upper field widgets #
####################################

##########################################
# Begin subs for matrix of entry widgets #
##########################################
#
#  @rows_of_runs =
# 
#  [
#    [   Frame, # Row A, Col 0 = $rows->[0][0] = Outer frame for whole 1st row. Has top label.
#        Frame, # Row A, Col 1 = $rows->[0][1] = Leftmost frame.
#        Frame, # Row A, Col 2 = $rows->[0][2] = Frame 2nd-from-left
#    ],         # Row A = $rows->[0]
# 
#    [   Frame, # Row B, Col 0 = $rows->[1][0] = Outer frame for whole 2nd row. Has top label.
#        Frame, # Row B, Col 1 = $rows->[1][1] = Leftmost frame.
#        Frame, # Row B, Col 2 = $rows->[1][2] = Frame 2nd-from-left
#    ],         # Row B = $rows->[1]
# 
#    # And so forth...
#  ]
#
#########################################

use vars qw ( @rows_of_runs );

sub init_readings_frames {        

    # Destroy outermost frame of every row.
    while ( my $a_ref = shift @rows_of_runs ) { $a_ref->[0]->destroy();    }
        
        for ( my $i = 0; $i < $run_frames; ++$i ) {
                    
            push @rows_of_runs, []; # New empty row.

        # A separate frame for adding input file widget sets.
        push @{ $rows_of_runs[-1] }, $pane_top->Frame(
            -label       => 'CALIBRATION DATA POINT ENTRY',
            -relief      => 'flat',
            -borderwidth => 5
        )->pack( -side     => 'top',  -expand => 1, -fill => 'x' );


        for ( my $j = 1; $j <= $runs_per_frame; ++$j ) {
                    my $run_number = $i * $runs_per_frame + $j;
                        
            # A separate frame for adding input file widget sets.
            push @{ $rows_of_runs[-1] }, ${ $rows_of_runs[-1] }[0]->Frame(
                -label       => "RUN NUMBER $run_number" ,
                -relief      => 'groove',
                -borderwidth => 5
            )->pack( -side => 'left', -expand => 1, -fill => 'x' );
                }
        }

}

sub get_polarity {
    my $units = $_[0];
    my $choices;
    if    ( $units eq 'N-m' ) { $choices = ['CW', 'CCW'] }
    elsif ( $units =~ /mV\/V/ ) { $choices = ['Positive', 'Negative'] ;}
    elsif ( $units =~ /[mm|cm|in]/ ) { $choices = ['Extension', 'Retraction'] }
    elsif ( $units =~ /[N|kN|lbf|klbf]/ ) { $choices = ['Compression', 'Tension'] }
    return  $choices;
}

use vars qw( @runs @rdgs_when @rdgs_from @rdgs_polarity);

sub build_input_matrices {
    init_readings_frames();
    @runs = @rdgs_when = @rdgs_from = @rdgs_polarity = ();

    $balloons = [
        'Nominal value.',
        'The ideal target value only very closely approximated.',
        'Standard readout?',
        'Enter the what the Standard Reference is reporting.',
        'UUT readout?',
        'Enter what the Unit Under Test is reporting.',
        'Reading error.',
        'Reading error = ( UUT - Standard ) / Standard * 100',
        'Full scale error.',
        'Error as percent of full scale = ( UUT - Standard ) / Full_Scale * 100',
    ];
        
    my @rdgs_radios; # For use in debugging.
        
    my @label_list =
        ( 'Nominal', 'Readout Standard', '  Readout UUT  ', '    Error %   ', '  Error % FS  ' );
        
    foreach my $row ( @rows_of_runs ) {
        for ( 1 .. $#$row ) {     

            push @rdgs_from, '';
            push @rdgs_radios, 
            GUS::tk::frame_label_radio( 5, $row->[$_], 'For which:', ['Xdcr','Channel','Xdcr & Channel'], \$rdgs_from[-1],);

            if ( $units_uut ne 'Ohms' ) {
                push @rdgs_polarity, '';
                push @rdgs_radios, 
                GUS::tk::frame_label_radio( 5, $row->[$_], 'Direction:', get_polarity($units_uut), \$rdgs_polarity[-1],);
            }
            else { push @rdgs_polarity, 'n/a' }

            push @rdgs_when, '';
            push @rdgs_radios, 
            GUS::tk::frame_label_radio( 5, $row->[$_], 'From when:', ['As found','As adjusted'], \$rdgs_when[-1],);
                        
            GUS::tk::frame_label_labels(   $row->[$_], @label_list );
            push @runs, mk_matrix_entries( $row->[$_], 8, $readings, 4, $interval, $balloons );
        }        
    }
        
    # Debugging aid, auto-select every rightmost radio button.
    if ( $debug_flag ) {
        foreach my $a_ref ( @rdgs_radios ) {  
            $a_ref->select() if ref $a_ref eq 'Tk::Radiobutton'; 
        }        
    }
}

sub mk_matrix_entries {
    my ( $parent, $label_width, $rows, $cols, $increment, $balloons_aref ) = @_;
    my $row_label = 0; # Starting row label is zero.

    # Build a separate annonymous array for each.
    my @array;

    # Row count is selectable via the config menu. Build to suit.
    for ( my $i = 1 ; $i <= $rows + 2 ; ++$i ) {
        my $matrix = [];
        $row_label = '0' if $i == $rows + 2; # Final row label also zero.
        my @row    = ( $row_label, );

        # Create array for cols 1, 2, 3 of a given run.
        for ( my $j = 1 ; $j <= $cols ; ++$j ) {
            push @array, '';
            if ( defined &debug_fill ) { debug_fill($j, $i, $interval, $rows, $cols, \$array[-1]) }
            $row[$j] = \$array[-1];
        }

        # Build the row of cols 1, 2, 3 for this run.
        my @widgets = GUS::tk::frame_label_entries( $parent, @row );

        # Prevent calcualted-value entry boxes from taking focus with TAB key.
        $widgets[-1]->configure( -takefocus => 0);
        $widgets[-2]->configure( -takefocus => 0);

        # Give user clues via baloons and status window.
        for ( 1 ... $#widgets ) {
            $balloon->attach(
                $widgets[$_],
                -balloonmsg => $balloons_aref->[ ($_ - 1) * 2 ],
                -statusmsg  => $balloons_aref->[ ($_ - 1) * 2 + 1 ],
            ) if defined $balloons_aref;
        }
        push @$matrix, \@row;
        $row_label += $increment;
    }       
    return \@array;
}

################################
# DELETE SUB BELOW AFTER DEBUG #
################################

# Fill out form with pseudo-data to debug error calc.
sub debug_fill {
    my ($j, $i, $interval, $rows, $cols, $ref ) = @_;
    if ( $debug_flag && ( $j < $cols - 1 ) ) {
        my @time   = localtime(time);
        my $offset;

        # Set at exact step value.
        $$ref = $interval * ( $i - 1 );

        if ( $j % 2 == 1 ) {

            # The standard column.
            $offset = $interval / ( 104 + $time[1] % 40 + rand );
            if ($time[1] % 2 == 0) { $$ref += $offset }
            else { $$ref -= $offset }
        }
        else {

            # The UUC column.
            $offset = $interval / ( 220 + $time[1] % 30 + rand );
            if ($time[0] % 2 == 0) { $$ref += $offset }
            else { $$ref -= $offset }
        }                

        # Overwrite last row for final zero.
        $$ref = $interval / 150 + rand if $i == $rows + 2;
        $$ref = sprintf "%8.3f", $$ref;
    }
}

sub calc_errors {
    my ( $i, $flag_format_inputs_too ) = @_;
    my $array_ref = $runs[$i];
    my $numeric   = '^-?[0-9]+\.?[0-9]*$';    # Any int or real number.

    sub compensate_uut {
        my ($std_rdg,) = @_;

        # Compensate only if user has explicitly chosen ratiometric compensation.
        # Refer to sub mk_ratio_radio 
        $std_rdg =  $std_rdg / $scale_fs_std[2]->get() * $scale_fs_uut[2]->get()
            if $ratio_flag eq 'FS:FS';

        return $std_rdg;
    }

    for ( 0 ... $#{$array_ref} ) {

        # 1st quad of indices:
        #     0th = Readout form calibration standard (user input).
        #     1st = Readout from transducer being cal'd (user input).
        #     2nd = Percent error calculated here for output.
        #     3rd = Percent-of-full scale error calculated here for output.
        if ( ( $_ == 2 ) || ( $_ == $#{$array_ref} - 1 ) ) {

                # Top and bottom of column are near-zero values.
                $array_ref->[$_] = '   n/a   ';
        }
        elsif ( $_ % 4 == 2 ) {

            # This is the 'calculated percent error' column. Calculate it if
            # meets these conditions:
            # 1. Not top or bottom of column (zero readings).
            # 2. Both input data columns are properly numeric.
            if ( ( $array_ref->[ $_ - 1 ] =~ /$numeric/ )
                && ( $array_ref->[ $_ - 2 ] =~ /$numeric/ ) )
            {

                # The input data are both numeric.
                $array_ref->[$_] = ' ' . sprintf "%8.3f",
                    ( $array_ref->[ $_ - 1 ] - compensate_uut($array_ref->[ $_ - 2 ]) ) /
                    ( compensate_uut($array_ref->[ $_ - 2 ]) + 0.0000001 ) * 100;
            }
            else {

                # One or both of the data are non-numeric.
                $array_ref->[$_] = '  ?  ';
            }
        }
        if ( $_ % 4 == 3 ) {

            # This is the 'calculated percent-of-fs error' column. Calculate it
            # if the FS scale widget has been adjusted and also both input
            # data columns are properly numeric.
            if ( ( $array_ref->[ $_ - 2 ] =~ /$numeric/ ) &&
                 ( $array_ref->[ $_ - 3 ] =~ /$numeric/ ) ) {

                # Full scale won't have polarity. So test polarity of regular percent error
                # and in sure it is the same by making 100 percent plus or minus. Otherwise
                # it flips to opposite on below-zero readings.
                my $hundred = 100;
                if ( $array_ref->[ $_ - 1 ] !~ 'n/a') {
                    $hundred = -100 if $array_ref->[ $_ - 1 ] < 0;
                }
                

                # The input data are both numeric.
                $array_ref->[$_] = ' ' . sprintf "%8.3f",
                    abs( $array_ref->[ $_ - 2 ] - compensate_uut($array_ref->[ $_ - 3 ]) ) /

                    # FS value gotten from scale widget.
                    ( $scale_fs_uut[2]->get() + 0.0000001 ) * $hundred;
            }
            else {

                # One or both of the data are non-numeric.
                $array_ref->[$_] = '  ?  ';
            }

        }
        else {

            # Assume any whitespace is a typo.
            $array_ref->[$_] =~ s/\s//g;

            # This is one of the two data input columns.
            if ( $array_ref->[$_] =~ /$numeric/ ) {

                # This input datum is numeric. Format it.
                $array_ref->[$_] = sprintf $format, $array_ref->[$_] if $flag_format_inputs_too;
            }
        }
    }
}

sub rebuild_input_matrices {

}

# Automatically rebuild matrices if FS or units change.
sub recheck_input_matrices {
    if ( defined($units_uut) && defined($units_std) ) {
        if ( $interval != $scale_fs_uut[2]->get() / $readings ) {
            $interval = $scale_fs_uut[2]->get() / $readings;
            build_input_matrices();
        }

        # Elect whether to compare UUT against Standard ratiometrically.
        # Refer to sub mk_ratio_radio about '1:1' versus 'FS:FS'
        if (    ( $units_uut ne $units_std ) ||
                ( $scale_fs_uut[2]->get() != $scale_fs_std[2]->get() )
           ) { 
            mk_ratio_radio() unless Tk::Exists($frame_ratio); 
            if ( $units_uut ne $units_std ) { $ratio_flag = 'FS:FS'; }  
            else { $ratio_flag = '1:1'; }  
        }
        else { $ratio_flag = '1:1';
               $frame_ratio->destroy() if Tk::Exists($frame_ratio); }
    }
}

# Check regularly for user-change of full scale.
$mw->repeat( 1000, \&recheck_input_matrices );

########################################
# End subs for matrix of entry widgets #
########################################

################################
#  End non-template GUI stuff  #
################################

my $frame_btm = $mw->Frame(
    -relief      => 'flat',
    -borderwidth => 5
);

# Make some buttons.
my @buttons = GUS::tk::frame_label_buttons(
    $frame_btm,
    'Action:',

    [ 'Read', 'Write', 'Show', 'Quit' ], [
        sub {
            tell_then_do(
            "Reading from input path...", sub {
                $feedback = "Oops! Feature not available yet.";

                #print "INPUT FILE = $path_input \n" if $debug_flag;
                #if ($path_input) {
                #    initialize_paths();
                #    start_over_init();
                #}
                #else { $feedback = "Oops! Input path is empty."; }
            } );
        },
        sub {
            tell_then_do(
            "Writing to output path...", sub {
                open_for_writing();
                $feedback = "Okay! Done writing." unless $feedback =~ m/Oops/;
            } );
        },
        sub {
            tell_then_do(
            "Opening output file in browser...", sub {
                GUS::os_detect::show_in_viewer($path_output);
                $feedback = "Okay!." unless $feedback =~ m/Oops/;
            } );
        },
        \&quit_MainLoop,
    ],
    [   'blue',
        'red',
        'green',
        'green',
    ]
);

# Give hints to user
$balloon->attach(
    $buttons[2], -balloonmsg => 'Read input file.',
    -statusmsg => "Open file for editing."
);
$balloon->attach(
    $buttons[3], -balloonmsg => 'Write output file',
    -statusmsg => "Date time code will be appended to name to avoid overwriting."
);
$balloon->attach(
    $buttons[4], -balloonmsg => 'Exit the program',
    -statusmsg => "Unsaved edits will be lost."
);

my @fdbk = GUS::tk::frame_label_entry( $frame_btm, 'Feedback:', \$feedback );
$balloon->attach(
    $fdbk[2], -balloonmsg => 'Read stuff here.',
    -statusmsg => "Any problems encountered will be reported in the feedback window."
);

$help_info->pack( -side => 'top', -expand => 0, -fill => 'x' );
$frame_btm->pack( -side => 'top', -expand => 0, -fill => 'x' );

build_upper_fields();

$mw->repeat( 500,
    sub {
        foreach ( 0 ... $#runs) { 

            # First make sure that radio buttons are selected. Else the
            # readings/errors will be without much significance.
            if ( $rdgs_from[$_] && 
                 $rdgs_when[$_] && 
                 $rdgs_polarity[$_] ) 
            {                
                calc_errors($_); # Calculate % and %FS error columns.
            }
        }
    } 
);

MainLoop;

# Give feedback message then do something...
sub tell_then_do {
    my $pause = 100;    # Default if no $_[2]
    $pause    = $_[2] if $_[2];
    $feedback = $_[0];
    $mw->after( $pause, $_[1] );
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    $mw->destroy() if Tk::Exists($mw);
    GUS::user_config::quit_MainLoop();
    GUS::help_about::quit_MainLoop();
}

###################
#  End GUI stuff  #
###################

sub any_true_in_list {
    while ( shift @_ ) { last if $_; }
    return $_;
}

# Return Date Time Group in ISO 8601 approved fashion.
sub update_DTG {
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    my $DTG =
        sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min,
        $sec );
    return ("$DTG");
}

# Stuff to do on first go and when starting over.
sub start_over_init {
}

sub open_for_reading {
    if ( open( IN, "< $path_input" ) ) {

    }
    else { $feedback = "Oops! Can\'t open $path_input: $!"; }
}

sub make_model_serial {
    my ($i, $a_ref,) = @_;
    my $assy = '';
    for ( 0,1,2 ) {
        $assy .=
        $upper_field_hashrefs[$i]->{ $a_ref->[$_] } . ' '
    }
    chop $assy;
    return $assy;
}

sub suggest_output_filename {
        my ($date,) = update_DTG();
    my $name = make_model_serial(2, \@field_labels_xdcr) .
       '_' . 
       make_model_serial(1, \@field_labels_indicator) . 
       '_' . 
       $date;
    # Translate most disallowed and undesired chars from file name to underscores.
    # Colon -> dash in time so that 12:00:00 -> 12-00-00 in file names.
    # Letter 'r' is for decimal like in ham radio jargon where multiplier p, n, m, c,
    # d, K, M, G and T as multipliers go in the decimal place of a unit of measure
    # and 'r' is the decimal when no multiplier applies. Example: 2K00 Ohm is same
    # as 2.00 KOhm and 14M266 Hz is 14.266 MHz. So 1r23 is 1.23. Just so you know
    # that I did have a reason.
        $name =~ tr/.:/r-/;
        $name =~ tr!\\\/!__!;
    $name =~ tr/~`!@#$%^&*()+={}[]|;"'<>,? /___________________________/;
        # Accordion multiples down to a single.
        while ( $name =~ m/__/ ) { $name =~ s/__/_/g; }
    $name .= '.txt';   # Tell browser, 'You can read this'.
    $name =~ s/^_//;   # Undo avoidance of Perl warning.
    return $name;
}

sub open_for_writing {
    my $cal_date = update_DTG();
    $path_output = $mw->getSaveFile(
        -initialfile => suggest_output_filename($cal_date),
        -title => 'Save Calibration Record',
    );
    if ( open OUT, "> $path_output" ) {
        tidy_up_report();
        trim_last_page();
        tidy_page_tops($cal_date);
        print OUT join "\n", @buffer;
        close OUT;
    }
    else { $feedback = "Oops! Can\'t open $path_output: $!"; }
}

sub close_after_reading {
    close(IN);
}

sub close_after_writing {
    close(OUT);
}

sub tidy_page_tops {
    my ($cal_date,) = @_;
    my $pages = scalar @buffer / $lines_per_page;
    $pages = int($pages) + 1 unless $pages == int($pages);
    my $page = 1;
    for ( my $i = 0; $i < $pages; ++$i ) {
        formline
        '@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||',
        "CALIBRATION REPORT: $cal_date, Page $page of $pages";
        $buffer[$i * $lines_per_page] = $ACCUMULATOR;
        $ACCUMULATOR = '';
        ++$page;

        # Next line for Xdcr if exists.
        my $line_2 = make_model_serial(2, \@field_labels_xdcr);
        if ( $line_2 !~ m/^\s*$/ ) {
            formline
            '@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||',
            $line_2;
            $buffer[$i * $lines_per_page + 1] = $ACCUMULATOR;
            $ACCUMULATOR = '';

        }

        # Next line for indicator if exists.
        my $line_3 = make_model_serial(1, \@field_labels_indicator) ;
        if ( $line_3 !~ m/^\s*$/ ) {
            formline
            '@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||',
            $line_3;
            $buffer[$i * $lines_per_page + 2] = $ACCUMULATOR;
            $ACCUMULATOR = '';
        }
    }
}

sub paginate {
    my ($denominator,) = @_; # lines_per_page, denominator
    my $i;
    if ( $denominator == 0 ) {
        @buffer = ('','','',''); # First page before any lines.
    }
    else {
        $i = int( $lines_per_page / $denominator ); 
        until ( scalar @buffer % $i == 0 ) { push @buffer, ' '; }
    }
    if ( scalar @buffer % $lines_per_page == 0) {
        push @buffer, ('','','',''); # Top of new Nth page.
    }
}


# If no data entered for last matrices, delete their pages.
sub trim_last_page {
        while ( $buffer[-1] =~ m/^\s*$/ ) { 
        
        # When last lines are blank, erase them.
            while ( $buffer[-1] =~ m/^\s*$/ ) { pop @buffer; }
                
                # When last page holds only a header, erase it.
        if ( $buffer[-3] =~ /.*CALIBRATION REPORT: .* .*, Page .* of .*/ ) {
            for (1..3) { pop @buffer; }
        }
                
                # When last data run holds no entries, erase it.
                if ( $buffer[-8] =~ /.*Data Run Number .*:.*/ ) {
            for (1..8) { pop @buffer; }
        }                            
        }
}

# Output the text values from upper Tk Entry boxes.
sub print_text_entries {
    my ($a_ref, $field, $i) = @_;
    my $header = shift @$a_ref;
        
    formline
    '@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||',
    $header;
    push @buffer, ($ACCUMULATOR);
    $ACCUMULATOR = '';
        
    for ( @{$field} ) {
        formline
        '@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<',
        $_, $upper_field_hashrefs[$i]->{$_} ;
        push @buffer, $ACCUMULATOR 
            if $upper_field_hashrefs[$i]->{$_};  # Not blank.
        $ACCUMULATOR = '';
    }
        
    if ( $buffer[-1] =~ m/$header/ ) {
        pop @buffer; # Toss header lacking entries.
        pop @buffer; # Toss blank line above header.
    }
        
    push @buffer, ''; # Blank line between each set.
        
}

# Output the selections from Tk Radio buttons.
sub print_data_header {        
    my ($i, $j) = @_;        
    formline
    '@|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||',
    "Data Run Number " . ($i + 1) . ":";
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';

    push @buffer, "=" x 70;

    formline
    '@<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<',
    'Recorded from:', 
    $rdgs_from[$_], 
    'Recorded how:',
    $rdgs_when[$_];
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';
        
    formline
    '@<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<',
    'Direction:',
    $rdgs_polarity[$_],
    'Capacity:',
    $scale_fs_uut[2]->get() . " $units_std";
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';

    push @buffer, "=" x 70;

}

# Output the numeric data from lower Tk Entry boxes.
sub print_data_points {
        
    my @this_run = @{$runs[$_]};
        
    formline
    '@|||||||||||||||@||||||||||||||||@|||||||||||||||||@||||||||||||||||||',
    'Standard',  'Reported',  'Error',  'Error';
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';
                    
    formline
    '@|||||||||||||||@||||||||||||||||@|||||||||||||||||@||||||||||||||||||',                
    "$units_uut", "$units_std", "%", "%FS";
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';
                    
    formline
    '@|||||||||||||||@||||||||||||||||@|||||||||||||||||@||||||||||||||||||',                
    '-' x 15, '-' x 15, '-' x 15, '-' x 15;
    push @buffer, $ACCUMULATOR;
    $ACCUMULATOR = '';
        
    # Collate like rows from all runs into same output row.
    while ( scalar @this_run ) {

    # Get next row of data as a quad. 
        my @quad =
            (   shift @this_run,
                shift @this_run,
                shift @this_run,
                shift @this_run
            );
        # Skip to next quad if contains non-numeric data besides 'n/a'. The
        # 'n/a' occurs at top and bottom zeros. Also user may skip entries
        # for an abbreviated 'as found' and go on to more complet 'as adjusted'
        # sets of calibration data.
        next unless list_is_numeric(@quad);
                    
        formline
        '@|||||||||||||||@||||||||||||||||@|||||||||||||||||@||||||||||||||||||',                
        @quad;
        push @buffer, $ACCUMULATOR;
        $ACCUMULATOR = '';
    }
}

# Check list for invalid/non-numeric values.
sub list_is_numeric {
    my @list = @_;
    my $flag = 1;
    foreach ( @list ) {
        $_ =~ s/n\/a/1/;      # Let 'n/a' pass as if numeric.
        $_ =~ s/\s//g;        # Whitespace is not data.
        $_ =~ s/[A-Za-z]//g;  # Letters are not data data.
        $flag = $flag && $_; 
    }
    return $flag;
}

sub tidy_up_report {
    my $i = 0;
    my @headers_1 = (
        'GENERAL INFORMATION',
        'INDICATOR UNDERGOING CALIBRATION',
        'TRANSDUCER UNDERGOING CALIBRATION',
        'INDICATOR STANDARD REFERENCED',
        'TRANSDUCER STANDARD REFERENCED',
    );

    paginate(0); # Align to next half or full page.
        
    foreach my $field (
        \@field_labels_head,
        \@field_labels_indicator,
        \@field_labels_xdcr,
        \@field_labels_indicator,
        \@field_labels_xdcr,
        ) {
        print_text_entries(\@headers_1, $field, $i);
        ++$i;
    }

    paginate(2); # Align to next half or full page.

    my $run_count = 1;
    for ( 0 ... $#runs ) {
 
        # Run count & header top lines.
        print_data_header($_, 10);    

        # The actual data points.  
        print_data_points($runs[$_]); 

        ++$run_count;
        paginate(2); # Align to next half or full page.
    }
}

################################################################################
################################################################################
##                      GUS PACKAGES -- CUSTOM SET                            ##
##                     FOR USE IN THIS PROGRAM ONLY                           ##
##            REQUIRES INCLUSION OF GUS PACKAGES STANDARD SET                 ##
################################################################################
################################################################################

#############################
# Begin User Config Package #
#############################

# This is a semi-arbitrary package for use with GUS::tk package.

package GUS::user_config;
BEGIN {}

use Tk;
use strict;
use warnings;

# Declare variables for strict.
use vars qw( $mw_user_config $help_info $balloon
    @scale_runs_per_frame @scale_runs_per_frame
    @scale_run_frames @scale_run_frames
    @scale_readings @scale_interval
    @scale_format_1 @scale_format_2

);

sub start_MainLoop {
    $mw_user_config = MainWindow->new( -title => ' Configure' );

    #####################
    # Define the frames #
    #####################

    # For sunken look.
    my $frame_top = $mw_user_config->Frame(
        -relief      => 'sunken',
        -borderwidth => 5
    );

    # For flat look.
    my $frame_btm = $mw_user_config->Frame(
        -relief      => 'flat',
        -borderwidth => 5
    );

    ###################
    # Set up balloons #
    ###################

    # Provide help info as balloon widgets.
    $help_info = $frame_btm->Label(
        -borderwidth => 2,
        -relief      => 'groove',
        -background  => $main::color_bg_balloon,
        -foreground  => $main::color_fg_balloon,
    );
    $balloon = $mw_user_config->Balloon(
        -statusbar       => $help_info,
        -balloonposition => 'mouse',
        -background      => $main::color_bg_balloon,
        -foreground      => $main::color_fg_balloon,
    );
    $balloon->attach( $help_info, -msg => 'Hover mouse on any widget then read here.' );

    ######################
    # The actual configs #
    ######################

    @scale_runs_per_frame = GUS::tk::frame_label_scale( $frame_top, 'Horizontal:', 1, 8 );
    $scale_runs_per_frame[2]->set($main::runs_per_frame);
    $balloon->attach(
        $scale_runs_per_frame[2], -balloonmsg => "Data runs per each row?",
        -statusmsg => 'How many data runs to display horizontally?',
    );

    @scale_run_frames = GUS::tk::frame_label_scale( $frame_top, 'Vertical:', 1, 8 );
    $scale_run_frames[2]->set($main::run_frames);
    $balloon->attach(
        $scale_runs_per_frame[2], -balloonmsg => "How many rows?",
        -statusmsg => 'How many rows of data runs to display vertically?',
    );

    @scale_readings = GUS::tk::frame_label_zoom( $frame_top, 'Data points:', 1, 20, 1, 200, 1 );
    # $parent, $text, $from, $to, $min_limit, $max_limit, $res_limit, $orient
    $scale_readings[2]->set($main::readings);
    $balloon->attach(
        $scale_readings[2], -balloonmsg => "Number of readings?",
        -statusmsg => 'How many rows of data readings between the zeros at start and end?',
    );

    @scale_interval = GUS::tk::frame_label_zoom( $frame_top, 'Interval:', 1, 1000, 0.01, 10000, 0.01 );
    # $parent, $text, $from, $to, $min_limit, $max_limit, $res_limit, $orient
    $scale_interval[2]->set($main::interval);
    $balloon->attach(
        $scale_interval[2], -balloonmsg => "Maximum digits?",
        -statusmsg => 'How many digits maximum with which to format entry data?',
    );

    @scale_format_1 = GUS::tk::frame_label_scale( $frame_top, 'Digits:', 0, 16 );
    $scale_format_1[2]->set(8);
    $balloon->attach(
        $scale_format_1[2], -balloonmsg => "Maximum digits?",
        -statusmsg => 'How many digits maximum with which to format entry data?',
    );

    @scale_format_2 = GUS::tk::frame_label_scale( $frame_top, 'Decimals:', 0, 8 );
    $scale_format_2[2]->set(1);
    $balloon->attach(
        $scale_format_2[2], -balloonmsg => "Significant decimals?",
        -statusmsg => 'How many decimal points with which to format entry data?',
    );

    ###################
    # Bottom controls #
    ###################

    my @controls = GUS::tk::frame_label_buttons(
        $frame_btm, 'Action:', [ 'Accept', 'Cancel' ], [
            sub { accept_config(); }, sub { quit_MainLoop(); }
        ],
        [ 'red', 'green' ],
    );
    $balloon->attach(
        $controls[2], -balloonmsg => "Configure now?",
        -statusmsg => 'Click to accept any changes made in the configuration and perform them now.',
    );
    $balloon->attach(
        $controls[2], -balloonmsg => "Abandon changes?",
        -statusmsg =>
        'Click to abandon any changes made in the configuration and return as before.',
    );

    $help_info->pack( -side => 'top', -expand => 0, -fill => 'x' );
    $frame_top->pack( -side => 'top', -expand => 1, -fill => 'both' );
    $frame_btm->pack( -side => 'top', -expand => 0, -fill => 'x' );

    MainLoop;
}

###############
# Define subs #
###############

sub accept_config {
    $main::format = "%" . $scale_format_1[2]->get() . '.' . $scale_format_2[2]->get() . "f";

    # Store new arrangement of runs criteria.
    if ( ( $main::runs_per_frame != $scale_runs_per_frame[2]->get() ) || 
         ( $main::run_frames     != $scale_run_frames[2]->get() ) 
       ) {
        $main::runs_per_frame = $scale_runs_per_frame[2]->get();
        $main::run_frames     = $scale_run_frames[2]->get();
                        
        # Build new run arrangement.
        main::init_readings_frames();

        # Build new entry-readings matrix.
        main::build_input_matrices();
    }
                
    # Store new entry-readings matrix criteria.
    elsif ( ( $main::readings != $scale_readings[2]->get() ) || 
            ( $main::interval != $scale_interval[2]->get() ) 
          ) {
        $main::readings = $scale_readings[2]->get();
        $main::interval = $scale_interval[2]->get();

        # Build new entry-readings matrix.
        main::build_input_matrices();
    }
        
    quit_MainLoop();
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    $mw_user_config->destroy() if Tk::Exists($mw_user_config);
}

END {}

###########################
# End User Config Package #
###########################



################################################################################
################################################################################
##                      GUS PACKAGES -- STANDARD SET                          ##
##                  FOR USE UNEDITED ACROSS ANY PROGRAM                       ##
##                          VERSION 2004-11-22                                ##
################################################################################
################################################################################

################################
# Begin GUS Tk widgets Package #
# Version 2004-11-29           #
################################

# A separate package for ease of re-use.

package GUS::tk;

use Tk;
use Tk::Pane;
use Tk::DirTree;

use vars qw( $debug_flag $widget_id $label_width $entry_width $button_width $text_height $text_width $file_basename $feedback
  $color_bg $color_fg $color_bg_balloon $color_fg_balloon $color_bg_active $color_bg_inactive );

BEGIN {
    $debug_flag          = 0;
    $widget_id           = 0;
    $label_width         = 12;
    $entry_width         = 12;
    $button_width        = 12;
    $main::file_basename = 'foo.txt' unless defined $main::file_basename;
}

use vars qw(
  %frame
  $dir_toplevel
);

sub new_widget { $widget_id++; return $widget_id; }

# Automate the build of a lable & entry wiget set inside GUS::tk frame.
sub frame_label_entry {
    my ( $parent, $label_text, $text_var_ref ) = @_;
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text ",
    )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scrolled(
        'Entry',
        -textvariable => $text_var_ref,
        -width        => $entry_width,
        -background   => "white",
        -foreground   => 'blue',
        -relief       => 'sunken',
        -font         => 'courier'
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    return @widgets;
}

# Automate the build of a lable & entry wiget set inside GUS::tk frame.
sub frame_label_listbox {
    my ( $parent, $label_text, $list_ref, $selectmode, $takefocus ) = @_;
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text ",
    )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scrolled(
        'Listbox',
        -selectmode   => $selectmode,
        -takefocus    => $takefocus,
        -width        => $entry_width,
        -background   => "white",
        -foreground   => 'blue',
        -relief       => 'sunken',
        -font         => 'courier'
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    return @widgets;
}


# Automate the build of a lable & set of entry widgets set inside GUS::tk frame.
sub frame_label_entries {
    my $parent     = shift;
    my $label_text = shift;
    my @widgets    = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text",
    )->pack( -side => 'left' );

    foreach my $text_var_ref (@_) {
        push @widgets, $widgets[0]->Entry(
            -textvariable => $text_var_ref,
            -background   => "white",
            -foreground   => 'blue',
            -relief       => 'sunken',
            -font         => 'courier',
            -justify      => 'right',
            -width        => 3,
          )->pack(
            -side   => 'left',
            -expand => 1,
            -fill   => 'x'
          );
    }
    return @widgets;
}

# Automate the build of a lable & text wiget set inside GUS::tk frame.
sub frame_label_text {
    my ( $parent, $label_text, $text_height, $text_width ) = @_;
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text ",
    )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scrolled(
        'Text',
        -height       => $text_height,
        -width        => $text_width,
        -background   => "white",
        -foreground   => 'blue',
        -relief       => 'sunken',
        -font         => 'courier',
        -wrap         => 'word',
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    return @widgets;
}

# Automate the build of a lable & set of label widgets set inside GUS::tk frame.
sub frame_label_labels {
    my $parent     = shift;
    my $label_text = shift;
    my @widgets    = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text",
    )->pack( -side => 'left' );

    foreach $label_text (@_) {
        push @widgets, $widgets[0]->Label(
            -text   => "$label_text",
            -relief => 'flat',
          )->pack(
            -side   => 'left',
            -expand => 1,
            -fill   => 'x'
          );
    }
    return @widgets;
}

sub frame_label_entry_button {
    my @widgets_1 = frame_label_entry( @_[ 0 .. 2 ] );
    my @widgets_2 = ();
    my ( $width, $text, $cmd_ref, $bg, $abg, $fg ) = @_[ 3 .. 8 ];
    $width = 7         unless defined($width);
    $text  = ' Clear ' unless defined($text);
    $bg    = 'gray'    unless defined($bg);
    $abg   = 'green'   unless defined($abg);
    $fg    = 'blue'    unless defined($fg);
    $cmd_ref = sub {
        $widgets_1[2]->delete( 0, 'end' );
      }

      unless defined($cmd_ref);
    $widgets_1[0]->Button(
        -width            => $width,
        -relief           => 'raised',
        -foreground       => $fg,
        -background       => $bg,
        -activebackground => $abg,
        -command          => $cmd_ref,
        -text             => $text
    )->pack( -side => 'left' );
    return ( @widgets_1, @widgets_2 );
}

# Automate the build of a lable & radiobutton wiget set inside a frame.
sub frame_label_radio {
    my ( $width, $parent, $label, $text_array_ref, $var_ref, $cmd_ref ) = @_;
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label ",
    )->pack( -side => 'left' );

    # Make N radiobuttons.
    foreach my $text (@$text_array_ref) {
        push @widgets, $widgets[0]->Radiobutton(
            -text     => $text,
            -justify  => 'left',
            -anchor   => 'w',
            -width    => $width,
            -value    => $text,
            -variable => $var_ref,
            -command  => $cmd_ref
          )->pack(
            -side   => 'left',
            -expand => 1,
            -fill   => 'x'
          );
    }    # End of foreach.
    return @widgets;
}

# Automate the build of a lable & scale wiget set inside a frame.
sub frame_label_scale {
    my ( $parent, $text, $from, $to, $res, $orient ) = @_;
    $orient = 'horizontal' unless defined($orient);    # Default option.
    $res    = 1            unless defined($res);       # Default option.
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $text ",
    )->pack( -side => 'left' );

    push @widgets, $widgets[0]->Scale(
        -from       => $from,
        -to         => $to,
        -resolution => $res,
        -orient     => $orient,
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    return @widgets;
}

# Just like &frame_label_scale above but with zoom-in, zoom-out buttons.
sub frame_label_zoom {
    my ( $parent, $text, $from, $to, $min_limit, $max_limit, $res_limit, $orient ) = @_;
    $orient = 'horizontal' unless defined($orient);
    my $res = zoom_res( ( $to - $from ) / 20, $res_limit );    # Set reasonable default.
    $res = $res_limit if $res < $res_limit;        # Prevent starting out below limit.
    my @widgets = ();
    my $tick_interval = ( $to - $from ) / 1.99999;
    $tick_interval = int( $tick_interval) if $tick_interval == 1;
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $text ",
      )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scale(
        -from         => $from,
        -to           => $to,
        -resolution   => $res,
        -orient       => $orient,
        -tickinterval => $tick_interval,
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '-',
        -command          => sub { zoom_scale( $widgets[2], 5, $min_limit, $max_limit, $res_limit ); },
        -activebackground => 'blue',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '+',
        -command          => sub { zoom_scale( $widgets[2], 0.2, $min_limit, $max_limit, $res_limit ); },
        -activebackground => 'orange',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    return @widgets;
}

# Just like &frame_label_zoom above but with an entry box.
sub frame_label_entry_label_zoom_label_zoom {
    my ( $parent, $text_1, $text_var_ref, 
         $text_2, $from_2, $to_2, $min_limit_2, $max_limit_2, $res_limit_2,
         $text_3, $from_3, $to_3, $min_limit_3, $max_limit_3, $res_limit_3, 
         $orient ) = @_;
    $orient = 'horizontal' unless defined($orient);
    my $res_2 = zoom_res( ( $to_2 - $from_2 ) / 20, $res_limit_2 );    # Set reasonable default.
    my $res_3 = zoom_res( ( $to_3 - $from_3 ) / 20, $res_limit_3 );    # Set reasonable default.
    $res_2 = $res_limit_2 if $res_3 < $res_limit_2;        # Prevent starting out below limit.
    $res_3 = $res_limit_3 if $res_3 < $res_limit_3;        # Prevent starting out below limit.
    my @widgets = ();
    my $tick_interval_2 = ( $to_2 - $from_2 ) / 1.99999;
    my $tick_interval_3 = ( $to_3 - $from_3 ) / 1.99999;
    $tick_interval_2 = int( $tick_interval_2) if $tick_interval_2 == 1;
    $tick_interval_3 = int( $tick_interval_3) if $tick_interval_3 == 1;
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $text_1 ",
      )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Entry(
        -textvariable => $text_var_ref,
        -background   => "white",
        -foreground   => 'blue',
        -relief       => 'sunken',
        -font         => 'courier',
        -justify      => 'right',
        -width        => $label_width,
      )->pack(
        -side   => 'left',
        -expand => 0,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $text_2 ",
      )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scale(
        -from         => $from_2,
        -to           => $to_2,
        -resolution   => $res_2,
        -orient       => $orient,
        -tickinterval => $tick_interval_2,
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '-',
        -command          => sub { zoom_scale( $widgets[4], 5, $min_limit_2, $max_limit_2, $res_limit_2 ); },
        -activebackground => 'blue',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '+',
        -command          => sub { zoom_scale( $widgets[4], 0.2, $min_limit_2, $max_limit_2, $res_limit_2 ); },
        -activebackground => 'orange',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $text_3 ",
      )->pack( -side => 'left' );
    push @widgets, $widgets[0]->Scale(
        -from         => $from_3,
        -to           => $to_3,
        -resolution   => $res_3,
        -orient       => $orient,
        -tickinterval => $tick_interval_3,
      )->pack(
        -side   => 'left',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '-',
        -command          => sub { zoom_scale( $widgets[8], 5, $min_limit_3, $max_limit_3, $res_limit_3 ); },
        -activebackground => 'blue',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    push @widgets, $widgets[0]->Button(
        -width            => 3,
        -text             => '+',
        -command          => sub { zoom_scale( $widgets[8], 0.2, $min_limit_3, $max_limit_3, $res_limit_3 ); },
        -activebackground => 'orange',
        -relief           => 'raised',
      )->pack(
        -side   => 'left',
        -expand => 0,
      );
    return @widgets;
}

sub zoom_res {
    my ( $range, $res_limit ) = @_;    # Compare to margin.
    my $res = 1;

    while ( $range / $res < 500 ) { last if $res < 0.000001; $res /= 10; }

    # When 1 is too small.
    while ( $range / $res > 500 ) { last if $res > 999_999; $res *= 10 }

    # Range is okay now.
    print "At zoom_res, \$res = $res & \$res_limit = $res_limit \n" if $debug_flag;
    $res = $res_limit if $res < $res_limit;    # Prevent going below limit.
    return $res;
}

# Sub below called by &frame_label_zoom when zoom button clicked.
sub zoom_scale {
    my ( $scale_ref, $power, $min_limit, $max_limit, $res_limit ) = @_;
    my $to     = $scale_ref->cget( -to );
    my $from   = $scale_ref->cget( -from );
    my $value  = $scale_ref->get();
    my $margin = ( ( $value - $from ) + ( $to - $value ) ) / 2;

    # Above are as-was values, now zoom in or out to new values.
    my $res = zoom_res( $margin * $power, $res_limit );
    $from = $value - $margin * $power;
    $to   = $value + $margin * $power;

    # Limit leftmost if required.
    if ( ( defined $min_limit ) && ( $from < $min_limit ) ) {
        $from = $min_limit;
    }

    # Limit rightmost if required.
    if ( ( defined $max_limit ) && ( $to > $max_limit ) ) {
        $to = $max_limit;
    }

    # Accomodate possible limiting from above.
    $margin = ( $to - $from ) / 2;
    $res    = zoom_res( $margin, $res_limit );

    # Adjust scale zoom within limits.
    unless ( defined($res_limit)
        && ( $power < 1 )
        && ( $res < $res_limit ) )
    {

        # Remake the scale at the new zoom level, avoiding
        # any zoom so close that no increments remain.
        $scale_ref->configure(
            -from         => $from,
            -to           => $to,
            -resolution   => $res,
            -tickinterval => $margin * 0.99999,
        ) if $to - $from > $res * 5;
    }
}

# Automate the build of a lable & button wiget set inside a frame.
sub frame_label_buttons {
    my ( $parent, $label_text, $text_array_ref, $cmd_ref_array_ref, $color_array_ref ) = @_;
    my @widgets = ();
    push @widgets,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets, $widgets[0]->Label(
        -width => $label_width,
        -text  => " $label_text ",
    )->pack( -side => 'left' );

    # Make N buttons.
    foreach my $text (@$text_array_ref) {
        push @widgets, $widgets[0]->Button(
            -width            => $button_width,
            -text             => $text,
            -command          => shift ( @{$cmd_ref_array_ref} ),
            -activebackground => shift ( @{$color_array_ref} ),
            -relief           => 'raised',
          )->pack(
            -side   => 'left',
            -expand => 1,
            -fill   => 'x'
          );
    }    # End of foreach.
    return @widgets;
}

#============ Begin subs for N checkbutton frames ============

# Automate the build of a lable & button wiget set inside a frame.
sub frame_label_checks {

    # The var_ref's in var_ref_array_ref are on-off values.
    my ( $width, $parent, $label_text, $text_array_ref, $on_array_ref, $off_array_ref, $bool_array_ref,
        $cmd_ref_array_ref )
      = @_;
    my @widgets_and_vars = ();
    push @widgets_and_vars,
      $parent->Frame(
        -relief      => 'flat',
        -borderwidth => 5,
      )->pack(
        -side   => 'top',
        -expand => 1,
        -fill   => 'x'
      );
    push @widgets_and_vars, $widgets_and_vars[0]->Label(
        -width => $label_width,
        -text  => " $label_text ",
    )->pack( -side => 'left' );

    # Make N checkbuttons.
    foreach my $text (@$text_array_ref) {
        my $check_var = 0;
        push @widgets_and_vars, $widgets_and_vars[0]->Checkbutton(

            -text     => $text,
            -justify  => 'left',
            -anchor   => 'w',
            -width    => $width,
            -variable => \$check_var,
            -relief   => 'groove',
          )->pack(
            -side   => 'left',
            -expand => 1,
            -fill   => 'x',
          );
        push @widgets_and_vars, \$check_var;

        # Assign the default on-value, if present.
        $widgets_and_vars[-2]->configure( -onvalue => shift @$on_array_ref )
          if defined $on_array_ref;

        # Assign the default off-value, if present.
        $widgets_and_vars[-2]->configure( -offvalue => shift @$off_array_ref )
          if defined $off_array_ref;

        # Assign checked or not-checked condition, if present.
        if ( defined $bool_array_ref ) {
            if ( shift @$bool_array_ref ) { $widgets_and_vars[-2]->select(); }
            else { $widgets_and_vars[-2]->deselect(); }
        }

        # Assign subroutine , if present.
        $widgets_and_vars[-2]->configure( -command => shift @$cmd_ref_array_ref )
          if defined $cmd_ref_array_ref;

    }    # End of foreach.
    return @widgets_and_vars;
}

# Return values of checkbutton widget set.
sub poll_frame_label_checks {

    # Input @_ = ( frame, label, check_1, var_1, check_2, var_2 ...)
    # print "Checklist poll input = ", join " ", @_, "\n" if $debug_flag;
    my @bar = ();
    for ( my $i = 3 ; defined( $_[$i] ) ; $i += 2 ) {
        push @bar, ${ $_[$i] };
    }

    # print "Checklist poll output = ", join " ", @bar, "\n" if $debug_flag;
    return @bar;
}

#============ End subs for N checkbutton frames ============
#============ Begin subs for N file browse entry frames ============

# One var and three subs below require sub label_entry defined above. Use them to
# make one-or-more file-browse widgets. Can add new ones underneath as required. Can also
# delete them, one-at-a-time, except for the top one.

my @auto_path_widgets = ();

# List of supported file patterns
@main::filetypes = ( 
    [ 'TAB delimited', '.dat', 'TEXT' ], 
    [ 'ASCII', '.txt', 'TEXT' ], 
    [ 'Any', '*.*', 'TEXT' ] )
  unless defined @main::filetypes;

sub add_path_widget {
    my ( $frame, $var_ref, $label_str, ) = @_;
    $label_str = 'Input Path:' unless defined $label_str;
    my @path_widgets = frame_label_entry_button(
        $frame,
        $label_str,
        $var_ref, 7, 'Browse',
        sub {
            $$var_ref = $mw->getOpenFile( -filetypes => \@main::filetypes );
        },
        'gray',
        'red',
        'black',
    );
    push @auto_path_widgets, \@path_widgets;
    return @path_widgets;
}

sub delete_path_widget {
    if ( $#auto_path_widgets > 0 ) {
        my $a_ref = $auto_path_widgets[-1];
        ${$a_ref}[0]->destroy();
        $main::feedback = "Row " . ( $#auto_path_widgets + 1 ) . " has been removed.";
        pop @auto_path_widgets;
    }
    else { $main::feedback = "Oops! Can't remove only remaining row."; }
}

sub auto_path_widgets {
    my ( $count, $frame, $label_str ) = @_;
    $label_str = 'Input Path:' unless defined $label_str;
    if ( $count > 0 ) {
        for ( my $i = 1 ; $i <= $count ; $i++ ) {
            my $var = '';
            add_path_widget( $frame, $var, $label_str,  );
        }
        return @auto_path_widgets;
    }

    if ( $count < 0 ) {
        for ( my $i = 1 ; $i >= $count ; $i-- ) {
            delete_path_widget();
        }
    }
}

#============ End subs for N file browse entry frames ============
#============ Begin subs for N directory browse entry frames ============

# NOTE: This sucks! Why ain't there a proper dir browse widget in Tk like
# the getOpenFile() and getSaveFile() widgets?

sub add_dir_widget {
    my ( $frame, $var_ref, $label_str,) = @_;
    $label_str = 'Input Dir:' unless defined $label_str;
    my @dir_widgets =
      frame_label_entry_button( $frame, $label_str, $var_ref, 7, 'Browse', sub { \&dir_tree_window($var_ref); },
        'gray', 'red', 'blue', );
    return @dir_widgets;
}

# Return list of drives for Windoze.
sub drives {
    my @drives;
    for my $i ( 'C' .. 'Z' ) {
        $i = "$i" . ':';
        push ( @drives, $i ) if ( -d "$i\\" );
    }
    return @drives;
}

sub dir_tree_window {
    my ( $dir_path_ref, ) = @_;
    if ( !Exists($dir_toplevel) ) {
        $dir_toplevel = $mw->Toplevel( -title => 'Browse to directory...' );
        my $dir_tree = $dir_toplevel->Scrolled('DirTree')->pack( -side => 'top', -expand => 1, -fill => 'both', );
        $dir_tree->delete('all');

        # Test if Windoze or a real OS...
        if ( $GUS::os_detect::OS eq 'WINDOWS' ) {

            # Cobble up for use with Windoze.
            foreach my $dir ( drives() ) { $dir_tree->chdir("$dir"); }
        }
        else { $dir_tree->chdir('/'); }    # For when Unician.

        my $button_frame = $dir_toplevel->Frame()->pack( -expand => 0, -fill => 'x' );

        frame_label_buttons(
            $button_frame,
            'Action:',
            [ 'Accept', 'Cancel' ],
            [
                sub {
                    $$dir_path_ref = $dir_tree->selectionGet();
                    $dir_toplevel->destroy;
                },
                sub { $dir_toplevel->destroy; }
            ],
            [ 'red', 'green' ],
        );
    }
}

#============ End subs for directory browse entry frames ============


# Preserve scale configuration in an array.
sub scale_cfg_save {
    my ( $tk_scl, $a_ref, $setting ) = @_;
    foreach ( '-from', '-to', '-res', '-tickinterval') {
        push @$a_ref, $tk_scl->cget($_);
    }
    push @$a_ref, $setting if defined $setting;
} 

sub scale_cfg_restore {
    my ( $tk_scl, $a_ref, $i ) = @_;
    foreach ( '-from', '-to', '-res', '-tickinterval') {
        $tk_scl->configure($_, $$a_ref[$i]);
        ++$i;
    }
}

END { }

##############################
# End GUS Tk widgets package #
##############################

###############################
# Begin GUS OS Detect package #
# Version 2004-10-09          #
###############################

# A separate package for ease of re-use.

package GUS::os_detect;
use strict;

# Declare variables for strict.
use vars qw( $OS $home $delim $browser $txt_viewer $ttf_dir $font $win_dir);

# Allow for configuration in main module.
$browser = $main::browser_filepath if $main::browser_filepath;

BEGIN {

    require Config;
    $OS = $Config::Config{'osname'};

    if ( $OS =~ /Win/i ) {
        $OS = 'WINDOWS';

        # Determin whether NT or not by testing for directory.
        if ( -e "C:/WINNT" ) { $win_dir = 'C:/WINNT/';}
        else { $win_dir = 'C:/WINDOWS/'; }
        $home       = "C:/";
        $delim      = '\\';
        $browser    = 'C:/Program Files/Internet Explorer/IEXPLORE.EXE' ; #unless $browser;
        $txt_viewer = $win_dir . 'notepad.exe';
        $ttf_dir    = $win_dir . 'Fonts/';
        $font       = $ttf_dir . 'arial.ttf';
    }
    elsif ( $OS =~ /^netbsd$/i ) {
        $OS      = 'NetBSD';
        $home    = '~/';
        $delim   = '/';
        $browser = '/usr/pkg/bin/firefox'
          unless $browser;
        $txt_viewer = '/usr/pkg/bin/nedit';
        $ttf_dir    = '';
        $font       = $ttf_dir . 'Generic.ttf';
    }
    elsif ( $OS =~ /^MacOS$/i ) {
        $OS      = 'MACINTOSH';
        $home    = '~/';
        $delim   = '/';
        $browser = ''
          unless $browser;
        $txt_viewer = '';
        $ttf_dir    = '';
        $font       = $ttf_dir . 'Generic.ttf';
    }
    elsif ( $OS =~ /os2/i ) {
        $OS      = 'OS2';
        $home    = '';
        $delim   = '/';
        $browser = ''
          unless $browser;
        $txt_viewer = '';
        $ttf_dir    = '';
        $font       = $ttf_dir . 'Generic.ttf';
    }
    else {
        $OS      = 'UNIX';
        $home    = '~/';
        $delim   = '/';
        $browser = '/usr/local/bin/mozilla/'
          unless $browser;
        $txt_viewer = '';
        $ttf_dir    = '';
        $font       = $ttf_dir . 'Generic.ttf';
    }
}

sub os_path {
    my ( $path, ) = @_;
    $path =~ s/\//\\/g if $OS eq 'WINDOWS';
    return ($path);
}

sub show_in_viewer {
    system( qq|start "$txt_viewer" "$txt_viewer"|, qq|"$_[0]"| ) && warn "Oops! ";
}

sub show_graphic {
    if ( $OS eq 'WINDOWS' ) {

        # This path for ImageMagick's 'display' works on Windows 2000.
        my $graphic_viewer = "C:/Program Files/ImageMagick-5.5.7-Q8/imdisplay.exe";

        # Just in case, however, include a fallback to MSIE. An error will pop up if
        # imdisplay.exe not there. When clicked, MSIE will come up instead.
        system( qq|start "$graphic_viewer" "$graphic_viewer"|, qq|"$_[0]"| )
          && system( qq|start "$browser" "$browser"|,          qq|"$_[0]"| );
    }
    elsif ( $OS =~ /NetBSD|UNIX/ ) {

        # These three ways put Tk on hold
        # `display $_[0] &`;
        # exec "display", "$_[0]";
        # system "display", "$_[0]", "&";
        #
        # This way doesn't...
        if ( defined( my $kid = fork ) ) {
            unless ($kid) { exec "display", "$_[0]"; }
        }
        else { $main::feedback = "Oops! Could not fork display of $_[0]" }
    }
    else {
        $main::feedback = 'Oops! Operation not defined for this OS.';
    }
}

sub hog_memory {
    my @procs = @_;

    # Get max datasize from NetBSD.
    my @lines = split ' ', `sysctl proc | grep datasize.hard`;
    my $datasize_max = $lines[-1]; 

    foreach my $proc ( @procs ) {
        @lines = split "\n",  `ps -xa | grep $proc`;

        # May be more than one copy of editor running.
        foreach my $line ( @lines ) {
            next if $line =~ /ps -xa|grep/;
            my @line = split ' ', $line;
            print "Increasing datasize to maximum for process $line[4]\n";
            print `sysctl -w proc.$line[0].rlimit.datasize.soft=$datasize_max`, "\n";
        }
    }
}

################################################
# Begin credit for Perl snippet.               #
# See "Mozilla -remote made simple" from:      #
# http://perlmonks.com/index.pl?node_id=204134 #
################################################

# Display a file in the user's own favorite browser.

use constant URL  => 'openURL(%s, new-tab)';
use constant MAIL => 'mailto(%s)';

sub abs_path {
    require File::Spec;
    File::Spec->rel2abs(shift);
}

sub show_in_browser {
    if ( $browser =~ m/mozilla|firefox/ ) {

        # Display in Mozilla or its derivatives...
        $_ = shift || '';
        my $command =
          m!^(?:ftp|http|file)://! ? sprintf URL, $_
          : -r ($_) ? sprintf URL, 'file://' . abs_path($_)
          : s!^(www\..+)!http://$1! ? sprintf URL,  $_
          : s!^(ftp\..+)!ftp://$1!  ? sprintf URL,  $_
          : s/^mailto://            ? sprintf MAIL, $_
          : warn "usage: $0 (filename|URL|mailto:foo\@bar.com)\n";

        $main::feedback = system "$browser", -remote => sprintf( $command, $_ );
    }
    else {
        system( qq|start "$browser" "$browser"|, qq|"$_[0]"| )
          && warn "Oops! Trouble opening $browser ";
    }
}

###############################
# End credit for Perl snippet #
###############################

END { }

#########################
# End OS Detect Package #
#########################

############################
# Begin Help About Package #
# Version 2004-03-06       #
############################

# Note: Two vars required in package main as/per following example...
# our $formal_name = 'Gan Uesli Starling'; # However it's officially called.
# our $formal_date = '1955-12-24'; # Official date of this relase.

package GUS::help_about;
BEGIN { }

use Tk;
use strict;
no strict "refs";

# Declare variables for strict.
use vars qw( $mw_about );

sub start_MainLoop {
    $mw_about = MainWindow->new( -title => 'About' );
    my $text =
      $mw_about->Label( -text => "$main::formal_name\n"
          . "Release $main::formal_date\n\n"
          . "Copyright 2004, Gan Uesli Starling\n\nTrailing Edge Technologies\n"
          . "http://starling.us/tet\n"
          . "email gan\@starling.us"
          . "\n" )->pack();
    my $bn_okay = $mw_about->Button(
        -width            => 8,
        -relief           => 'raised',
        -foreground       => 'blue',
        -activebackground => 'green',
        -command          => \&quit_MainLoop,
        -text             => 'Okay'
    )->pack( -side => 'top' );
    MainLoop;
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    $mw_about->destroy() if Tk::Exists($mw_about);
}

END { }

###############################
# End Menu Help About Package #
###############################

###############################
# Begin Pop Up Window Package #
# Version 2004-11-26          #
###############################

package GUS::pop_up_window;
BEGIN { }

use Tk;
use strict;
no strict "refs";

# Declare variables for strict.
use vars qw( $mw_pop_up $pane_pop_up $background $title $message $cmd_ref $cmd_args_array_ref );

sub start_MainLoop {

    # Only one pop-up at a time.
    quit_MainLoop() if Tk::Exists $mw_pop_up;

    ( $background, $title, $message, $cmd_ref, $cmd_args_array_ref ) = @_;
    $mw_pop_up = MainWindow->new( -title => " $title", -background => $background);

    # An outermost pane to scroll all sub-panes within.
    $pane_pop_up = $mw_pop_up->Scrolled(
        'Pane',
        -scrollbars => 'osw',
        -sticky     => 'new'
    )->pack( -side => 'top', -expand => 1, -fill => 'both' );

    my $text = $pane_pop_up->Label( 
        -text               => "\n$message\n", 
        -background         => $background,
        -justify            => 'left' 
    )->pack( -side => 'top', -expand => 1, -fill => 'both' );
    my $bn_okay = $pane_pop_up->Button(
        -width              => 12,
        -relief             => 'raised',
        -foreground         => 'blue',
        -activebackground   => 'green',
        -command            => \&acknowlege,
        -text               => ' Acknowlege '
    )->pack( -side => 'top' );
    MainLoop;
}

sub acknowlege {
    if ( defined( $cmd_ref ) ) {
        &{ $cmd_ref }( @{$cmd_args_array_ref} );
        quit_MainLoop();
    }
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    $mw_pop_up->destroy() if Tk::Exists($mw_pop_up);
}

END { }

#############################
# End Pop Up Window Package #
#############################

#################################
# Begin General Purpose Package #
# Version 2004-11-23            #
#################################

package GUS::general;
BEGIN { }

use Tk;
use strict;
no strict "refs";

# See if (0,0,1) and (0,1,0) are equal.
sub comp_numeric_arrays {
    my ($aref_1, $aref_2) = @_;
    my $bool = 1;
    for ( my $i = 0; $i <= $#$aref_1; ++$i ) { 
        $bool = 0 unless $$aref_1[$i] == $$aref_2[$i] ;  
    }
    $bool = 0 unless scalar @$aref_1 == scalar @$aref_2;
    return $bool;
}

# See if ('a', 'b', 'c') and ('d', 'e', 'f') are equal.
sub comp_string_arrays {
    my ($aref_1, $aref_2) = @_;
    my $bool = 1;
    for ( my $i = 0; $i <= $#$aref_1; ++$i ) { 
#        $bool = 0 unless $$aref_1[$i] eq $$aref_2[$i] ;  
    }
    $bool = 0 unless scalar @$aref_1 == scalar @$aref_2;
    return $bool;
}

END { }

###############################
# End General Purpose Package #
###############################

__END__

=head1 NAME

Calibration Record

=head1 VERSION

Release date = 2005-01-20
=head1 SYNOPSIS

perl gus_calibrate.pl

=head1 DESCRIPTION

Presents on-screen a Perl/Tk input form for recording the steps of an A2LA calibration.
Outputs a pure-ASCII TAB- and SPACE-delimited document when done.

=head1 FEATURES

=head2 Configuation Options

Configureable in the expected ways: any number of cal points; any interval of units, option for ratiometric comparison (when FS is different units). Employ the 'Config' pull-down menu to alter the number of runs, data points per run, etc.

=head2 Defaults 

Defaults to four runs of 10 points at 10% intervals. Page format is 50 lines of 70 columns. These are user-editable near head of script.

=head2 Suggested Usage

Employ runs 1 and 2 for 'As Found', runs 3 and 4 for 'As Adjusted'. Note that although the format presents N rows of entry boxes for N calibration points, these are suggestions only. Likewise the nominal values. There is no absolute requirement to employ all rows...especially for 'As Found' readings. Any entry boxes left blank will be ignored as if non-existant. 

=head1 CAVEATS

Note that the option for ratiometric comparison only appears when full scales are not equal between the UUT and Standard. Default is 1:1. But at times you may wish to compare, for a load cell say, Newtons vs mV/V. You could then have for the UUT an FS of 25KN and for the Standard an FS of 2.00 mV/V. Be sure of setting the radio button correctly, 1:1 or FS:FS, as desired.

=head1 PREREQUISITES

Refer to the 'use' statements at head of script for required Perl modules.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>

=head1 COPYRIGHT

Copyright (c) 2005, Gan Uesli Starling. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut