karchnu
/
some-usable-scripts
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add some code to enable the creation of the antipixel button, but nothing is implemented yet, i've to take the options parameters into consideration

master
Karchnu 2012-07-25 02:22:47 +02:00
parent d3c5a91865
commit 242837e1ff
1 changed files with 51 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
perl/antipixel/MyWrapper.pm
View File

@ -8,6 +8,16 @@ use MooX::Options;
has couleurs => ( is => 'ro', builder => '_build_colors' ); has couleurs => ( is => 'ro', builder => '_build_colors' );
option distance_entre_mots => ( is => 'rw',
doc => 'distance en pixels de chaque mot du message',
short => 'dem',
format => 'i', default => sub { 5 }
);
option output => ( is => 'rw',
doc => 'fichier généré : fichier image (ex: image.png)',
short => 'o',
format => 's', default => sub { 'image.png' }
);
option message => ( is => 'rw', option message => ( is => 'rw',
doc => 'message', doc => 'message',
short => 'm', short => 'm',
@ -18,6 +28,11 @@ option couleur_externe => ( is => 'rw',
short => 'ce', short => 'ce',
format => 's', default => sub { 'bleu' } format => 's', default => sub { 'bleu' }
); );
option couleur_contour => ( is => 'rw',
doc => 'couleur contour',
short => 'cc',
format => 's', default => sub { 'noir' }
);
option couleur_interne => ( is => 'rw', option couleur_interne => ( is => 'rw',
doc => 'couleur interne', doc => 'couleur interne',
short => 'ci', short => 'ci',
@ -60,6 +75,7 @@ sub afficher_couleurs {
sub afficher_valeurs_actuelles { sub afficher_valeurs_actuelles {
my ($self) = @_; my ($self) = @_;
say "Message : " . $self->message; say "Message : " . $self->message;
say "Distance entre mots : " . $self->distance_entre_mots;
say "couleur_interne : " . $self->couleur_interne; say "couleur_interne : " . $self->couleur_interne;
say "couleur_externe : " . $self->couleur_externe; say "couleur_externe : " . $self->couleur_externe;
say "couleur_background : " . $self->couleur_background; say "couleur_background : " . $self->couleur_background;
@ -70,14 +86,47 @@ sub tests {
my ($self) = @_; my ($self) = @_;
my %couleurs = %{$self->couleurs}; my %couleurs = %{$self->couleurs};
say "message : " . $self->message;
say "couleur_externe : " . $self->couleur_externe; say "couleur_externe : " . $self->couleur_externe;
say "Cette couleur n'existe pas !" unless exists $couleurs{$self->couleur_externe}; say "Cette couleur n'existe pas !" unless exists $couleurs{$self->couleur_externe};
} }
sub run { sub run {
my $self = shift; my $self = shift;
#$self->afficher_couleurs ; #$self->afficher_couleurs ;
$self->afficher_valeurs_actuelles; #$self->afficher_valeurs_actuelles;
my %couleurs = %{$self->couleurs};
my %couleurs_allouee;
my @mots = split / /, $self->message;
my $x = $self->taille_x;
my $y = $self->taille_y;
my $intersection = $x - 30;
# create a new image
my $im = new GD::Image($x,$y);
# allocate some colors
while( my ($key , $value) = each %couleurs)
{
#say "La couleur $key est : " . join(', ' , @$value);
$couleurs_allouee{$key} = $im->colorAllocate($$value[0], $$value[1], $$value[2]);
}
# make the background transparent and interlaced
#$im->transparent($couleurs_allouee{'blanc'});
$im->interlaced('true');
# Put a frame around the picture
$im->rectangle(0, 0, $x -1, $y -1, $couleurs_allouee{$self->couleur_contour});
# Put the background color
$im->filledRectangle(1, 1, $x -2, $y -2, $couleurs_allouee{$self->couleur_background});
# We add the word cases
$im->filledRectangle(2, 2, $intersection - $self->distance_entre_mots, $y -3, $couleurs_allouee{$self->couleur_interne});
# make sure we are writing to a binary stream
binmode STDOUT;
# Convert the image to PNG and print it on standard output
print $im->png;
} }
1; 1;