aboutsummaryrefslogtreecommitdiff
path: root/Perl/debug/LogoZinc.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/debug/LogoZinc.pm')
-rw-r--r--Perl/debug/LogoZinc.pm324
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;
+
+
generated by cgit v1.1 at 2024-11-03 01:14:05 +0000