Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

I was recently diagnosed with type 2 diabetes, and with this disease, almost everyone talks in terms of an exchange diet. An exchange diet requires a fair amount of bookkeeping to manage, and foods are broken down in terms of exchanges in large part so you can easily track carbohydrate intake. The other foods are necessary to keep up your calorie intake and in general, balance your nutrition.

I don't claim this is an original idea. There are various online exchange calculators, the best of which is here. But I've been puttering with Perl Tk and this seemed a suitable project.

#!/usr/bin/perl use warnings; use strict; =head1 NAME exchange-tk.pl - A tool to calculate the calories in diabetes exchang +es. =head1 SYNOPSIS exchange-tk.pl [options] Options: --help brief help message --man full documentation This is a Perl-Tk program so it is GUI and visual. Enter the exchanges and press the Compute button to do the calculations. =head1 VERSION author David Myers date February 11, 2009 modified N/A =head1 DESCRIPTION exchange-tk.pl - A tool to calculate the calories in diabetes exchang +es. =head1 COPYRIGHT This program is copyrighted (C) 2010 by David Myers. All rights are reserved. This program is licensed under the terms of the the Artistic License version 2.0. A copy of the license can be found at this URL: http://www.opensource.org/licenses/artistic-license-2.0.php =head1 BUGS In Ubuntu, you may have to export XMODIFIERS="" to get this code to work. for more details, see the bug documented here: https://bugs.launchpad.net/ubuntu/+source/perl-tk/+bug/283806 =cut use English; use Tk; use Getopt::Long; use Pod::Usage; my $help = 0; my $man = 0; GetOptions( 'help|?' => \$help, man => \$man, ) or pod2usage(2); pod2usage( -exitval => 0, -verbose => 1 ) if $help; pod2usage( -exitval => 0, -verbose => 2 ) if $man; my $Version = "0.11"; my $debug = 0; # # calories/gram list # my $cal_fat = 9.0; my $cal_protein = 4.0; my $cal_carb = 4.0; my $cal_alcohol = 7.0; # exchange diet groups my @exc_map = ( "", "starch", "fruit", "skim_milk", "one_milk", "two_milk", "whole_milk", "veggies", "very_lean_meat", "lean_meat", "fat_meat", "very_fat_meat", "fats", ); my %exchange_groups = ( starch => [ "Starch", 15, 3, 1, 80 ], fruit => [ "Fruits", 15, 0, 0, 60 ], skim_milk => [ "Skim Milk", 12, 8, 0, 90 ], one_milk => [ "1% Milk", 12, 8, 1, 100 ], two_milk => [ "2% Milk", 12, 8, 3, 120 ], whole_milk => [ "Whole Milk", 12, 8, 5, 150 ], veggies => [ "Vegetables", 5, 2, 0, 25 ], very_lean_meat => [ "Very Lean Meat", 0, 7, 1, 35 ], lean_meat => [ "Lean Meat", 0, 7, 3, 55 ], fat_meat => [ "Med Fat Meat", 0, 7, 5, 75 ], very_fat_meat => [ "Very Fat Meat", 0, 7, 8, 100 ], fats => [ "Fats", 0, 0, 5, 45 ], ); my $main = MainWindow->new(); $main->title("Diabetic Exchange Calculator V $Version"); $main->configure( -background => 'cyan' ); # Build Frames and Widgets my $top = $main->Frame( -background => 'cyan' )->grid(); my $menuframe = $top->Frame( -background => 'cyan' ) ->grid( -row => 0, -column => 0, -sticky => 'w' ); my $dataframe = $top->Frame( -background => 'cyan' ) ->grid( -row => 0, -column => 1, -sticky => 'w' ); my $go = $menuframe->Button( -text => "Compute", -background => 'white', -command => \&compute ); $go->grid( -row => 0, -column => 0, -sticky => 'w' ); for my $fill ( 1 .. 13 ) { my $fill_text = $menuframe->Label( -text => ' ', -background => +'cyan' ); $fill_text->grid( -row => $fill, -column => 0, -sticky => 'w' ); } my $stop = $menuframe->Button( -text => 'Quit', -background => 'red', -command => sub { exit(0) } ); $stop->grid( -row => 14, -column => 0, -sticky => 'w' ); my @column_labels = ( "Category", "Servings", "Carbs (g)", "Proteins (g)", "Fats (g)", "Calories" ); for my $col_lbl ( 0 .. 5 ) { my $col_txt = $dataframe->Label( -text => $column_labels[$col_lbl], -background => 'cyan' ); $col_txt->grid( -row => 0, -column => $col_lbl, -sticky => 'w' ); } my @rowlabels = ( "", $exchange_groups{starch}[0], $exchange_groups{fruit}[0], $exchange_groups{skim_milk}[0 +], $exchange_groups{one_milk}[0], $exchange_groups{two_milk}[0] +, $exchange_groups{whole_milk}[0], $exchange_groups{veggies}[0], $exchange_groups{very_lean_meat}[0], $exchange_groups{lean_meat}[0 +], $exchange_groups{fat_meat}[0], $exchange_groups{very_fat_mea +t}[0], $exchange_groups{fats}[0], "Total", "Percent Calories" ); for my $row ( 1 .. 14 ) { my $row_txt = $dataframe->Label( -text => $rowlabels[$row], -background => 'cyan' ); $row_txt->grid( -row => $row, -column => 0, -sticky => 'w' ); } my @serving = (); my @serving_value = (); for my $row ( 1 .. 12 ) { $serving_value[$row] = "0"; $serving[$row] = $dataframe->Entry( -width => 4, -background => 'white', -state => 'normal', -textvariable => \$serving_value[$row] ); $serving[$row]->grid( -row => $row, -column => '1', -pady => 1 ); } my @carbs_obj = (); my @carbs_value = (); for my $row ( 1 .. 12 ) { $carbs_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[1]; $carbs_obj[$row] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$carbs_value[$row] ); $carbs_obj[$row]->grid( -row => $row, -column => '2', -pady => 1 ); } my @protein_obj = (); my @protein_value = (); for my $row ( 1 .. 12 ) { $protein_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[2]; $protein_obj[$row] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$protein_value[$row] ); $protein_obj[$row]->grid( -row => $row, -column => '3', -pady => 1 ); } my @fat_obj = (); my @fat_value = (); for my $row ( 1 .. 12 ) { $fat_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[3]; $fat_obj[$row] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$fat_value[$row] ); $fat_obj[$row]->grid( -row => $row, -column => '4', -pady => 1 ); } my @cal_obj = (); my @cal_value = (); for my $row ( 1 .. 12 ) { $cal_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[4]; $cal_obj[$row] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$cal_value[$row] ); $cal_obj[$row]->grid( -row => $row, -column => '5', -pady => 1 ); } my @total_obj = (); my @total_value = (); for my $col ( 2 .. 5 ) { $total_value[$col] = " "; $total_obj[$col] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$total_value[$col] ); $total_obj[$col]->grid( -row => 13, -column => $col, -pady => 1 ); } my @pct_obj = (); my @pct_value = (); for my $col ( 2 .. 5 ) { $pct_value[$col] = " "; $pct_obj[$col] = $dataframe->Label( -background => 'cyan', -state => 'normal', -textvariable => \$pct_value[$col] ); $pct_obj[$col]->grid( -row => 14, -column => $col, -pady => 1 ); } # # functions to compute totals and percentages. # sub compute_starch { for my $row ( 1 .. 12 ) { $carbs_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[1] +; } } sub compute_protein { for my $row ( 1 .. 12 ) { $protein_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[2] +; } } sub compute_fat { for my $row ( 1 .. 12 ) { $fat_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[3] +; } } sub compute_calories { for my $row ( 1 .. 12 ) { $cal_value[$row] = $serving_value[$row] * $exchange_groups{ $exc_map[$row] }[4] +; } } sub compute_total { my $sum; $sum = 0; for my $row ( 1 .. 12 ) { $sum += $carbs_value[$row]; } $total_value[2] = $sum; $sum = 0; for my $row ( 1 .. 12 ) { $sum += $protein_value[$row]; } $total_value[3] = $sum; $sum = 0; for my $row ( 1 .. 12 ) { $sum += $fat_value[$row]; } $total_value[4] = $sum; $sum = 0; for my $row ( 1 .. 12 ) { $sum += $cal_value[$row]; } $total_value[5] = $sum; } sub compute_pct { my $total = $total_value[5] || 1; my $pct = $total_value[2] * $cal_carb * 100.0 / $total; $pct_value[2] = sprintf( "%4.1f", $pct ) . "%"; $pct = $total_value[3] * $cal_protein * 100.0 / $total; $pct_value[3] = sprintf( "%4.1f", $pct ) . "%"; $pct = $total_value[4] * $cal_fat * 100.0 / $total; $pct_value[4] = sprintf( "%4.1f", $pct ) . "%"; } # button press to bind them all. sub compute { compute_starch(); compute_protein(); compute_fat(); compute_calories(); compute_total(); compute_pct(); } MainLoop();

In reply to A diabetes exchange calculator by dwm042

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (7)
As of 2024-04-18 09:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found