View of /trunk/webwork/system/courseScripts/Label.pm

    1 =head1 NAME
    2 
    3   Label
    4 
    5 
    6 =head1 SYNPOSIS
    7 
    8   use Carp;
    9   use GD;
   10   use WWPlot;
   11   use Fun;
   12 
   13 
   14 =head1 DESCRIPTION
   15 
   16 This module defines labels for the graph objects (WWPlot).
   17 
   18 
   19 =head2 Usage
   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'
   25 
   26 
   27 
   28 =head2  Example
   29 
   30   $new_label = new Label ( 0,0, 'origin','red','left', 'top')
   31   @labels    = $graph->lb($new_label);
   32 
   33 
   34 
   35 =cut
   36 
   37 
   38 BEGIN {
   39   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
   40 }
   41 package Label;
   42 use strict;
   43 #use Exporter;
   44 #use DynaLoader;
   45 #use GD;   # this is needed to be able to define GD::gdMediumBoldFont and other terms used by GD
   46 #          # however  constants from GD need to be addressed fully, they have not been imported.
   47 #use  "WWPlot.pm";
   48 #Because of the way problem modules are loaded 'use' is disabled.
   49 
   50 
   51 @Label::ISA = qw(WWPlot);
   52 
   53 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,
   62 );
   63 
   64 
   65 sub new {
   66   my $class         = shift;
   67   my $self      = {
   68         _permitted  =>  \%fields,
   69         %fields,
   70   };
   71 
   72   bless $self, $class;
   73   $self->_initialize(@_);
   74   return $self;
   75 }
   76 
   77 sub _initialize {
   78   my $self        = shift;
   79   my ($x,$y,$str,$color,@justification) =   @_;
   80   $self -> x($x);
   81   $self -> y($y);
   82   $self -> str($str);
   83   $self -> color($color) if defined($color);
   84   my $j;
   85   foreach $j (@justification)  {
   86     $self->lr_nudge( - length($self->str) )   if $j eq 'right';
   87     $self->tb_nudge( - 1            )   if $j eq 'bottom';
   88     $self->lr_nudge( - ( length($self->str) )/2)if $j eq 'center';
   89     $self->tb_nudge(-0.5)                     if $j eq 'middle';
   90 #   print "\njustification=$j",$self->lr_nudge,$self->tb_nudge,"\n";
   91   }
   92 }
   93 sub draw {
   94   my $self = shift;
   95   my $g = shift;   #the containing graph
   96     $g->im->string( $self->font,
   97             $g->ii($self->x)+int( $self->lr_nudge*($self->font->width) ),
   98             $g->jj($self->y)+int( $self->tb_nudge*($self->font->height) ),
   99             $self->str,
  100             ${$g->colors}{$self->color}
  101           );
  102 
  103 }
  104 
  105 sub AUTOLOAD {
  106   my $self = shift;
  107   my $type = ref($self) || die "$self is not an object";
  108   my $name = $Label::AUTOLOAD;
  109   $name =~ s/.*://;  # strip fully-qualified portion
  110   unless (exists $self->{'_permitted'}->{$name} ) {
  111     die "Can't find '$name' field in object of class $type";
  112   }
  113   if (@_) {
  114     return $self->{$name} = shift;
  115   } else {
  116     return $self->{$name};
  117   }
  118 
  119 }
  120 
  121 sub DESTROY {
  122   # doing nothing about destruction, hope that isn't dangerous
  123 }
  124 
  125 1;
  126 
  127 
  128