ZincTraceUtils, Tk::ZincText and LogoZinc are renamed

Tk::Zinc::TraceUtils, Tk::Zinc::Text and Tk::Zinc::Logo.

ZincTrace et ZincTraceErrors which load Tk::Zinc::TraceUtils
need update.

1 files changed, 187 insertions, 0 deletions

diff --git a/Perl/Zinc/Logo.pm b/Perl/Zinc/Logo.pm
new file mode 100644
index 0000000..5e9db69
--- /dev/null
+++ b/Perl/Zinc/Logo.pm
@@ -0,0 +1,187 @@
+#!/usr/bin/perl
+#---------------------------------------------------------------
+#  Project         : Harmony
+#  Module          : Harmony
+#  File            : Logo.pm
+#
+#  Copyright (C) 2001
+#  Centre d'Études de la Navigation Aérienne
+#  Authors: Vinot Jean-Luc <vinot@cena.fr>
+#
+#---------------------------------------------------------------
+
+package Tk::Zinc::Logo;
+
+use strict;
+use Carp;
+use Math::Trig;
+
+Construct Tk::Widget 'Tk::Zinc::Logo';
+
+
+my @Gradiants;
+
+# paramètres de construction graphique
+my %builder = (-gradset => {'logoshape' => '=axial 270 |#ffffff;100 0 28|#66848c;100 96|#7192aa;100 100',
+			    'logopoint' => '=radial -20 -20 |#ffffff;100 0|#f70000;100 48|#900000;100 80|#ab0000;100 100',
+			    'logoptshad' => '=path 0 0 |#770000;64 0|#770000;70 78|#770000;0 100',
+			    },
+
+	       -shape => {-form => {-itemtype => 'curve',
+				    -coords => [[0, 0],[106, 0],[106, 58],[122, 41],[156, 41],[131, 69],
+						[153, 99],[203, 41],[155, 41],[155, 0],[218, 0],[240, 0, 'c'],
+						[252, 17, 'c'],[252, 34],[252, 40, 'c'],[249, 50, 'c'],
+						[244, 56],[202, 105],[246, 105],[246, 87],[246, 60, 'c'],
+						[271, 37, 'c'],[297, 37],[323, 37, 'c'],[342, 57, 'c'],[344, 68],
+						[347, 64, 'c'],[350, 60, 'c'],[353, 56],[363, 46, 'c'],[375, 37, 'c'],
+						[395, 37],[395, 79],[393, 79],[385, 79, 'c'],[379, 86, 'c'],
+						[379, 93],[379, 100, 'c'],[385, 107, 'c'],[393, 107],[409, 107],
+						[409, 148],[397, 148],[378, 148, 'c'],[364, 144, 'c'],[354, 133],
+						[346, 124],[346, 148],[305, 148],[305, 87],[305, 83, 'c'],[301, 79, 'c'],
+						[297, 79],[293, 79, 'c'],[289, 83, 'c'],[289, 87],[289, 150],[251, 150],
+						[251, 130],[251, 126, 'c'],[247, 122, 'c'],[243, 122],[239, 122, 'c'],
+						[235, 126, 'c'],[235, 130],[235, 150],[176, 150],[154, 150,'c'],
+						[146, 131,'c'],[146, 114],[148, 105],[120, 105],[104, 81],[104, 105],
+						[74, 105],[74, 41],[52, 41],[52, 105],[20, 105],[20, 41],[0, 41],
+					       ],
+
+				    -params => {-priority => 50,
+						-linewidth => 3,
+						-linecolor => '#000000;100',
+						-filled => 1,
+						-closed => 0,
+						-fillcolor => 'logoshape',
+					       },
+				   },
+
+			  -shadow => {-clone => '-form',
+				      -translate => [6, 6],
+				      -params => {-fillcolor => '#000000;18',
+						  -linewidth => 0,
+						  -priority => 20,
+						 },
+				     },
+			 },
+
+	       -point => {-coords => [240, 96],
+			  -params => {-alpha => 80,
+				      -priority => 100,
+				     },
+
+			  -form => {-itemtype => 'arc',
+				    -coords => [[-20, -20], [20, 20]],
+				    -params => {-priority => 50,
+						-filled => 1,
+						-linewidth => 1,
+						-linecolor => '#a10000;100',
+						-fillcolor => 'logopoint',
+						-closed => 1,
+					       },
+				   },
+
+			  -shadow => {-clone => '-form',
+				      -translate => [5, 5],
+				      -params => {-fillcolor => 'logoptshad',
+						  -linewidth => 0,
+						  -priority => 20,
+						 },
+				     },
+			 },
+	      );
+
+
+
+sub new {
+    my $proto = shift;
+    my $type = ref($proto) || $proto;
+    my $widget = shift;
+    my %params = @_;
+
+    my $self = {};
+    bless ($self, $type);
+
+    $self->{'-widget'} = $widget;
+    $self->{'-parent'} = (exists $params{'-parent'}) ? $params{'-parent'} : 1;
+    $self->{'-priority'} = (exists $params{'-priority'}) ? $params{'-priority'} : 500;
+    $self->{'-position'} = (exists $params{'-position'}) ? $params{'-position'} : [0, 0];
+    $self->{'-scale'} = (exists $params{'-scale'}) ? $params{'-scale'} : [1, 1];
+
+    $self->drawLogo();
+
+    return bless $self, $type;
+}
+
+
+
+sub drawLogo {
+  my ($self) = @_;
+  my $zinc = $self->{'-widget'}; 
+  my $parent = $self->{'-parent'};
+  my $priority = $self->{'-priority'};
+
+
+  if ($builder{'-gradset'}) {
+    while (my ($name, $gradiant) = each( %{$builder{'-gradset'}})) {
+      # création des gradiants nommés
+      $zinc->gname($gradiant, $name) unless $zinc->gname($name);
+      push(@Gradiants, $name);
+    }
+  }
+
+  # création des groupes logo
+  # logogroup : groupe de coordonnées
+  my $logogroup =  $self->{'-item'} = $zinc->add('group', $parent, -priority => $priority);
+  $zinc->coords($logogroup, $self->{'-position'}) if ($self->{'-position'});
+
+  # group de scaling
+  my $group = $self->{'-scaleitem'} = $zinc->add('group', $logogroup);
+  $zinc->scale($group,  @{$self->{'-scale'}}) if ($self->{'-scale'});
+
+
+  # création de l'item shape (Zinc)
+  my $formstyle = $builder{'-shape'}->{'-form'};
+  $self->ajustLineWidth($formstyle->{'-params'});
+  my $shape = $zinc->add('curve', $group,
+			$formstyle->{'-coords'},
+			%{$formstyle->{'-params'}},
+		       );
+
+  # ombre portée de la shape
+  my $shadstyle = $builder{'-shape'}->{'-shadow'};
+  my $shadow = $zinc->clone($shape, %{$shadstyle->{'-params'}});
+  $zinc->translate($shadow, @{$shadstyle->{'-translate'}}) if ($shadstyle->{'-translate'});
+
+  # réalisation du point
+  my $pointconf = $builder{'-point'};
+  my $ptgroup = $zinc->add('group', $group, %{$pointconf->{'-params'}});
+  $zinc->coords($ptgroup,  $pointconf->{'-coords'});
+
+  my $pointstyle =  $pointconf->{'-form'};
+  my $point = $zinc->add('arc', $ptgroup,
+			 $pointstyle->{'-coords'},
+			 %{$pointstyle->{'-params'}},
+			 );
+
+  my $shadpoint = $zinc->clone($point, %{$shadstyle->{'-params'}});
+  $shadstyle = $pointconf->{'-shadow'};
+  $zinc->translate($shadpoint, @{$shadstyle->{'-translate'}});
+
+}
+
+
+sub ajustLineWidth {
+  my ($self, $style, $scale) = @_;
+
+  if ($style->{'-linewidth'}) {
+    my ($sx, $sy) = @{$self->{'-scale'}};
+    my $linewidth = $style->{'-linewidth'};
+    if ($linewidth >= 2) {
+      my $ratio = ($sx > $sy) ? $sy : $sx;
+      $style->{'-linewidth'} = $linewidth * $ratio;
+    }
+  }
+}
+
+1;
+
+