Old stuff/Perl/svn/scrabble/trunk/api/Game.pm
(Deskargatu)
#!/usr/bin/perl
#
package Game;
use strict;
use Exporter;
our $VERSION = 1.00;
our @ISA = qw!Exporter!;
#our %EXPORT_TAGS = (
# DICTIONNARY => [ qw(&load_dictionnary &read_words &check_word) ],);
our @EXPORT = qw!&plateau_generate &display_plateau &calculate_points &load_dictionnary &read_words &check_word &set_lang &send_message!;
=for TODO_LIST
d�finir proprement une interface ( quels symboles peuvent/doivent �tre priv�s au paquetage, etc )
d�finir des codes d'erreur et faire des fichiers langue pour les messages
=cut
our @words;
our $words_file;
our %messages;
our $lang = 'en';
our %values = (
A=>1,B=>3, C=>3,D=>2, E=>1,F=>4,G=>2,H=>4,I=>1, J=>8,K=>10,L=>1,M=>2,N=>1,O=>1,P=>3,Q=>8,
R=>1,S=>1,T=>1,U=>1,V=>4,W=>10,X=>10,Y=>10,Z=>10);
our @plateau;
=for comment
B<plateau_generate> g�n�re le plateau du jeu.
Chaque case est un tableau de deux �l�ments.
Premier �l�ment : facteur multipliant la valeur de la lettre ou les points du mot ( dans lequel cas, un 'm' est suffix� au facteur )
Second �l�ment : 0 ou lettre plac�e
=cut
sub plateau_generate {
# doublent la valeur de la lettre : D1, A2, A12, C7, C9, D8, D15, G3, G7, G9, G13, H4, H13, I3, I7, I9, I15, L1, L8, L15, M7, M9, O4, O12
my @double_lettre = ([3,0],[0,1],[0,11],[2,6],[2,8],[3,7],[3,14],[6,2],[6,6],[6,8],[6,12],[7,3],[7,12],[8,2],[8,6],[8,14],[9,0],[9,7],[9,14],[10,6],[10,8],[11,3],[11,11]);
# triplent la valeur de la lettre : B6, B10, F2, F6, F10, F14, J2, J6, J10, J14, N6, N10
my @triple_lettre = ([1,5],[1,9],[5,1],[5,5],[5,9],[5,13],[9,1],[9,5],[9,9],[9,13],[13,5],[13,9]);
# doublent les points du mot : B2, C3, D4, E5, E11, D12, C13, B14
my @double_mot = ([1,1],[2,2],[3,3],[4,4],[4,10],[3,11],[2,12],[1,13]);
# triplent les points du mot : A1, A8, A15, H1, H15, 01, 08, 015
my @triple_mot = ([0,0],[0,7],[0,14],[7,0],[7,14],[14,0],[14,7],[14,14]);
# les cases non-sp�ciales :
my %union;
#foreach my $e(@double_lettre,@triple_lettre,@double_mot,@triple_mot) { $union{$e}++;}
foreach my $e(@double_lettre,@triple_lettre,@double_mot,@triple_mot) { my $f = "$$e[0]:$$e[1]";$union{$f}++;}
#print "mon hash union :\n";
#print join " - ", keys %union;
my @speciales = map { [(split /:/,$_)]} keys %union;
#print "il y a ",scalar @speciales," sp�ciales \nVoici les sp�ciales";
#print join "-", @{$_}," " for (@speciales);
my @nonspeciales = ();
#print "voici les double lettre :\n";
#print join "*",@{$_}, " " for (@double_lettre);
print "\n\n";
my @total = ();
for my $i(0..14) {
for my $j(0..14) {
push @total,[$i,$j];
}
}
foreach my $foo (@total) {
my $trouve = 0;
foreach my $bar (@speciales) {
$trouve = 1 if ( ($$foo[0] == $$bar[0]) && ($$foo[1] == $$bar[1]) );
}
push (@nonspeciales, $foo) unless ($trouve == 1);
}
print "il y a ",scalar @nonspeciales," non-sp�ciales \n";
for my $i (0..14) {
$plateau[$i] = [];
push @{ $plateau[$i] }, [] for 1..15;
}
# remplissage des doubles lettre
foreach my $case (@double_lettre) {
$plateau[$$case[0]]->[$$case[1]]->[0]='2';
$plateau[$$case[0]]->[$$case[1]]->[1]='0';
}
# remplissage des triples lettre
foreach my $case (@triple_lettre) {
$plateau[$$case[0]]->[$$case[1]]->[0]='3';
$plateau[$$case[0]]->[$$case[1]]->[1]='0';
}
# remplissage des doubles mot
foreach my $case (@double_mot) {
$plateau[$$case[0]]->[$$case[1]]->[0]='2m';
$plateau[$$case[0]]->[$$case[1]]->[1]='0';
}
# remplissage des triples mot
foreach my $case (@triple_mot) {
$plateau[$$case[0]]->[$$case[1]]->[0]='3m';
$plateau[$$case[0]]->[$$case[1]]->[1]='0';
}
# remplissage des non sp�ciales :
foreach my $case (@nonspeciales) {
$plateau[$$case[0]]->[$$case[1]]->[0]='0';
$plateau[$$case[0]]->[$$case[1]]->[1]='0';
}
}
=for comment
B<display_plateau> affiche en mode texte le plateau du jeu.
=cut
sub display_plateau {
my @rangees = ('A' .. 'O');
#local $, = " "x2;
local $\ = "";
print " ";
print join "\t ",(1..15);
print "\n";
for my $i (0..14) {
print $rangees[$i], " ";
for my $j (0..14) {
print "[", $plateau[$i]->[$j]->[0],"-",$plateau[$i]->[$j]->[1],"] ";
}
print "\n";
}
}
=for comment
B<load_dictionnary> prend en argument un nom de fichier dictionnaire et rempli @words de son contenu
=cut
sub load_dictionnary ($) {
$words_file = shift;
open(WORDS, "<$words_file") or die "Impossible d'ouvrir le fichier dicco : $!\n";
# ne pas die et renvoyer un code d'erreur � l'appelant
while (<WORDS>) {
chomp;
push @words, $_;
}
close(WORDS);
}
=for comment
B<read_words> affiche le contenu de @words i.e. le contenu du dictionnaire courant.
=cut
sub read_words {
local $, = "\n";
print STDOUT @words;
}
=for comment
B<check_word> prend en argument un mot � rechercher et v�rifie son existence dans le dictionnaire courant.
La fonction renvoie la valeur -1 si le mot n'a pas pu �tre trouv�.
=cut
sub check_word($) {
my $word = shift;
my $found = 0;
# tester si un grep peut �tre utilis�e en context void et s'il est plus rapide � l'ex�cution
foreach (@words) {
$found = 1 if (m!\b$word\b!i);
}
return $found;
}
=for TODO_LIST
bosser gettext & assimil�s
=cut
sub set_lang($) {
$lang = shift;
#open(LANGFILE,"<data/messages.$lang") or die "impossible d'ouvrir langue";
#
#close(LANGFILE);
#
return $lang;
}
# pour test
%messages = ("ERROR1" => "ceci est l'erreur 1",
"ERROR2" => "Ceci est l'erreur 2",
"ERROR3" => "Ceci est l'erreur 3",);
=for comment
B<send_message> prend en argument la cl� d'un message et renvoie le texte du message en fonction de la langue courante.
On utilise un hash par pr�voyance : avoir un mot sera plus parlant s'il y a un probl�me dans la sub .
Retourne -1 si pas de texte trouv� correspondant � la cl�.
=cut
sub send_message($) {
my $keycode = shift;
return ((exists($messages{$keycode})) ? $messages{$keycode} : "-1");
}
=for comment
B<calculate_points> prend en argument un mot et sa position sur le plateau et renvoie le nombre de points.
=cut
sub calculate_points($$) {
my $word = shift; # en l'attente de la gestion de la position
my $points = 0;
foreach my $letter((split //, $word)) {
$letter = uc($letter);
$points += $values{$letter};
}
return $points;
}
=for comment
B<put_letter> prend en argument une lettre et des coordonn�es.
V�rifie l'existence des mots form�s par voisinage de la lettre.
Renvoie -1 si un seul mot form� avec les lettres du plateau est absent dans le dictionnaire.
Sinon renvoie le nombre de points du nouveau mot form� avec les lettres du plateau.
sub put_letter($$) {
my ($letter, $position) = shift;
}
1;
Tfe