[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Pastel / Geometry / GeneralPath.pm

#$Id: GeneralPath.pm,v 1.7 2003/04/22 16:28:12 malay Exp $

# Perl module for GeneralPath
# Author: Malay < curiouser@ccmb.res.in >
# Copyright Malay
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

=head1 NAME

GeneralPath - DESCRIPTION of Object

=head1 SYNOPSIS

Give standard usage here

=head1 DESCRIPTION

Describe the object here

=head1 CONTACT

Malay <curiouser@ccmb.ap.nic.in>

=cut

# Let the code begin...

package Pastel::Geometry::GeneralPath;
@ISA = qw(Pastel::Root Pastel::Shape);

use Pastel::Root;
use Pastel::Shape;
use Pastel::Geometry::PathIteratorI;
use Pastel::Geometry::Point;
use strict;
use Carp;

=head1 CONSTRUCTOR

=cut

# _init is where the heavy stuff will happen when new is called

# Some static constants

use constant WIND_EVEN_ODD => 'WIND_EVEN_ODD';
use constant WIND_NON_ZERO => 'WIND_NON_ZERO';
use constant SEG_MOVETO    => 'SEG_MOVETO';
use constant SEG_LINETO    => 'SEG_LINETO';
use constant SEG_QUADTO    => 'SEG_QUADTO';
use constant SEG_CUBICTO   => 'SEG_CUBICTO';
use constant SEG_CLOSE     => 'SEG_CLOSE';
use constant SEG_ARCTO     => 'SEG_ARCTO';

sub _init {
    my ( $self, @args ) = @_;
    my ( $rule, $shape ) = $self->_rearrange( [ 'RULE', 'SHAPE' ], @args );
    if ( defined($rule) && $rule eq 'WIND_EVEN_ODD' ) {
        $self->set_winding_rule('WIND_EVEN_ODD');
    }
    else {
        $self->set_winding_rule('WIND_NON_ZERO');    # Default winding rule
    }
    $self->{types}    = [];                          # Segment types
    $self->{coord}    = [];                          # xy coord of each point
    $self->{numtypes} = 0;                           # y coord of current point
    $self->{numcoord} = 0;
    $self->{arc_rotation} = 0;
    
    # set stuff in self from @args
    return $self;                                    # success - we hope!
}

sub get_winding_rule {
    my $self = shift;
    return $self->{wind};
}


sub set_winding_rule {
    my ( $self, $rule ) = @_;

    #print STDERR $rule;
    if ( ( $rule ne 'WIND_EVEN_ODD' ) && ( $rule ne 'WIND_NON_ZERO' ) ) {
        die
'Illegal parameter in Pastel::Geometry::GeneralPath::set_winding_rule()\n';
    }
    else {
        $self->{wind} = $rule;
        if ( $rule eq 'WIND_EVEN_ODD' ) {

            # default fill rule for SVG is nonzero
            $self->set_fill_rule('evenodd');    # inherited from Pastel::Shape
        }
    }
}

sub set_arc_rotation {
    my $self = shift;
    my $r = shift;
    if ($r){
	$self->{arc_rotation} = $r;
	
    }
}

sub get_arc_rotation {
    return $_[0]->{arc_rotation};
    
}
sub move_to {
    my ( $self, $x, $y ) = @_;
    push ( @{ $self->{types} }, SEG_MOVETO );
    push ( @{ $self->{coord} }, $x );
    push ( @{ $self->{coord} }, $y );
    $self->{numtypes}++;
    $self->{numcoord} += 2;
}

sub line_to {
    my ( $self, $x, $y ) = @_;
    push ( @{ $self->{types} }, SEG_LINETO );
    push ( @{ $self->{coord} }, $x );
    push ( @{ $self->{coord} }, $y );
    $self->{numtypes}++;
    $self->{numcoord} += 2;
}

sub quad_to {
    my $self  = shift;
    my @array = @_[ 0 .. 3 ];
    push ( @{ $self->{types} }, SEG_QUADTO );
    push ( @{ $self->{coord} }, @array );
    $self->{numtypes}++;
    $self->{numcoord} += 4;
}

sub curve_to {
    my $self  = shift;
    my @array = @_[ 0 .. 5 ];
    push ( @{ $self->{types} }, SEG_CUBICTO );
    push ( @{ $self->{coord} }, @array );
    $self->{numtypes}++;
    $self->{numcoord} += 6;
}

sub close_path {
    my $self = shift;
    push ( @{ $self->{types} }, SEG_CLOSE );
    $self->{numtypes}++;
}

sub arc_to {
    my $self = shift;
    push ( @{$self->{types} } , SEG_ARCTO );
    $self->{numtypes}++;
    push (@{$self->{coord}}, @_ );
    $self->{numcoord} += 6;
}
sub get_current_point {
    my $self = shift;
    if ( $self->{numtypes} < 1 || $self->{numcoord} < 2 ) {
        return undef;
    }
    my $index = $self->{numcoord};

    # If last point is a CLOSE PATH then go back to the beginning

    if ( $self->{types}[ $self->{numtypes} - 1 ] eq 'SEG_CLOSE' ) {
        for ( my $j = $self->{numtypes} - 2 ; $j > 0 ; $j-- ) {
            if ( $self->{types}[$j] eq 'SEG_MOVETO' ) {
                last;
            }
            elsif ( $self->{types}[$j] eq 'SEG_LINETO' ) {
                $index -= 2;
                next;
            }
            elsif ( $self->{types}[$j] eq 'SEG_QUADTO' ) {
                $index -= 4;
                next;
            }
            elsif ( $self->{types}[$j] eq 'SEG_CUBICTO' ) {
                $index -= 6;
                next;
            }
	    elsif ($self->{types}[$j] eq 'SEG_ARCTO' ){
		$index -= 6;
		
	    }
            elsif ( $self->{types}[$j] eq 'SEG_CLOSE' ) {
                last;
            }
        }
    }
    return Pastel::Geometry::Point->new(
        -x => $self->{coord}[ $index - 2 ],
        -y => $self->{coord}[ $index - 1 ]
    );

}

sub _draw {
    my $self     = shift;
    my $graphics = shift;
    my $s        = '<path d="';
    $s .= $self->to_svg();
    $s .= '" style="' . $self->get_style($graphics) . '" />';
    return $s;

}

sub to_svg {
    my $self  = shift;
    my $index = 0;
    my $s     = "";

    my $x = 0;    # holds the last x coordinate
    my $y = 0;    # holds the last y coordinate

    for ( my $i = 0 ; $i < $self->{numtypes} ; $i++ ) {
        if ( $self->{types}[$i] eq 'SEG_MOVETO' ) {
            $x = $self->{coord}[$index];
            $y = $self->{coord}[ $index + 1 ];
            $s .=
              'M' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
            $index += 2;
            next;
        }
        elsif ( $self->{types}[$i] eq 'SEG_LINETO' ) {
            if ( $self->{coord}[$index] == $x ) {
                $y = $self->{coord}[ $index + 1 ];
                $s .= 'V' . $y;
                $index += 2;
                next;
            }
            elsif ( $self->{coord}[ $index + 1 ] == $y ) {
                $x = $self->{coord}[$index];
                $s .= 'H' . $x;
                $index += 2;
                next;
            }
            else {
                $x = $self->{coord}[$index];
                $y = $self->{coord}[ $index + 1 ];
                $s .= 'L'
                  . $self->{coord}[$index] . " "
                  . $self->{coord}[ $index + 1 ];
                $index += 2;
                next;
            }
        }
        elsif ( $self->{types}[$i] eq 'SEG_QUADTO' ) {
            $x = $self->{coord}[ $index + 2 ];
            $y = $self->{coord}[ $index + 3 ];
            $s .=
              'Q' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
            $s .= " " . $x . " " . $y;
            $index += 4;
            next;
        }
        elsif ( $self->{types}[$i] eq 'SEG_CUBICTO' ) {
            $x = $self->{coord}[ $index + 4 ];
            $y = $self->{coord}[ $index + 5 ];
            $s .=
              'C' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
            $s .= " "
              . $self->{coord}[ $index + 2 ] . " "
              . $self->{coord}[ $index + 3 ];
            $s .= " " . $x . " " . $y;
            $index += 6;
            next;
        }
	elsif ($self->{types}[$i] eq 'SEG_ARCTO'){
	    $x = $self->{coord}[ $index + 4];
	    $y = $self->{coord}[ $index + 5];
	    $s .= 'A'.$self->{coord}[$index]." ".$self->{coord}[$index + 1];
	    $s .= " ".$self->get_arc_rotation()." ";
	    $s .= $self->{coord}[$index + 2];
	     $s .= " ".$self->{coord}[$index + 3];
	     $s .= " ".$x." ".$y;
	    $index += 6;
	    next;
	    
	    
	}
        elsif ( $self->{types}[$i] eq 'SEG_CLOSE' ) {
            $s .= 'z';
            next;
        }
    }

    return $s;
}

=head1 APPENDIX


=cut

1;
Commit	Line	Data
86530b38 AT	1	#$Id: GeneralPath.pm,v 1.7 2003/04/22 16:28:12 malay Exp $
	2
	3	# Perl module for GeneralPath
	4	# Author: Malay < curiouser@ccmb.res.in >
	5	# Copyright Malay
	6	# You may distribute this module under the same terms as perl itself
	7
	8	# POD documentation - main docs before the code
	9
	10	=head1 NAME
	11
	12	GeneralPath - DESCRIPTION of Object
	13
	14	=head1 SYNOPSIS
	15
	16	Give standard usage here
	17
	18	=head1 DESCRIPTION
	19
	20	Describe the object here
	21
	22	=head1 CONTACT
	23
	24	Malay <curiouser@ccmb.ap.nic.in>
	25
	26	=cut
	27
	28	# Let the code begin...
	29
	30	package Pastel::Geometry::GeneralPath;
	31	@ISA = qw(Pastel::Root Pastel::Shape);
	32
	33	use Pastel::Root;
	34	use Pastel::Shape;
	35	use Pastel::Geometry::PathIteratorI;
	36	use Pastel::Geometry::Point;
	37	use strict;
	38	use Carp;
	39
	40	=head1 CONSTRUCTOR
	41
	42	=cut
	43
	44	# _init is where the heavy stuff will happen when new is called
	45
	46	# Some static constants
	47
	48	use constant WIND_EVEN_ODD => 'WIND_EVEN_ODD';
	49	use constant WIND_NON_ZERO => 'WIND_NON_ZERO';
	50	use constant SEG_MOVETO => 'SEG_MOVETO';
	51	use constant SEG_LINETO => 'SEG_LINETO';
	52	use constant SEG_QUADTO => 'SEG_QUADTO';
	53	use constant SEG_CUBICTO => 'SEG_CUBICTO';
	54	use constant SEG_CLOSE => 'SEG_CLOSE';
	55	use constant SEG_ARCTO => 'SEG_ARCTO';
	56
	57	sub _init {
	58	my ( $self, @args ) = @_;
	59	my ( $rule, $shape ) = $self->_rearrange( [ 'RULE', 'SHAPE' ], @args );
	60	if ( defined($rule) && $rule eq 'WIND_EVEN_ODD' ) {
	61	$self->set_winding_rule('WIND_EVEN_ODD');
	62	}
	63	else {
	64	$self->set_winding_rule('WIND_NON_ZERO'); # Default winding rule
65	}
66	$self->{types} = []; # Segment types
67	$self->{coord} = []; # xy coord of each point
68	$self->{numtypes} = 0; # y coord of current point
69	$self->{numcoord} = 0;
70	$self->{arc_rotation} = 0;
71
72	# set stuff in self from @args
73	return $self; # success - we hope!
74	}
75
76	sub get_winding_rule {
77	my $self = shift;
78	return $self->{wind};
79	}
80
81
82	sub set_winding_rule {
83	my ( $self, $rule ) = @_;
84
85	#print STDERR $rule;
86	if ( ( $rule ne 'WIND_EVEN_ODD' ) && ( $rule ne 'WIND_NON_ZERO' ) ) {
87	die
88	'Illegal parameter in Pastel::Geometry::GeneralPath::set_winding_rule()\n';
89	}
90	else {
91	$self->{wind} = $rule;
92	if ( $rule eq 'WIND_EVEN_ODD' ) {
93
94	# default fill rule for SVG is nonzero
95	$self->set_fill_rule('evenodd'); # inherited from Pastel::Shape
96	}
97	}
98	}
99
100	sub set_arc_rotation {
101	my $self = shift;
102	my $r = shift;
103	if ($r){
104	$self->{arc_rotation} = $r;
105
106	}
107	}
108
109	sub get_arc_rotation {
110	return $_[0]->{arc_rotation};
111
112	}
113	sub move_to {
114	my ( $self, $x, $y ) = @_;
115	push ( @{ $self->{types} }, SEG_MOVETO );
116	push ( @{ $self->{coord} }, $x );
117	push ( @{ $self->{coord} }, $y );
118	$self->{numtypes}++;
119	$self->{numcoord} += 2;
120	}
121
122	sub line_to {
123	my ( $self, $x, $y ) = @_;
124	push ( @{ $self->{types} }, SEG_LINETO );
125	push ( @{ $self->{coord} }, $x );
126	push ( @{ $self->{coord} }, $y );
127	$self->{numtypes}++;
128	$self->{numcoord} += 2;
129	}
130
131	sub quad_to {
132	my $self = shift;
133	my @array = @_[ 0 .. 3 ];
134	push ( @{ $self->{types} }, SEG_QUADTO );
135	push ( @{ $self->{coord} }, @array );
136	$self->{numtypes}++;
137	$self->{numcoord} += 4;
138	}
139
140	sub curve_to {
141	my $self = shift;
142	my @array = @_[ 0 .. 5 ];
143	push ( @{ $self->{types} }, SEG_CUBICTO );
144	push ( @{ $self->{coord} }, @array );
145	$self->{numtypes}++;
146	$self->{numcoord} += 6;
147	}
148
149	sub close_path {
150	my $self = shift;
151	push ( @{ $self->{types} }, SEG_CLOSE );
152	$self->{numtypes}++;
153	}
154
155	sub arc_to {
156	my $self = shift;
157	push ( @{$self->{types} } , SEG_ARCTO );
158	$self->{numtypes}++;
159	push (@{$self->{coord}}, @_ );
160	$self->{numcoord} += 6;
161	}
162	sub get_current_point {
163	my $self = shift;
164	if ( $self->{numtypes} < 1 \|\| $self->{numcoord} < 2 ) {
165	return undef;
166	}
167	my $index = $self->{numcoord};
168
169	# If last point is a CLOSE PATH then go back to the beginning
170
171	if ( $self->{types}[ $self->{numtypes} - 1 ] eq 'SEG_CLOSE' ) {
172	for ( my $j = $self->{numtypes} - 2 ; $j > 0 ; $j-- ) {
173	if ( $self->{types}[$j] eq 'SEG_MOVETO' ) {
174	last;
175	}
176	elsif ( $self->{types}[$j] eq 'SEG_LINETO' ) {
177	$index -= 2;
178	next;
179	}
180	elsif ( $self->{types}[$j] eq 'SEG_QUADTO' ) {
181	$index -= 4;
182	next;
183	}
184	elsif ( $self->{types}[$j] eq 'SEG_CUBICTO' ) {
185	$index -= 6;
186	next;
187	}
188	elsif ($self->{types}[$j] eq 'SEG_ARCTO' ){
189	$index -= 6;
190
191	}
192	elsif ( $self->{types}[$j] eq 'SEG_CLOSE' ) {
193	last;
194	}
195	}
196	}
197	return Pastel::Geometry::Point->new(
198	-x => $self->{coord}[ $index - 2 ],
199	-y => $self->{coord}[ $index - 1 ]
200	);
201
202	}
203
204	sub _draw {
205	my $self = shift;
206	my $graphics = shift;
207	my $s = '<path d="';
208	$s .= $self->to_svg();
209	$s .= '" style="' . $self->get_style($graphics) . '" />';
210	return $s;
211
212	}
213
214	sub to_svg {
215	my $self = shift;
216	my $index = 0;
217	my $s = "";
218
219	my $x = 0; # holds the last x coordinate
220	my $y = 0; # holds the last y coordinate
221
222	for ( my $i = 0 ; $i < $self->{numtypes} ; $i++ ) {
223	if ( $self->{types}[$i] eq 'SEG_MOVETO' ) {
224	$x = $self->{coord}[$index];
225	$y = $self->{coord}[ $index + 1 ];
226	$s .=
227	'M' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
228	$index += 2;
229	next;
230	}
231	elsif ( $self->{types}[$i] eq 'SEG_LINETO' ) {
232	if ( $self->{coord}[$index] == $x ) {
233	$y = $self->{coord}[ $index + 1 ];
234	$s .= 'V' . $y;
235	$index += 2;
236	next;
237	}
238	elsif ( $self->{coord}[ $index + 1 ] == $y ) {
239	$x = $self->{coord}[$index];
240	$s .= 'H' . $x;
241	$index += 2;
242	next;
243	}
244	else {
245	$x = $self->{coord}[$index];
246	$y = $self->{coord}[ $index + 1 ];
247	$s .= 'L'
248	. $self->{coord}[$index] . " "
249	. $self->{coord}[ $index + 1 ];
250	$index += 2;
251	next;
252	}
253	}
254	elsif ( $self->{types}[$i] eq 'SEG_QUADTO' ) {
255	$x = $self->{coord}[ $index + 2 ];
256	$y = $self->{coord}[ $index + 3 ];
257	$s .=
258	'Q' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
259	$s .= " " . $x . " " . $y;
260	$index += 4;
261	next;
262	}
263	elsif ( $self->{types}[$i] eq 'SEG_CUBICTO' ) {
264	$x = $self->{coord}[ $index + 4 ];
265	$y = $self->{coord}[ $index + 5 ];
266	$s .=
267	'C' . $self->{coord}[$index] . " " . $self->{coord}[ $index + 1 ];
268	$s .= " "
269	. $self->{coord}[ $index + 2 ] . " "
270	. $self->{coord}[ $index + 3 ];
271	$s .= " " . $x . " " . $y;
272	$index += 6;
273	next;
274	}
275	elsif ($self->{types}[$i] eq 'SEG_ARCTO'){
276	$x = $self->{coord}[ $index + 4];
277	$y = $self->{coord}[ $index + 5];
278	$s .= 'A'.$self->{coord}[$index]." ".$self->{coord}[$index + 1];
279	$s .= " ".$self->get_arc_rotation()." ";
280	$s .= $self->{coord}[$index + 2];
281	$s .= " ".$self->{coord}[$index + 3];
282	$s .= " ".$x." ".$y;
283	$index += 6;
284	next;
285
286
287	}
288	elsif ( $self->{types}[$i] eq 'SEG_CLOSE' ) {
289	$s .= 'z';
290	next;
291	}
292	}
293
294	return $s;
295	}
296
297	=head1 APPENDIX
298
299
300
301	=cut
302
303	1;