Parent Directory
| 
Revision Log
Merging changes gage branch gage_dev/pg removed dependence on AUTOLOAD which does not work well with newer versions of Safe.pm. It wasn't needed in any case. There remain other incompatibilies of WeBWorK with Safe.pm 2.27 Added more support for WARN_MESSAGE and DEBUG_MESSAGE Changed List.pm to ChoiceList.pm to remove confusion with MathObjects List object Additional support for geogebra applets
1 2 3 =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 =head2 Examples: 25 26 Here is the code used to define the subroutines open_circle 27 and closed_circle in PGgraphmacros.pl 28 29 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 40 $circle_object2 = closed_circle( $x_position, $y_position, $color ); 41 42 @circle_objects = $graph -> stamps($circle_object2); 43 # 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 @Circle::ISA = qw(WWPlot); 61 62 # my %fields =( 63 # colors => {}, 64 # border_color => 0, 65 # fill_color => 1, 66 # radius => 8, 67 # ); 68 69 70 sub new { 71 my $class = shift; 72 my $cx = shift; 73 my $cy = shift; 74 my $radius = shift; # radius is in pixels, others are in real world coordinates 75 my $border_color = shift; 76 my $fill_color = shift; 77 $radius =4 unless defined $radius; 78 $border_color = 'black' unless defined($border_color); 79 $fill_color = 'black' unless defined($fill_color); 80 81 my $self = { im => new GD::Image(2*$radius, 2*$radius), 82 cx => $cx, 83 cy => $cy, 84 radius => $radius, 85 border_color => $border_color, 86 fill_color => $fill_color, 87 88 }; 89 90 bless $self, $class; 91 $self -> _initialize_colors; 92 if (defined($self->{'colors'}{$border_color} ) ) { 93 $self->{'border_color'} = $self->{'colors'}{$border_color}; 94 } else { 95 $self->{'border_color'} = 'default_color'; 96 } 97 if (defined($self->{'colors'}{$fill_color} ) ) { 98 $self->{'fill_color'} = $self->{'colors'}{$fill_color}; 99 } else { 100 $self->{'fill_color'} = 'nearwhite'; 101 } 102 $self->im->transparent($self->{'colors'}{'background_color'}); 103 $self->im->arc($radius,$radius,2*$radius,2*$radius,0,360,$self->{'border_color'} ); 104 $self->im->fill($radius,$radius,$self->{'fill_color'}); 105 return $self; 106 } 107 108 sub _initialize_colors { 109 my $self = shift; 110 # allocate some colors 111 $self->{'colors'}{'background_color'} = $self->im->colorAllocate(255,255,255); 112 $self->{'colors'}{'default_color'} = $self->im->colorAllocate(0,0,0); 113 $self->{'colors'}{'white'} = $self->im->colorAllocate(255,255,255); 114 $self->{'colors'}{'black'} = $self->im->colorAllocate(0,0,0); 115 $self->{'colors'}{'red'} = $self->im->colorAllocate(255,0,0); 116 $self->{'colors'}{'green'} = $self->im->colorAllocate(0,255,0); 117 $self->{'colors'}{'blue'} = $self->im->colorAllocate(0,0,255); 118 $self->{'colors'}{'yellow'} = $self->im->colorAllocate(255,255,0); 119 $self->{'colors'}{'orange'} = $self->im->colorAllocate(255,100,0); 120 $self->{'colors'}{'gray'} = $self->im->colorAllocate(180,180,180); 121 $self->{'colors'}{'nearwhite'} = $self->im->colorAllocate(254,254,254); 122 123 } 124 125 126 ########################## 127 # Access methods -- Get only??? should this be changed? 128 ########################## 129 sub size { 130 my $s = shift; 131 (2*$s->{radius}, 2*$s->{radius}); 132 } 133 sub height{ 134 my $s = shift; 135 2*$s->{radius}; 136 } 137 sub width { 138 my $s = shift; 139 2*$s->{radius}; 140 } 141 sub radius { 142 my $s = shift; 143 $s->{radius}; 144 } 145 sub x { 146 my $s = shift; 147 $s->{cx}; 148 } 149 sub y { 150 my $s = shift; 151 $s->{cy}; 152 } 153 sub image { 154 my $s = shift; 155 $s->{im}; 156 } 157 158 ########################## 159 # Access methods -- Get and Set 160 ########################## 161 162 163 sub colors { 164 my $self = shift; 165 my $type = ref($self) || die "$self is not an object"; 166 unless (exists $self->{colors} ) { 167 die "Can't find colors field in object of class $type"; 168 } 169 170 if (@_) { 171 return $self->{colors} = shift; 172 } else { 173 return $self->{colors} 174 } 175 } 176 177 sub border_color { 178 my $self = shift; 179 my $type = ref($self) || die "$self is not an object"; 180 unless (exists $self->{border_color} ) { 181 die "Can't find border_color field in object of class $type"; 182 } 183 184 if (@_) { 185 return $self->{border_color} = shift; 186 } else { 187 return $self->{border_color} 188 } 189 } 190 191 sub fill_color { 192 my $self = shift; 193 my $type = ref($self) || die "$self is not an object"; 194 unless (exists $self->{fill_color} ) { 195 die "Can't find fill_color field in object of class $type"; 196 } 197 198 if (@_) { 199 return $self->{fill_color} = shift; 200 } else { 201 return $self->{fill_color} 202 } 203 } 204 205 206 sub draw{ 207 my $self = shift; 208 my $g = shift; # the enclosing graph object 209 my $x = $self->x; 210 my $y = $self->y; 211 my $image = $self->image; 212 my $height = $self->height; 213 my $width = $self->width; 214 $g->im->copy($image, 215 ($g->ii($x)) - int($width/2), 216 ($g->jj($y)) - int($height/2), 217 0, 0, $width, $height); 218 } 219 sub DESTROY { 220 # doing nothing about destruction, hope that isn't dangerous 221 } 222 223 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |