initial release

1 files changed, 324 insertions, 0 deletions

diff --git a/Perl/debug/LogoZinc.pm b/Perl/debug/LogoZinc.pm
new file mode 100644
index 0000000..5f5475b
--- /dev/null
+++ b/Perl/debug/LogoZinc.pm
@@ -0,0 +1,324 @@
+#!/usr/bin/perl
+#---------------------------------------------------------------
+#  File            : LogoZinc.pm
+#
+#  Copyright (C) 2001-2002
+#  Centre d'Études de la Navigation Aérienne
+#  Authors: Vinot Jean-Luc <vinot@cena.fr>
+#  $Id$
+#---------------------------------------------------------------
+
+package LogoZinc;
+
+use strict;
+use Carp;
+use Math::Trig;
+
+Construct Tk::Widget 'LogoZinc';
+
+
+my %builder = (-shape => {-geom => [['point', 0, 0],
+				    ['lineto', 106, 0],
+				    ['lineto', 0, 58],
+				    ['lineto', 16, -18],
+				    ['lineto', 34, 0],
+				    ['lineto', -25, 29],
+				    ['lineto', 22, 30],
+				    ['lineto', 50, -58],
+				    ['lineto', -48, 0],
+				    ['lineto', 0, -42],
+				    ['lineto', 64, 0],
+				    ['moveto', 0, 34],
+				    ['arc', 34, 34, 270, 135, 5],
+				    ['lineto', -44, 50],
+				    ['lineto', 44, 0],
+				    ['lineto', 0, -18],
+				    ['moveto', 50, 0],
+				    ['arc', 50, 50, 180, 154, 5],
+				    ['moveto', 50, 31],
+				    ['arc', 56, 56, 210, 60, 5],
+				    ['lineto', 0, 42],
+				    ['lineto', -2, 0],
+				    ['moveto', 0, 14],
+				    ['arc', 14, 14, 270, -180, -5],
+				    ['lineto', 14, 0],
+				    ['lineto', 0, 42],
+				    ['lineto', -14, 0],
+				    ['moveto', 0, -56],
+				    ['arc', 56, 56, 90, 50, 5],
+				    ['lineto', 0, 20],
+				    ['lineto', -40, 0],
+				    ['lineto', 0, -59],
+				    ['moveto', -8, 0],
+				    ['arc', 8, 8, 360, -180, -5],
+				    ['lineto', 0, 59],
+				    ['lineto', -38, 0],
+				    ['lineto', 0, -18],
+				    ['moveto', -8, 0],
+				    ['arc', 8, 10, 360, -180, -5],
+				    ['lineto', 0, 18],
+				    ['lineto', -51, 0],
+				    ['moveto', 0, -34],
+				    ['arc', 34, 34, 90, 108, 4],
+				    ['lineto', -28, 0],
+				    ['lineto', -16, -24],
+				    ['lineto', 0, 24],
+				    ['lineto', -30, 0],
+				    ['lineto', 0, -64],
+				    ['lineto', -22, 0],
+				    ['lineto', 0, 64],
+				    ['lineto', -32, 0],
+				    ['lineto', 0, -64],
+				    ['lineto', -20, 0],
+				    ],
+			  -linewidth => 3,
+			  -linecolor => '#000000:70',
+			  -fillcolor => '#ffffff:100 0 28|#66848c:100 96|#7192aa:100 100/270',
+			  -shadow => {-dxy => [6, 6],
+				      -fillcolor => '#000000:18',
+				  },
+			  },
+
+	       -point => {-posi => [240, 96],
+			  -alpha => 72,
+			  -geom => [['arc', 20, 20, 0, 360, 5]],
+			  -linewidth => 1,
+			  -linecolor => '#a10000:80',
+			  -fillcolor => '#ffffff:100 0|#f70000:100 48|#900000:100 80|#ab0000:100 100(-7 -6',
+			  -shadow => {-dxy => [5, 5],
+				      -fillcolor => '#770000:64 0|#770000:70 78|#770000:0 100[0 0',
+				  },
+		      },
+	       );
+
+
+
+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'};
+
+    # création du groupe
+    my ($x, $y) = @{$self->{'-position'}};
+    my ($xs, $ys) = @{$self->{'-scale'}};
+    
+    my $logogroup = $zinc->add('group', $parent, -priority => $priority);
+    $zinc->coords($logogroup, [$x, $y]);
+
+    my $group = $zinc->add('group', $logogroup);
+    $zinc->scale($group, $xs, $ys);
+
+    # création de l'item
+    my $shapeconf = $builder{'-shape'};
+    my @form_params = @{$shapeconf->{'-geom'}};
+
+    # ombre portée
+    my ($dx, $dy) = @{$shapeconf->{'-shadow'}->{'-dxy'}};
+    my $shadow_pts = $self->polyLine($dx, $dy, @form_params);
+    $zinc->add('curve', $group,
+	       $shadow_pts,
+	       -closed => 1,
+	       -filled => 1,
+	       -fillcolor => $shapeconf->{'-shadow'}->{'-fillcolor'},
+	       -linewidth => 0,	
+	       );
+
+    my $shape_pts = $self->polyLine(0, 0, @form_params);
+    my $linewidth = int(($shapeconf->{'-linewidth'} * $xs) + 0.5);
+    $linewidth = 1 if $linewidth <= 0;
+    
+    $zinc->add('curve', $group,
+	       $shape_pts,
+	       -closed => 0,
+	       -filled => 1,
+	       -fillcolor => $shapeconf->{'-fillcolor'},
+	       -linewidth => $linewidth,
+	       -linecolor => $shapeconf->{'-linecolor'},
+	       );
+
+    my $pointconf = $builder{'-point'};
+    my $ptgroup = $zinc->add('group', $group, -alpha => $pointconf->{'-alpha'});
+    $zinc->coords($ptgroup,  $pointconf->{'-posi'});
+
+    @form_params = @{$pointconf->{'-geom'}};
+    # ombre portée
+    ($dx, $dy) = @{$pointconf->{'-shadow'}->{'-dxy'}};
+    $shadow_pts = $self->polyLine($dx, $dy, @form_params);
+    $zinc->add('curve', $ptgroup,
+	       $shadow_pts,
+	       -closed => 1,
+	       -filled => 1,
+	       -fillcolor => $pointconf->{'-shadow'}->{'-fillcolor'},
+	       -linewidth => 0,	
+	       );
+
+    my $pt_pts = $self->polyLine(0, 0, @form_params);  
+    $zinc->add('curve', $ptgroup,
+	       $pt_pts,
+	       -closed => 1,
+	       -filled => 1,
+	       -fillcolor => $pointconf->{'-fillcolor'},
+	       -linewidth => $pointconf->{'-linewidth'},
+	       -linecolor => $pointconf->{'-linecolor'},
+	       );
+    
+
+
+}
+
+sub polyLine {
+    my ($self, $x0, $y0, @faces) = @_;
+    my @pts = ();
+    my @previous = ($x0, $y0);
+    
+    return undef if (!defined @faces);
+	
+
+    foreach (@faces) {
+	my ($type, $dx, $dy, $angle, $extend, $astep) = @{$_}; 
+
+	if ($type eq 'moveto') {
+	    @previous = ($previous[0] + $dx, $previous[1] + $dy);
+	    
+	}  elsif ($type eq 'point') {
+	    push (@pts, ($dx, $dy));
+
+	} elsif ($type eq 'lineto') {
+	    @previous = ($previous[0] + $dx, $previous[1] + $dy);
+	    push (@pts, @previous);
+
+	} else {
+	    next if ($dx == 0 or $dy == 0);
+
+	    my $xc = $previous[0];
+	    my $yc = $previous[1];
+
+	    if ($dx == $dy) {
+		push (@pts, &arc_pts($xc, $yc, $dx, $angle, $extend, $astep));
+
+	    } else {
+		if ($dx > $dy) {
+		    my $z = $dy / $dx;
+		    push (@pts, &ove_pts($xc, $yc, $dx, $angle, $extend,
+					 $astep, $z, 'y'));
+		    
+
+		} else {
+		    my $z = $dx / $dy;
+		    push (@pts, &ove_pts($xc, $yc, $dy, $angle, $extend,
+					 $astep, $z, 'x'));
+		    
+
+		}
+
+	    }
+
+	    my $numpts = scalar(@pts);
+	    @previous = ($pts[$numpts - 2],$pts[$numpts - 1]); 
+	}
+    }
+
+    return \@pts;
+
+}
+
+
+# calcul des points constitutif d'un arc
+sub arc_pts {
+    my ($x, $y, $rad, $angle, $extent, $step, $debug) = @_;
+    my @pts = ();
+
+    
+    if ($extent > 0) {
+	for (my $alpha = $angle; $alpha <= ($angle + $extent); $alpha += $step) {
+	    #push (@pts, &rad_point($x, $y, $rad,$alpha));
+	    my ($xn, $yn) = &rad_point($x, $y, $rad,$alpha);
+	    push (@pts, ($xn, $yn));
+	    print "Graphics::arc_pts a:$alpha $step xn:$xn yn:$yn\n" if $debug;
+	}
+    } else {
+	for (my $alpha = $angle; $alpha >= ($angle + $extent); $alpha += $step) {
+	    push (@pts, &rad_point($x, $y, $rad,$alpha));
+	}
+    }
+
+    return @pts;
+}
+
+#calcul des points constitutif d'un arc d'ellipse (arc aplati)
+sub ove_pts {
+    my ($x, $y, $rad, $angle, $extent, $step, $z, $axe) = @_;
+    my @pts = ();
+    my @arcpts = ();
+
+    
+    my $maxangle = $extent + $step;
+    my ($cx, $cy);
+
+    if ($extent >= 0) {
+	for (my $alpha = $angle; $alpha <= ($angle + $extent); $alpha += $step) {
+	    push(@arcpts, &rad_point($x, $y, $rad, $alpha));
+
+	}
+
+    } else {
+	for (my $alpha = $angle; $alpha >= ($angle + $extent); $alpha += $step) {
+	    push(@arcpts, &rad_point($x, $y, $rad, $alpha));
+	}
+    }
+    
+    for (my $i = 0; $i < scalar(@arcpts); $i+=2) {
+	my ($zx, $zy) = ($arcpts[$i], $arcpts[$i+1]);
+
+	if ($axe eq 'y') {
+	    my $dy = ($zy - $y) * $z;
+	    $zy = $y + $dy;
+
+	} else {
+	    my $dx = ($zx - $x) * $z;
+	    $zx = $x + $dx;
+	}
+	
+	push (@pts, ($zx, $zy));
+    }
+
+    return @pts;
+}
+
+sub rad_point {
+    my ($x, $y, $rad, $angle) = @_;
+    my $alpha = deg2rad($angle);
+
+    my $xpt = $x + ($rad * cos($alpha));
+    my $ypt = $y + ($rad * sin($alpha));
+
+    return ($xpt, $ypt,); 
+}
+
+
+1;
+
+