#!/usr/bin/perl
#
# CalcNIFTk.pl
#
# Version 1.02 2007.04.23 - 2007.10.24
# (c) 2007 por Javier Pérez Montes - el.maquinas@terra.es
#
##########
# MODULOS
#
use strict;
use Tk;
use Tk::DialogBox;
sub Calcular;
sub Borrar;
#############
# CONSTANTES
#
my $VERSION = "1.02";
my %NIF = (
    0 => 'T', 1 => 'R', 2 => 'W', 3 => 'A', 4 => 'G', 5 => 'M',
    6 => 'Y', 7 => 'F', 8 => 'P', 9 => 'D', 10 => 'X', 11 => 'B',
    12 => 'N', 13 => 'J', 14 => 'Z', 15 => 'S', 16 => 'Q', 17 => 'V',
    18 => 'H', 19 => 'L', 20 => 'C', 21 => 'K', 22 => 'E',
    'DIVISOR' => 23
);
#######
# MAIN
#
my $mw = MainWindow->new(-width=>700);
$mw->title("CalcNIFTk ".$VERSION);
$mw->configure( -width=>100, -height=>150);
$mw->resizable( 0, 0 ); # not resizable in any direction
# Construyo los campos
my $frame1 = $mw->Frame()->pack(-expand => '1', -fill => 'both', -side => 'top');
$frame1->Label(-text => "D.N.I.:")->pack(-side => 'left', -padx => '4');
my $DNI = $frame1->Entry(-width => '15', -relief => 'sunken')->pack(-side => 'left', -expand => '0', -fill => 'x', -padx => '4', -pady => '10');
$frame1->Label(-text => "-")->pack(-side => 'left');
my $LetraNIF = $frame1->Entry(-width => '2', -relief => 'sunken', -state => 'normal')->pack(-side => 'left', -expand => '0', -fill => 'x', -padx => '4');
#
my $frame2 = $mw->Frame()->pack(-expand => '1', -fill => 'both', -side => 'bottom', -padx => '4', -pady => '10');
$frame2->Button(-text => "Calcular", -underline => '0', -command => sub { Calcular; })->pack(-side => "left");
$frame2->Button(-text => "Borrar", -underline => '0', -command => sub { Borrar; })->pack(-side => "left", -padx => '4');
$frame2->Button(-text => "Salir", -underline => '0', -command => sub { exit; })->pack(-side => "right");
# Remapeado de teclas.
$mw->bind('<KeyPress-C>' => sub { 
        $DNI -> delete(length($DNI -> get)-1);
        Calcular; 
    });
$mw->bind('<KeyPress-c>' => sub { 
        $DNI -> delete(length($DNI -> get)-1);
        Calcular; 
    });
$mw->bind('<KeyPress-Return>' => sub { Calcular; });
$mw->bind('<KeyPress-B>' => sub { Borrar; });
$mw->bind('<KeyPress-b>' => sub { Borrar; });
$mw->bind('<KeyPress-Escape>' => sub { exit; });
$mw->bind('<KeyPress-S>' => sub { exit; });
$mw->bind('<KeyPress-s>' => sub { exit; });
#
$DNI->focus;
MainLoop;
exit(0);

############
# FUNCIONES
#

# Calcular
sub Calcular {
    my $dni = $DNI -> get;
    if ($dni =~ /^\d+$/) {
        $LetraNIF -> delete(0,length($LetraNIF -> get)) if (length($LetraNIF -> get) > 0);
        $LetraNIF -> insert(0,$NIF{$dni%$NIF{'DIVISOR'}});
    } else {
        warn "El valor introducido no es numérico: '$dni'\n";
        my $dialog = $mw->DialogBox( -title   => "Advertencia", -buttons => [ "Aceptar" ]);
        $dialog->add("Label", -text => "El valor introducido no es numérico o está vacío: '$dni'")->pack;
        $dialog->Show;
    }
}

# Borrar
sub Borrar {
    $LetraNIF -> delete(0,length($LetraNIF -> get)) if (length($LetraNIF -> get) > 0);
    $DNI -> delete(0,length($DNI -> get)) if (length($DNI -> get) > 0);
}
#FIN
=head1 NAME

CalcNIFTk

=head1 DESCRIPTION

Sample script that calculates the spanish N.I.F. letter.
Script de ejemplo que calcula la letra del N.I.F. 

=head1 README

CalcNIFTk is sample Perl/Tk script that enables you to 
calculate the Spanish NIF letter from NIF number. 
Works under Linux and Windows.

Sorry English users this software was written in Spanish.
Feel free to contact the author for more information.


CalcNIFTk es una script Perl/Tk de ejemplo que le 
permitirá calcular la letra del número NIF utilizado en
España. Funciona bajo Linux y Windows.

=head1 PREREQUISITES

This script requires the C<strict> module.  It also requires C<Tk> and C<Tk::DialogBox>.
Este módulo requiere del módulo C<strict>. Tambien requiere de los módulos C<Tk> y C<Tk::DialogBox>.

=head1 COREQUISITES

=pod OSNAMES

linux
MSWin32

=pod SCRIPT CATEGORIES

Educational
Win32/Utilities

=head1 AUTHOR

CalNIFTk.pl - Copyright 2007 Javier Pérez Montes,  All rights reserved.

This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Este script es software libre, puede redistribuirlo y/o modificarlo bajo los mismo términos que Perl.

=cut