#!/usr/local/bin/perl -w use strict; use diagnostics; use Tk; use Tk::Dialog; sub convert_main; sub num2char; sub char2num; sub denary2string; sub base2denary; sub char2denary; my $mw = MainWindow->new; $mw->geometry("500x500"); $mw->minsize(qw(500 500)); $mw->maxsize(qw(500 500)); $mw->title("Mega-Converter"); my $top_frm = $mw->Frame->pack(-side => 'top', -fill => 'y', pady => 8 +); my $mid_frm = $mw->Frame->pack(-side => 'top', -fill => 'x', pady => 8 +); my $bottom_frm = $mw->Frame->pack(-side => 'top', -fill => 'x', pady = +> 8); my $left_frm = $mid_frm->Frame->pack(-side => 'left', -fill => 'y', -padx => 4, -expand => 1, -anchor => 'center'); my $mid_frm1 = $mid_frm->Frame->pack(-side => 'left', -fill => 'y', -padx => 4, -expand => 1, -anchor => 'center'); my $right_frm = $mid_frm->Frame->pack(-side => 'left', -fill => 'y', -padx => 4, -expand => 1, -anchor => 'center'); my $start_text = $top_frm->Text(-background => 'white', -height => 13)->pack; my $convert_btn = $mid_frm1->Button(-text => 'Convert >>', -command => \&convert_main) ->pack(-side => 'top', pady => 2, padx => 2, -expand => 1, -anchor => +'center'); my $label2 = $left_frm->Label(-text => 'Convert From:', -padx => 4) ->pack(-side => 'top'); my $from_lb = $left_frm->Scrolled('Listbox', -exportselection => 0, -scrollbars => 'e', -selectmode => 'single', -background => 'white', -height => 5)->pack(-side => 'top'); $from_lb->insert('end', qw/Binary Octal Decimal Hex Char/); my $label3 = $right_frm->Label(-text => 'Convert To:', -padx => 4) ->pack(-side => 'top'); my $to_lb = $right_frm->Scrolled('Listbox', -exportselection => 0, -scrollbars => 'e', -selectmode => 'single', -background => 'white', -height => 5)->pack(-side => 'top'); $to_lb->insert('end', qw/Binary Octal Decimal Hex Char/); my $end_text = $bottom_frm->Text(-background => 'white', -height => 13)->pack; my $dialog = $mw->Dialog; MainLoop; my ($start_string, $end_string, $base_from, $base_to); my @start_values; sub convert_main { my @base_values = (2, 8, 10, 16); my (@from_list, @to_list); my $err = 0; @from_list = $from_lb->curselection(); @to_list = $to_lb->curselection(); $base_from = $base_values[$from_list[0]]; $base_to = $base_values[$to_list[0]]; $start_string = $start_text->get('1.0', 'end'); chomp($start_string); # Search for invalid entries # Binary if ($from_list[0] == 0 and !($start_string =~ m/^[0-1].+$/)) { $err = 1; } # Octal if ($from_list[0] == 1 and !($start_string =~ m/^[0-7].+$/)) { $err = 1; } # Denary (decimal) if ($from_list[0] == 2 and !($start_string =~ m/^[0-9].+$/)) { $err = 1; } # Hex if ($from_list[0] == 3 and !($start_string =~ m/^[0-9a-fA-F].+$/)) + { $err = 1; } if ($err == 1) { $dialog->configure(-title => 'Invalid Entry', -text => 'Invali +d value.'); $dialog->Show; return; } if ($from_list[0] == 4) { @start_values = split(//, $start_string); char2num(); } else { @start_values = split(/ /, $start_string); base2denary(); } if ($to_list[0] == 4) { num2char(); } else { denary2string; } $start_string = ''; $end_string = ''; } sub num2char { my $value = ''; $end_string = pack('C*', @start_values); $end_text->delete('1.0', 'end'); $end_text->insert('1.0', $end_string); } sub char2num { my $value1 = ''; my $value2 = ''; my $index1 = 0; my @temp; my @temp2; foreach $value1 (@start_values) { @temp = split(//, $value1); foreach $value2 (@temp) { $temp2[$index1] = unpack('c*', $value2); $index1 += 1; } } @start_values = @temp2; } sub denary2string { my $value1 = 0; my $index1 = 0; my $index2 = 0; my $temp = ''; my %character_map = ( '10' => 'A', '11' => 'B', '12' => 'C', '13' => 'D', '14' => 'E', '15' => 'F', ); foreach $value1 (@start_values) { while ($value1 >= $base_to**$index1) { $a = int(($value1/($base_to**$index1)) % $base_to); if (defined($character_map{$a})){ $a = $character_map{$a}; } $temp = $a.$temp; $index1 += 1; } if ($index2 > 0) { $end_string = $end_string.' '.$temp; } else { $end_string = $end_string.$temp; } $index1 = 0; $temp = ''; $index2 += 1; } $end_text->delete('1.0', 'end'); $end_text->insert('1.0', $end_string); } sub base2denary { my $value1 = 0; my $value2 = 0; my $final_num = 0; my $index = 0; my $index2 = 0; my @temp = (); foreach $value1 (@start_values) { @temp = split(//, $value1); @temp = reverse(@temp); foreach $value2 (@temp) { $value2 =~ s/(a|A)/10/; $value2 =~ s/(b|B)/11/; $value2 =~ s/(c|C)/12/; $value2 =~ s/(d|D)/13/; $value2 =~ s/(e|E)/14/; $value2 =~ s/(f|F)/15/; $final_num = $final_num + ($value2 * ($base_from**$index)) +; $index +=1; } $start_values[$index2] = $final_num; $index2 += 1; $final_num = 0; $index = 0; } }
In reply to Perl/Tk Mega-Converter by Lysander
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |