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();
Back to
Cool Uses for Perl