diff options
-rw-r--r-- | doc/manuel_utilisateur.txt | 13 | ||||
-rw-r--r-- | src/MTools/GUI/MTexture.pm | 37 |
2 files changed, 34 insertions, 16 deletions
diff --git a/doc/manuel_utilisateur.txt b/doc/manuel_utilisateur.txt index 8f54270..386a6a7 100644 --- a/doc/manuel_utilisateur.txt +++ b/doc/manuel_utilisateur.txt @@ -297,17 +297,18 @@ my $message=new MTools::GUI::MText(1,"Texte d'exemple",100,100,-color=>"gray"); mrun; ___________ MTexture.pm : -Permet d'appliquer une texture à un objet. Une texture est une image qui sert de -motif au remplissage d'une figure. Comme pour une tapisserie, la texture est +Permet d'appliquer une texture à un objet. Une texture est un motif qui est +utilisé pour remplir une figure. Comme pour une tapisserie, la texture est répétée autant de fois que nécessaire pour couvrir toute la surface. Le coin en -haut à gauche de la texture est aligné avec le coin en haut à gauche de la bbox -de la figure à remplir. +haut à gauche de la bbox de la texture est aligné avec le coin en haut à gauche +de la bbox de la figure à remplir. La création nécessite les arguments suivants : - parent : père de l'objet. - target : groupe zinc ou objet MTools définissant le contour de la figure. - - image_name : nom de l'image texture (fichier png) Tester avec les - autres formats*** + - pattern : objet graphique MTools (texte, image, svg...) ou nom de d'un + fichier image (fichier png) Tester avec les autres formats*** + Le pattern est le motif qui va être répété. Exemple d'utilisation : use MTools; diff --git a/src/MTools/GUI/MTexture.pm b/src/MTools/GUI/MTexture.pm index 13ad4aa..6362832 100644 --- a/src/MTools/GUI/MTexture.pm +++ b/src/MTools/GUI/MTexture.pm @@ -20,7 +20,7 @@ package MTools::GUI::MTexture; # Parametres : # * parent : pere de l'objet. # * target : group zinc ou MTools destine a contenir les images de texture -# * image_name : nom de l'image texture +# * pattern : nom d'un fichier image ou objet MTools. use strict; @@ -38,31 +38,48 @@ BEGIN } sub new { - my ($class, $parent, $target, $image_name) = @_; + my ($class, $parent, $target, $pattern) = @_; my $self = new MTools::GUI::MGroup ($parent); bless $self, $class; chggroup ($target, $self); - my $image = new MTools::GUI::MImage ($self, $image_name); + my ($img_w, $img_h, $offset_x, $offset_y); + + if (ref($pattern) eq '') { + my $image = new MTools::GUI::MImage ($self, $pattern); + my @bb = bbox ($image); + $img_w = $bb [2] - $bb [0]; + $img_h = $bb [3] - $bb [1]; + mdelete ($image); + } else { + my @bb = bbox ($pattern); + $img_w = $bb [2] - $bb [0]; + $img_h = $bb [3] - $bb [1]; + $offset_x = -$bb [0]; + $offset_y = -$bb [1]; + } - my @bb = bbox ($image); - my $img_w = $bb [2] - $bb [0]; - my $img_h = $bb [3] - $bb [1]; my @bb = bbox ($target); my $w = $bb [2] - $bb [0]; my $h = $bb [3] - $bb [1]; - - mdelete ($image); + $offset_x += $bb [0]; + $offset_y += $bb [1]; my @images_list; + my $image; for (my $x = 0; $x < $w; $x += $img_w) { for (my $y = 0; $y < $h; $y += $img_h) { - $image = new MTools::GUI::MImage ($self, $image_name); - $image -> translate ($x + $bb [0], $y + $bb [1]); + if (ref($pattern) eq '') { + $image = new MTools::GUI::MImage ($self, $pattern); + } else { + $image = clone($pattern); + chggroup($image, $self); + } + translate ($image, $x + $offset_x, $y + $offset_y); push @images_list, $image; } } |