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

View of /trunk/pg/lib/Fun.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1079 - (download) (as text) (annotate)
Mon Jun 9 17:36:12 2003 UTC (16 years, 8 months ago) by apizer
File size: 9050 byte(s)
removed unneccesary shebang lines

    1 
    2 
    3 #  Fun.pm
    4 # methods:
    5 #   new Fun($rule,$graphRef)
    6 #     If $rule is a subroutine then a function object is created,
    7 #        with default data. If the graphRef is present the function is
    8 #       installed into the
    9 #   graph and the domain is reset to the graphRef's domain.
   10 #     If the $rule is another function object then a copy of that function is
   11 #     made with all of its data  and it is installed in the graphRef if that is present.
   12 #   In this case the domain of the function is not affected by the domain of the graphRef.
   13 #   initial data
   14 #     @domain = ($tstart, $tstop)   the domain of the function      -- initially (-1,1)
   15 #     steps             the number of steps in drawing  -- initially 20
   16 #     color             the pen color to draw with    -- initially 'red'
   17 #   weight              the width of the pen in pixels  --  initially 2
   18 #     rule              reference to a subroutine
   19 #                       which calculates the function -- initially null
   20 #     graph             reference to the enclosing graph  -- initially $ref or else null
   21 
   22 # What will the domain of new Fun($rule, $graphRef) be?
   23 #     It will be the same as $rule if $rule is actually another function object
   24 #         ELSE      the same as the domain of $graphRef if that is present
   25 #         ELSE    the interval (-1,1)
   26 #   public access methods:
   27 #     domain
   28 #     steps
   29 #     color
   30 #     rule
   31 #   weight
   32 ;
   33 
   34 =head1 NAME
   35 
   36   Fun
   37 
   38 =head1 SYNPOSIS
   39 
   40   use Carp;
   41   use GD;
   42   use WWPlot;
   43   use Fun;
   44   $fn = new Fun( rule_reference);
   45   $fn = new Fun( rule_reference , graph_reference);
   46   $fn = new Fun ( x_rule_ref, y_rule_ref );
   47   $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
   48 
   49 =head1 DESCRIPTION
   50 
   51 This module defines a parametric or non-parametric function object.  The function object is designed to
   52 be inserted into a graph object defined by WWPlot.
   53 
   54 The following functions are provided:
   55 
   56 
   57 
   58 =head2  new  (non-parametric version)
   59 
   60 =over 4
   61 
   62 =item $fn = new Fun( rule_reference);
   63 
   64 rule_reference is a reference to a subroutine which accepts a numerical value and returns a numerical value.
   65 The Fun object will draw the graph associated with this subroutine.
   66 For example: $rule = sub { my $x= shift; $x**2};  will produce a plot of the x squared.
   67 The new method returns a reference to the function object.
   68 
   69 =item $fn = new Fun( rule_reference , graph_reference);
   70 
   71 The function is also placed into the printing queue of the graph object pointed to by graph_reference and the
   72 domain of the function object is set to the domain of the graph.
   73 
   74 =back
   75 
   76 =head2  new  (parametric version)
   77 
   78 =over 4
   79 
   80 =item $fn = new Fun ( x_rule_ref, y_rule_ref );
   81 
   82 A parametric function object is created where the subroutines refered to by x_rule_ref and y_rule_ref define
   83 the x and y outputs in terms of the input t.
   84 
   85 =item $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref );
   86 
   87 This variant inserts the parametric function object into the graph object referred to by graph_ref.  The domain
   88 of the function object is not adjusted.  The domain's default value is (-1, 1).
   89 
   90 =back
   91 
   92 =head2 Properites
   93 
   94   All of the properties are set using the construction $new_value = $fn->property($new_value)
   95   and read using $current_value = $fn->property()
   96 
   97 =over 4
   98 
   99 =item tstart, tstop, steps
  100 
  101 The domain of the function is (tstart, tstop).  steps is the number of subintervals
  102 used in graphing the function.
  103 
  104 =item color
  105 
  106 The color used to draw the function is specified by a word such as 'orange' or 'yellow'.
  107 C<$fn->color('blue')> sets the drawing color to blue.  The RGB values for the color are defined in the graph
  108 object in which the function is drawn.  If the color, e.g. 'mauve', is not defined by the graph object
  109 then the function is drawn using the color 'default_color' which is always defined (and usually black).
  110 
  111 =item x_rule
  112 
  113 A reference to the subroutine used to calculate the x value of the graph.  This is set to the identity function (x = t )
  114 when using the function object in non-parametric mode.
  115 
  116 =item y_rule
  117 
  118 A reference to the subroutine used to calculate the y value of the graph.
  119 
  120 =item weight
  121 
  122 The width in pixels of the pen used to draw the graph. The pen is square.
  123 
  124 =back
  125 
  126 =head2 Actions which affect more than one property.
  127 
  128 =over 4
  129 
  130 =item rule
  131 
  132 This defines a non-parametric function.
  133 
  134   $fn->rule(sub {my $x =shift; $x**2;} )
  135 
  136   is equivalent to
  137 
  138   $fn->x_rule(sub {my $x = shift; $x;});
  139   $fn->y_rule(sub {my $x = shift; $x**2;);
  140 
  141   $fn->rule() returns the reference to the y_rule.
  142 
  143 =item domain
  144 
  145 $array_ref = $fn->domain(-1,1) sets tstart to -1 and tstop to 1 and
  146 returns a reference to an array containing this pair of numbers.
  147 
  148 
  149 =item draw
  150 
  151 $fn->draw($graph_ref) draws the function in the graph object pointed to by $graph_ref. If one of
  152 the points bounding a subinterval is undefined then that segment is not drawn.  This usually does the "right thing" for
  153 functions which have simple singularities.
  154 
  155 The graph object must
  156 respond to the methods below.  The draw call is mainly for internal use by the graph object. Most users will not
  157 call it directly.
  158 
  159 =over 4
  160 
  161 =item   $graph_ref->{colors}
  162 
  163 a hash containing the defined colors
  164 
  165 =item $graph_ref ->im
  166 
  167 a GD image object
  168 
  169 =item $graph_ref->lineTo(x,y, color_number)
  170 
  171 draw line to the point (x,y) from the current position using the specified color.  To obtain the color number
  172 use a construction such as C<$color_number = $graph_ref->{colors}{'blue'};>
  173 
  174 =item $graph_ref->lineTo(x,y,gdBrushed)
  175 
  176 draw line to the point (x,y) using the pattern set by SetBrushed (see GD documentation)
  177 
  178 =item $graph_ref->moveTo(x,y)
  179 
  180 set the current position to (x,y)
  181 
  182 =back
  183 
  184 =back
  185 
  186 =cut
  187 
  188 BEGIN {
  189   be_strict(); # an alias for use strict.  This means that all global variable must contain main:: as a prefix.
  190 }
  191 
  192 package Fun;
  193 
  194 
  195 #use "WWPlot.pm";
  196 #Because of the way problem modules are loaded 'use' is disabled.
  197 
  198 
  199 
  200 
  201 
  202 @Fun::ISA = qw(WWPlot);
  203 # import gdBrushed from GD.  It unclear why, but a good many global methods haven't been imported.
  204 sub gdBrushed {
  205   &GD::gdBrushed();
  206 }
  207 
  208 my $GRAPH_REFERENCE = "WWPlot";
  209 my $FUNCTION_REFERENCE = "Fun";
  210 
  211 my %fields =(
  212     tstart    =>  -1,  # (tstart,$tstop) constitutes the domain
  213     tstop   =>  1,
  214     steps     =>  50,
  215     color   =>  'blue',
  216     x_rule      => \&identity,
  217     y_rule      => \&identity,
  218     weight    =>  2,  # line thickness
  219 );
  220 
  221 
  222 sub new {
  223   my $class         = shift;
  224 # my ($rule,$graphRef)  =   @_;
  225 
  226   my $self      = {
  227         _permitted  =>  \%fields,
  228         %fields,
  229   };
  230 
  231   bless $self, $class;
  232   $self -> _initialize(@_);
  233   return $self;
  234 }
  235 
  236 sub identity {  # the identity function
  237   shift;
  238 }
  239 sub rule  { # non-parametric functions are defined using rule; use x_rule and y_rule to define parametric functions
  240   my $self = shift;
  241   my $rule = shift;
  242   my $out;
  243   if ( defined($rule)  ){
  244     $self->x_rule (\&identity);
  245     $self->y_rule($rule);
  246     $out = $self->y_rule;
  247   } else {
  248     $out = $self->y_rule
  249   }
  250   $out;
  251 }
  252 
  253 sub _initialize {
  254   my  $self   =   shift;
  255   my  ($xrule,$yrule, $rule,$graphRef);
  256   my @input = @_;
  257   if (ref($input[$#input]) eq $GRAPH_REFERENCE ) {
  258     $graphRef = pop @input;  # get the last argument if it refers to a graph.
  259     $graphRef->fn($self);     # Install this function in the graph.
  260   }
  261 
  262     if ( @input == 1 ) {                 # only one argument left -- this is a non parametric function
  263         $rule = $input[0];
  264     if ( ref($rule) eq $FUNCTION_REFERENCE ) {  # clone another function
  265       my $k;
  266       foreach $k (keys %fields) {
  267         $self->{$k} = $rule->{$k};
  268       }
  269     } else {
  270       $self->rule($rule);
  271       if (ref($graphRef) eq $GRAPH_REFERENCE) { # use graph to initialize domain
  272         $self->domain($graphRef->xmin,$graphRef->xmax);
  273       }
  274     }
  275   } elsif (@input == 2 ) {   #  two arguments -- parametric functions
  276       $self->x_rule($input[0]);
  277       $self->y_rule($input[1]);
  278 
  279   } else {
  280     wwerror("$0:Fun.pm:_initialize:", "Can't call function with more than two arguments", "");
  281   }
  282 
  283 }
  284 
  285 sub draw {
  286     my $self = shift;  # this function
  287   my $g = shift;   # the graph containing the function.
  288   my $color;   # get color scheme from graph
  289   if ( defined( $g->{'colors'}{$self->color} )  ) {
  290     $color = $g->{'colors'}{$self->color};
  291   } else {
  292     $color = $g->{'colors'}{'default_color'};  # what you do if the color isn't there
  293   }
  294   my $brush = new GD::Image($self->weight,$self->weight);
  295   my $brush_color = $brush->colorAllocate($g->im->rgb($color));  # transfer color
  296   $g->im->setBrush($brush);
  297   my $stepsize = ( $self->tstop - $self->tstart )/$self->steps;
  298 
  299     my ($t,$x,$i,$y);
  300     my $x_prev = undef;
  301     my $y_prev = undef;
  302     foreach $i (0..$self->steps) {
  303         $t=$stepsize*$i + $self->tstart;
  304         $x=&{$self->x_rule}( $t );;
  305         $y=&{$self->y_rule}( $t );
  306         if (defined($x) && defined($x_prev) && defined($y) && defined($y_prev) ) {
  307           $g->lineTo($x, $y, gdBrushed);
  308         } else {
  309           $g->moveTo($x, $y) if defined($x) && defined($y);
  310         }
  311         $x_prev = $x;
  312         $y_prev = $y;
  313     }
  314 }
  315 
  316 sub domain {
  317   my $self =shift;
  318   my $tstart = shift;
  319   my $tstop  = shift;
  320   if (defined($tstart) && defined($tstop) ) {
  321     $self->tstart($tstart);
  322     $self->tstop($tstop);
  323   }
  324     [$self->tstart,$self->tstop];
  325 }
  326 
  327 
  328 sub DESTROY {
  329   # doing nothing about destruction, hope that isn't dangerous
  330 }
  331 
  332 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9