gistfile1.pl

#!/usr/bin/perl

# author : Jean-Baptiste Bourgoin
# Licence : GPLv2

use strict;
use warnings;
use Tk;

my ($param1, $param2) = @ARGV;

# fenetre principale
my $mw = MainWindow->new;

#cadres princpaux
my $ctitre =  $mw->Frame()                     # CADRE TITRE
    ->pack(-side => 'top', -fill => 'y');
my $cfight =  $mw->Frame()                     # CADRE COMBATTANTS
    ->pack(-side => 'top', -fill => 'y');
my $cmessage =  $mw->Frame()                     # CADRE COMBATTANTS
    ->pack(-side => 'bottom', -fill => 'y');

########## CADRE TITRE
my $titre1 = $ctitre->Label(-text=>"Tunnels & Trolls\n", -font=>"Times 20 bold")->pack();
my $titre2 = $ctitre->Label(-text=>"Fighting Simulation\n", -font=>"Times 14 italic")->pack();

########## CADRE COMBATTANTS
my $cf1 =  $cfight->Frame()->pack(-side => 'left', -fill => 'x');
my $cbt =  $cfight->Frame()->pack(-side => 'left', -fill => 'x', -padx=>30, -pady=>10);
my $cf2 =  $cfight->Frame()->pack(-side => 'right', -fill => 'x');

# cadre du combattant 1
my $cf1a =  $cf1->Frame()->pack(-side => 'top', -fill => 'y');
my $cf1b =  $cf1->Frame()->pack(-side => 'top', -fill => 'y');
my $cf1c =  $cf1->Frame()->pack(-side => 'top', -fill => 'y');

my $c1name = $cf1a->Label(-text => "Name ")->pack(-side => "left");
my $c1nameE = $cf1a->Entry(-background => "white", -textvariable => "Ken")->pack(-side => "right");

my $c1des = $cf1b->Label(-text => "Dices ")->pack(-side => "left");
my $c1desE = $cf1b->Entry(-background => "white",)->pack(-side => "right");

my $c1adds = $cf1c->Label(-text => "ADDS ")->pack(-side => "left");
my $c1addsE = $cf1c->Entry(-background => "white")->pack(-side => "right");

# cadre du combattant 2
my $cf2a =  $cf2->Frame()->pack(-side => 'top', -fill => 'y');
my $cf2b =  $cf2->Frame()->pack(-side => 'top', -fill => 'y');
my $cf2c =  $cf2->Frame()->pack(-side => 'top', -fill => 'y');

my $c2name = $cf2a->Label(-text => "Name ")->pack(-side => "left");
my $c2nameE = $cf2a->Entry(-background => "white", -textvariable => "Liz")->pack(-side => "right");

my $c2des = $cf2b->Label(-text => "Dices ")->pack(-side => "left");
my $c2desE = $cf2b->Entry(-background => "white")->pack(-side => "right");

my $c2adds = $cf2c->Label(-text => "ADDS ")->pack(-side => "left");
my $c2addsE = $cf2c->Entry(-background => "white")->pack(-side => "right");

########## CADRE MESSAGES
my $txt = $cmessage -> Scrolled("Text",-scrollbars=>'e')->pack();
# fonction de calcul des degats
my $round = 1;
sub degats {
    my ($joueur, $des, $adds) = @_;
    my $total_des = 0;
    my $nbr6 = 0;
    foreach my $i(1 .. $des) {
	my $jet = int(rand(6)) + 1;
	if ($jet == 6) { $nbr6 = ( $nbr6 +1) };
	$total_des = $total_des + $jet;

	#print "$jet ";
    }
    my $total = $total_des + $adds;
    $txt -> insert('end', "Round $round, $joueur => $total normal damages and $nbr6 spite damages\n\n");
}

########### CADRE DES BOUTTONS
# bouton de calcul du combat
my $fightb = $cbt -> Button(-text=>"Fight !", -command => \&fight)->pack();

sub fight {
    my $param1a = $c1nameE->get();
    my $param1b = $c1desE->get();
    my $param1c = $c1addsE->get();
    degats($param1a, $param1b, $param1c);
    my $param2a = $c2nameE->get();
    my $param2b = $c2desE->get();
    my $param2c = $c2addsE->get();
    degats($param2a, $param2b, $param2c);
    $round = $round + 1;
}
# bouton de nettoyage
my $clearb = $cbt -> Button(-text=>"Clear",
			   -command => \&clear )-> pack();
sub clear {
    $c1nameE->delete('0.0', 'end');
    $c1desE->delete('0.0', 'end');
    $c1addsE->delete('0.0', 'end');
    $c2nameE->delete('0.0', 'end');
    $c2desE->delete('0.0', 'end');
    $c2addsE->delete('0.0', 'end');
    $txt->delete('0.0', 'end');
    $round = 1;
}

# bouton de fermeture
my $exitb = $cbt -> Button(-text=>"Exit",
			   -command => sub { exit })-> pack();

MainLoop;