#!/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(-66 -66', -shadow => {-dxy => [5, 5], -fillcolor => '#770000:64 0|#770000:70 78|#770000:0 100[-50 -50', }, }, ); 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, -tags => ['letters'], -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, -tags => ['point'], -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 ($#faces == -1); 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;