#!C:\Perl\bin\perl.exe
# gus_wheatstone.pl version 2005-01-21
# 286 lines-of-code, 45 comment lines
# Calculate shunt cal output for Wheatstone Bridges
# See POD at EOF for full details.

use Tk;
use Tk::Pane;
use Tk::Balloon;
use strict;
use warnings;

my $label_width = 15;
my $entry_width = 40;
my $color_bg_balloon = 'darkseagreen';
my $color_fg_balloon = 'black';

our $formal_name      = 'Wheatstone Bridge Calculator';    # Plain language name of program.
our $formal_date      = '2005-01-21';            # Version ID = date of modification
our $debug_flag       = 0;                       # For building, debugging and upgrading.

my $units = 'Newtons';
my $fs = 22_241;
my $mV_per_V = 2.000;
my $r = 350;
my $r_shunt = 80;
my $v_exe = 10;
my $v_fs = 10;
my $gain;
my $mV_out_bridge;
my $v_out_bridge;
my $v_out_amp;
my $mV_out;
my $result;

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

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

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

# Because Pane can't be sunken.
my $frame_top = $mw->Frame(
    -relief      => 'sunken',
    -borderwidth => 5
)->pack( 
    -side => 'top', 
    -expand => 1, 
    -fill => 'both' 
);

# So won't expand, allowing $frame_top to hog all expansnion.
my $frame_btm = $mw->Frame(
    -relief      => 'flat',
    -borderwidth => 5
)->pack( 
    -side => 'top', 
    -expand => 0, 
    -fill => 'both' 
);

# To accomodate over-sized space if user configures many datapoints.
my $pane_top = $frame_top->Scrolled(
    'Pane', -scrollbars => 'e',
    -sticky => 'we'
)->pack( -side => 'top', -expand => 1, -fill => 'both' );

# Provide help info as balloon widgets.
my $help_info = $frame_btm->Label(
    -borderwidth => 2,
    -relief      => 'groove',
    -background  => $color_bg_balloon,
    -foreground  => $color_fg_balloon,
)->pack(
    -side   => 'top',
    -expand => 1,
    -fill   => 'x'
);

my $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.' );

#frame_label_zoom( $mw, $text, $from, $to, $min_limit, $max_limit, $res_limit, $var_ref, 'horizontal' );
my @units_fs    = frame_label_zoom( $pane_top, "Units FS:", 10, 50000, 1, 500000, 0.001, \$fs, 'horizontal' );
my @volts_fs    = frame_label_zoom( $pane_top, "Volts FS:",  5, 15, 1, 30, 0.001, \$v_fs, 'horizontal' );
my @volts_exe   = frame_label_zoom( $pane_top, "Volts Exe:", 5, 15, 1, 30, 0.001, \$v_exe, 'horizontal' );
my @mv_per_v    = frame_label_zoom( $pane_top, "mV/V @ FS:", 1, 3, 1, 5, 0.001, \$mV_per_V, 'horizontal' );
my @bridge_ohms = frame_label_zoom( $pane_top, "Bridge Ohms:", 120, 750, 1, 2000, 1, \$r, 'horizontal' );
my @shunt_ohms  = frame_label_zoom( $pane_top, "Shunt kOhms:",  40, 260, 10, 900, 1, \$r_shunt, 'horizontal' );

attach_baloons( $units_fs[2], 
    "Transducer full scale", 
    "How the bridge output is interpreted. If a 25,000N load cell, then 25,000." );
attach_baloons( $volts_fs[2], 
    "Amplifier full scale", 
    "Output of amplifier in volts when transducer is at full scale." );
attach_baloons( $volts_exe[2], 
    "Excitation voltage", 
    "Differential voltage across the wheatstone bridge." );
attach_baloons( $mv_per_v[2], 
    "Transducer sensitivity", 
    "Ratio of bridge output voltage to excitation volatage at full scale." );
attach_baloons( $bridge_ohms[2], 
    "Bridge resistance", 
    "Assuming full symmetry, the resistance of any one arm of the bridge." );
attach_baloons( $shunt_ohms[2], 
    "Shunt resistance", 
    "The resistance in kOhms of an external resistor added in parallel to any one arm of the bridge."
);

sub attach_baloons {
    my ($widget, $baloon_msg, $status_msg) = @_;
    $balloon->attach(
        $widget,
        -balloonmsg => "$baloon_msg",
        -statusmsg => "$status_msg",
    );
}

frame_label_entry( $frame_btm, "Amplifier Gain:",    \$gain);
frame_label_entry( $frame_btm, "Output Bridge:",     \$mV_out_bridge);
frame_label_entry( $frame_btm, "Output Amplifier:",  \$v_out_amp);
frame_label_entry( $frame_btm, "Output Scaled:",     \$result);

$mw->repeat(500, \&wheatstone );

MainLoop;

# Calculate the parallel resistance.
sub shunt { return 1 / ( 1/$r + 1/$_[0]/1000 ); }

# Perform all other calculations.
sub wheatstone {
    $v_out_bridge  = $v_exe * ( $r * $r - shunt($r_shunt) * $r ) / (( shunt($r_shunt) + $r) * ($r + $r));
    $mV_out_bridge = sprintf '%.3f mV', $v_out_bridge * 1000;
    $gain          = sprintf '%.3f', $v_fs / $v_exe / $mV_per_V * 1000;
    $v_out_amp     = sprintf '%.3f V', $v_out_bridge * $gain;
    $result        = sprintf '%.3f Units', $v_out_bridge * 1000 / $mV_per_V / $v_exe * $fs;
}

# Automated frame, label and scale with zoom buttons.
sub frame_label_zoom {
    my ( $parent, $text, $from, $to, $min_limit, $max_limit, $res_limit, $var_ref, $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,
        -variable     => $var_ref,
        -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;
}

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;
    }
}

# Automated frame with label and entry widgets.
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;
}

############################
# 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 2005, 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 #
###############################

__END__

=head1 NAME

Wheatstone Bridge Calculator

=head1 SYNOPSIS

perl C<gus_wheatstone.pl>

=head1 DESCRIPTION

Calculates the mV and Units output for Wheatstone bridges.

=head1 PREREQUISITES

For use especially (but not exclusively) with strain gage type load cells.

=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.

=head1 SCRIPT CATEGORIES

MTS/MultiPurpose Test

=cut