[system] / trunk / pg / lib / Circle.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/Circle.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1079 - (view) (download) (as text)

1 : sh002i 1050
2 : apizer 1079
3 : sh002i 1050 =head1 NAME
4 :    
5 :     Circle
6 :    
7 :     =head1 SYNPOSIS
8 :    
9 :     use Carp;
10 :     use GD;
11 :     use WWPlot;
12 :     use Fun;
13 :    
14 :    
15 :     =head1 DESCRIPTION
16 :    
17 :     This module defines a circle which can be inserted as a stamp in a graph (WWPlot) object.
18 :    
19 :     =head2 Command:
20 :    
21 :     $circle_object = new Circle( $center_pos_x, $center_pos_y, $radius, $border_color, $fill_color);
22 :    
23 :    
24 : apizer 1079 =head2 Examples:
25 :    
26 :     Here is the code used to define the subroutines open_circle
27 : sh002i 1050 and closed_circle in PGgraphmacros.pl
28 : apizer 1079
29 : sh002i 1050 sub open_circle {
30 :     my ($cx,$cy,$color) = @_;
31 :     new Circle ($cx, $cy, 4,$color,'nearwhite');
32 :     }
33 :    
34 :     sub closed_circle {
35 :     my ($cx,$cy, $color) = @_;
36 :     $color = 'black' unless defined $color;
37 :     new Circle ($cx, $cy, 4,$color, $color);
38 :     }
39 : apizer 1079
40 : sh002i 1050 $circle_object2 = closed_circle( $x_position, $y_position, $color );
41 :    
42 : apizer 1079 @circle_objects = $graph -> stamps($circle_object2);
43 : sh002i 1050 # puts a filled dot at ($x_position, $y_position) on the graph -- using real world coordinates.
44 :    
45 :     =cut
46 :    
47 :    
48 :     BEGIN {
49 :     be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
50 :     }
51 :    
52 :     package Circle;
53 :    
54 :    
55 :    
56 :     #use WWPlot;
57 :     #Because of the way problem modules are loaded 'use' is disabled.
58 :    
59 :     #use strict;
60 :     #use vars qw($AUTOLOAD @ISA);
61 :     @Circle::ISA = qw(WWPlot);
62 :    
63 :     my %fields =(
64 :     colors => {},
65 :     border_color => 0,
66 :     fill_color => 1,
67 :     radius => 8,
68 :     );
69 :    
70 :    
71 :     sub new {
72 :     my $class = shift;
73 :     my $cx = shift;
74 :     my $cy = shift;
75 :     my $radius = shift; # radius is in pixels, others are in real world coordinates
76 :     my $border_color = shift;
77 :     my $fill_color = shift;
78 :     $radius =4 unless defined $radius;
79 :     $border_color = 'black' unless defined($border_color);
80 :     $fill_color = 'black' unless defined($fill_color);
81 : apizer 1079
82 : sh002i 1050 my $self = { im => new GD::Image(2*$radius, 2*$radius),
83 : apizer 1079
84 : sh002i 1050 cx => $cx,
85 :     cy => $cy,
86 :     radius => $radius,
87 :     border_color => $border_color,
88 :     fill_color => $fill_color,
89 : apizer 1079
90 : sh002i 1050 };
91 : apizer 1079
92 : sh002i 1050 bless $self, $class;
93 :     $self -> _initialize_colors;
94 :     if (defined($self->{'colors'}{$border_color} ) ) {
95 : apizer 1079 $self->{'border_color'} = $self->{'colors'}{$border_color};
96 : sh002i 1050 } else {
97 :     $self->{'border_color'} = 'default_color';
98 :     }
99 :     if (defined($self->{'colors'}{$fill_color} ) ) {
100 : apizer 1079 $self->{'fill_color'} = $self->{'colors'}{$fill_color};
101 : sh002i 1050 } else {
102 :     $self->{'fill_color'} = 'nearwhite';
103 :     }
104 : apizer 1079 $self->im->transparent($self->{'colors'}{'background_color'});
105 : sh002i 1050 $self->im->arc($radius,$radius,2*$radius,2*$radius,0,360,$self->{'border_color'} );
106 :     $self->im->fill($radius,$radius,$self->{'fill_color'});
107 :     return $self;
108 :     }
109 :    
110 :     sub _initialize_colors {
111 :     my $self = shift;
112 :     # allocate some colors
113 :     $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255);
114 :     $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0);
115 :     $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255);
116 :     $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0);
117 : apizer 1079 $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0);
118 : sh002i 1050 $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0);
119 :     $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255);
120 :     $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0);
121 :     $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0);
122 :     $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180);
123 :     $self->{'colors'}{'nearwhite'} = $self->im->colorAllocate(254,254,254);
124 : apizer 1079
125 : sh002i 1050 }
126 :    
127 :     sub size {
128 :     my $s = shift;
129 :     (2*$s->{radius}, 2*$s->{radius});
130 :     }
131 :     sub height{
132 :     my $s = shift;
133 :     2*$s->{radius};
134 :     }
135 :     sub width {
136 :     my $s = shift;
137 :     2*$s->{radius};
138 :     }
139 :     sub radius {
140 :     my $s = shift;
141 :     $s->{radius};
142 :     }
143 :     sub x {
144 :     my $s = shift;
145 :     $s->{cx};
146 :     }
147 :     sub y {
148 :     my $s = shift;
149 :     $s->{cy};
150 :     }
151 :     sub image {
152 :     my $s = shift;
153 :     $s->{im};
154 :     }
155 :    
156 :     sub draw{
157 :     my $self = shift;
158 :     my $g = shift; # the enclosing graph object
159 :     my $x = $self->x;
160 :     my $y = $self->y;
161 :     my $image = $self->image;
162 :     my $height = $self->height;
163 :     my $width = $self->width;
164 :     $g->im->copy($image,
165 :     ($g->ii($x)) - int($width/2),
166 :     ($g->jj($y)) - int($height/2),
167 :     0, 0, $width, $height);
168 : apizer 1079 }
169 : sh002i 1050 sub DESTROY {
170 :     # doing nothing about destruction, hope that isn't dangerous
171 :     }
172 :    
173 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9