@@ -18,14 +18,18 @@ This module defines labels for the graph objects (WWPlot).
18
18
19
19
=head2 Usage
20
20
21
- $label1 = new Label($x_value, $y_value, $label_string, $label_color, @justification)
22
- $justification = one of ('left', 'center', 'right) and ('bottom', 'center', 'top')
23
- describes the position of the ($x_value, $y_value) within the string.
24
- The default is 'left', 'top'
21
+ $label1 = new Label($x_value, $y_value, $label_string, $label_color, @options)
22
+ $options is an array with (*'d defaults)
23
+ - one of 'left'*, 'center', 'right' (horizontal alignment)
24
+ - one of 'bottom', 'center', 'top'* (verical alignment)
25
+ - one of 'horizontal'*, 'vertical' (orientation)
26
+ - one of 'small', 'large', 'mediumbold'*, 'tiny', 'giant' (which gd font to use)
27
+ Note the alignment specifications are relative to the English reading of the string,
28
+ even when the orientation is vertical.
25
29
26
30
27
31
28
- =head2 Example
32
+ =head2 Example:
29
33
30
34
$new_label = new Label ( 0,0, 'origin','red','left', 'top')
31
35
@labels = $graph->lb($new_label);
@@ -51,14 +55,15 @@ use strict;
51
55
@Label::ISA = qw( WWPlot) ;
52
56
53
57
my %fields =(
54
- ' x' => 0,
55
- ' y' => 0,
56
- color => ' black' ,
57
- font => GD::gdMediumBoldFont, # gdLargeFont
58
- # constants from GD need to be addressed fully, they have not been imported.
59
- str => " " ,
60
- lr_nudge => 0, # justification parameters
61
- tb_nudge => 0,
58
+ ' x' => 0,
59
+ ' y' => 0,
60
+ color => ' black' ,
61
+ font => GD::gdMediumBoldFont, # gdLargeFont
62
+ # constants from GD need to be addressed fully, they have not been imported.
63
+ str => " " ,
64
+ lr_nudge => 0, # justification parameters
65
+ tb_nudge => 0,
66
+ orientation => ' horizontal' ,
62
67
);
63
68
64
69
@@ -74,31 +79,46 @@ sub new {
74
79
}
75
80
76
81
sub _initialize {
77
- my $self = shift ;
78
- my ($x ,$y ,$str ,$color ,@justification ) = @_ ;
79
- $self -> x($x );
80
- $self -> y ($y );
81
- $self -> str($str );
82
- $self -> color($color ) if defined ($color );
83
- my $j ;
84
- foreach $j (@justification ) {
85
- $self -> lr_nudge( - length ($self -> str) ) if $j eq ' right' ;
86
- $self -> tb_nudge( - 1 ) if $j eq ' bottom' ;
87
- $self -> lr_nudge( - ( length ($self -> str) )/2)if $j eq ' center' ;
88
- $self -> tb_nudge(-0.5) if $j eq ' middle' ;
89
- # print "\njustification=$j",$self->lr_nudge,$self->tb_nudge,"\n";
90
- }
82
+ my $self = shift ;
83
+ my ($x ,$y ,$str ,$color ,@justification ) = @_ ;
84
+ $self -> x($x );
85
+ $self -> y ($y );
86
+ $self -> str($str );
87
+ $self -> color($color ) if defined ($color );
88
+ my $j ;
89
+ foreach $j (@justification ) {
90
+ if ($j eq ' right' ) {$self -> lr_nudge( - length ($self -> str) ); }
91
+ elsif ($j eq ' bottom' ) {$self -> tb_nudge( - 1 ); }
92
+ elsif ($j eq ' center' ) {$self -> lr_nudge( - ( length ($self -> str) )/2); }
93
+ elsif ($j eq ' middle' ) {$self -> tb_nudge(-0.5); }
94
+ elsif ($j eq ' vertical' ) {$self -> orientation($j ); }
95
+ # there are only five avialble fonts: http://search.cpan.org/~rurban/GD-2.68/lib/GD.pm#Font_Utilities
96
+ elsif ($j eq ' small' ) {$self -> font(GD::gdSmallFont); }
97
+ elsif ($j eq ' large' ) {$self -> font(GD::gdLargeFont); }
98
+ elsif ($j eq ' tiny' ) {$self -> font(GD::gdTinyFont); }
99
+ elsif ($j eq ' giant' ) {$self -> font(GD::gdGiantFont); }
100
+ }
91
101
}
92
102
sub draw {
93
- my $self = shift ;
94
- my $g = shift ; # the containing graph
95
- $g -> im-> string( $self -> font,
96
- $g -> ii($self -> x)+int ( $self -> lr_nudge*($self -> font-> width) ),
97
- $g -> jj($self -> y ) +int( $self->tb_nudge*($self->font->height) ) ,
98
- $self -> str,
99
- ${$g -> colors}{$self -> color}
100
- );
101
-
103
+ my $self = shift ;
104
+ my $g = shift ; # the containing graph
105
+ if ($self -> orientation eq ' horizontal' ) {
106
+ $g -> im-> string( $self -> font,
107
+ $g -> ii($self -> x)+int ( $self -> lr_nudge*($self -> font-> width) ),
108
+ $g -> jj($self -> y ) +int( $self->tb_nudge*($self->font->height) ) ,
109
+ $self -> str,
110
+ ${$g -> colors}{$self -> color}
111
+ );
112
+ }
113
+ elsif ($self -> orientation eq ' vertical' ) {
114
+ $g -> im-> stringUp( $self -> font,
115
+ $g -> ii($self -> x)+int ( $self -> tb_nudge*($self -> font-> height) ),
116
+ $g -> jj($self -> y ) -int( $self->lr_nudge*($self->font->width) ) ,
117
+ $self -> str,
118
+ ${$g -> colors}{$self -> color}
119
+ );
120
+
121
+ }
102
122
}
103
123
104
124
sub AUTOLOAD {
@@ -214,6 +234,22 @@ sub tb_nudge {
214
234
return $self -> {tb_nudge }
215
235
}
216
236
}
237
+
238
+ sub orientation {
239
+ my $self = shift ;
240
+ my $type = ref ($self ) || die " $self is not an object" ;
241
+ unless (exists $self -> {orientation } ) {
242
+ die " Can't find orientation field in object of class $type " ;
243
+ }
244
+
245
+ if (@_ ) {
246
+ return $self -> {orientation } = shift ;
247
+ } else {
248
+ return $self -> {orientation }
249
+ }
250
+ }
251
+
252
+
217
253
sub DESTROY {
218
254
# doing nothing about destruction, hope that isn't dangerous
219
255
}
0 commit comments