From adbd1635174a8dbb652acc90c551934a801f2789 Mon Sep 17 00:00:00 2001 From: mertz Date: Wed, 13 Mar 2002 16:14:15 +0000 Subject: initial release --- Perl/debug/LogoZinc.pm | 324 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 Perl/debug/LogoZinc.pm (limited to 'Perl/debug') 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 +# $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; + + -- cgit v1.1