loncom/xml/lonplot.pm - view

File: [LON-CAPA] / loncom / xml / lonplot.pm
Revision 1.51: download - view: text, annotated - select for diffs
Wed Feb 27 22:10:23 2002 UTC (22 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

First stab at printing.  I don't guarantee printing works yet, but at least
$target eq 'web' will work.  Note: The only place information is returned
to the parser is in &end_gnuplot, for both 'web' and 'tex' targets.  For
$target eq 'tex' the name of the eps file is returned.  Currently this file
is not actually created, but that'll be fixed in the next commit.  Trust me.

1: # The LearningOnline Network with CAPA 2: # Dynamic plot 3: # 4: # $Id: lonplot.pm,v 1.51 2002/02/27 22:10:23 matthew Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # 12/15/01 Matthew 29: # 12/17 12/18 12/19 12/20 12/21 12/27 12/28 12/30 12/31 Matthew 30: # 01/01/02 Matthew 31: # 01/02 01/03 01/04 01/07 01/08 01/09 Matthew 32: # 01/21 02/05 02/06 Matthew 33: 34: package Apache::lonplot; 35: 36: use strict; 37: use Apache::File; 38: use Apache::response; 39: use Apache::lonxml; 40: use Apache::edit; 41: 42: BEGIN { 43: &Apache::lonxml::register('Apache::lonplot',('gnuplot')); 44: } 45: 46: ## 47: ## Description of data structures: 48: ## 49: ## %plot %key %axis 50: ## -------------------------- 51: ## height title color 52: ## width box xmin 53: ## bgcolor pos xmax 54: ## fgcolor ymin 55: ## transparent ymax 56: ## grid 57: ## border 58: ## font 59: ## align 60: ## 61: ## @labels: $labels[$i] = \%label 62: ## %label: text, xpos, ypos, justify 63: ## 64: ## @curves: $curves[$i] = \%curve 65: ## %curve: name, linestyle, ( function | data ) 66: ## 67: ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], 68: ## [y1,y2,y3,y4] ] 69: ## 70: 71: ################################################################### 72: ## ## 73: ## Tests used in checking the validitity of input ## 74: ## ## 75: ################################################################### 76: 77: my $max_str_len = 50; # if a label, title, xlabel, or ylabel text 78: # is longer than this, it will be truncated. 79: 80: my %linestyles = 81: ( 82: lines => 2, # Maybe this will be used in the future 83: linespoints => 2, # to check on whether or not they have 84: dots => 2, # supplied enough <data></data> fields 85: points => 2, # to use the given line style. But for 86: steps => 2, # now there are more important things 87: fsteps => 2, # for me to deal with. 88: histeps => 2, 89: errorbars => 3, 90: xerrorbars => [3,4], 91: yerrorbars => [3,4], 92: xyerrorbars => [4,6], 93: boxes => 3, 94: # boxerrorbars => [3,4,5], 95: # boxxyerrorbars => [4,6,7], 96: # financebars => 5, 97: # candlesticks => 5, 98: vector => 4 99: ); 100: 101: my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; 102: my $real_test = 103: sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; 104: my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/}; 105: my $onoff_test = sub {$_[0]=~/^(on|off)$/}; 106: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/}; 107: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; 108: my $linestyle_test = sub {exists($linestyles{$_[0]})}; 109: my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w]+ ?)+$/}; 110: 111: ################################################################### 112: ## ## 113: ## Attribute metadata ## 114: ## ## 115: ################################################################### 116: my @gnuplot_edit_order = 117: qw/bgcolor fgcolor height width font transparent grid border align/; 118: 119: my $gnuplot_help_text = <<"ENDPLOTHELP"; 120: 121: The gnuplot tag allows an author to design a plot which can 122: be created on the fly. This is intended for use in homework problems 123: where each student needs to see a distinct plot. It can be used in 124: conjunction with a script tag to generate random plots. 125: 126: A gnuplot tag can contain the following sub-tags: 127: 128: <dl> 129: <dt> Plot Label 130: <dd> Allows you to place text at a given (x,y) coordinate on the plot. 131: <dt> Plot Title 132: <dd> The title of the plot 133: <dt> Plot Xlabel 134: <dd> The label on the horizontal axis of the plot 135: <dt> Plot Ylabel 136: <dd> The label on the vertical axis of the plot 137: <dt> Plot Axes 138: <dd> allows specification of the x and y ranges displayed in the plot 139: <dt> Plot Key 140: <dd> Lists the functions displayed in the plot. 141: <dt> Plot Curve 142: <dd> Sets the data used in the plot. 143: <dt> Plot Tics 144: <dd> Allows specification of the x and y coordinate 'tics' on the axes. 145: This is mostly used to adjust the grid lines when a grid is displayed. 146: </dl> 147: ENDPLOTHELP 148: 149: my %gnuplot_defaults = 150: ( 151: height => { 152: default => 200, 153: test => $int_test, 154: description => 'height of image (pixels)', 155: edit_type => 'entry', 156: size => '10' 157: }, 158: width => { 159: default => 200, 160: test => $int_test, 161: description => 'width of image (pixels)', 162: edit_type => 'entry', 163: size => '10' 164: }, 165: bgcolor => { 166: default => 'xffffff', 167: test => $color_test, 168: description => 'background color of image (xffffff)', 169: edit_type => 'entry', 170: size => '10' 171: }, 172: fgcolor => { 173: default => 'x000000', 174: test => $color_test, 175: description => 'foreground color of image (x000000)', 176: edit_type => 'entry', 177: size => '10' 178: }, 179: transparent => { 180: default => 'off', 181: test => $onoff_test, 182: description => 'Transparent image', 183: edit_type => 'onoff' 184: }, 185: grid => { 186: default => 'off', 187: test => $onoff_test, 188: description => 'Display grid', 189: edit_type => 'onoff' 190: }, 191: border => { 192: default => 'on', 193: test => $onoff_test, 194: description => 'Draw border around plot', 195: edit_type => 'onoff' 196: }, 197: font => { 198: default => 'medium', 199: test => $sml_test, 200: description => 'Size of font to use', 201: edit_type => 'choice', 202: choices => ['small','medium','large'] 203: }, 204: align => { 205: default => 'left', 206: test => sub {$_[0]=~/^(left|right|center)$/}, 207: description => 'alignment for image in html', 208: edit_type => 'choice', 209: choices => ['left','right','center'] 210: } 211: ); 212: 213: my %key_defaults = 214: ( 215: title => { 216: default => '', 217: test => $words_test, 218: description => 'Title of key', 219: edit_type => 'entry', 220: size => '40' 221: }, 222: box => { 223: default => 'off', 224: test => $onoff_test, 225: description => 'Draw a box around the key?', 226: edit_type => 'onoff' 227: }, 228: pos => { 229: default => 'top right', 230: test => $key_pos_test, 231: description => 'position of the key on the plot', 232: edit_type => 'choice', 233: choices => ['top left','top right','bottom left','bottom right', 234: 'outside','below'] 235: } 236: ); 237: 238: my %label_defaults = 239: ( 240: xpos => { 241: default => 0, 242: test => $real_test, 243: description => 'x position of label (graph coordinates)', 244: edit_type => 'entry', 245: size => '10' 246: }, 247: ypos => { 248: default => 0, 249: test => $real_test, 250: description => 'y position of label (graph coordinates)', 251: edit_type => 'entry', 252: size => '10' 253: }, 254: justify => { 255: default => 'left', 256: test => sub {$_[0]=~/^(left|right|center)$/}, 257: description => 'justification of the label text on the plot', 258: edit_type => 'choice', 259: choices => ['left','right','center'] 260: } 261: ); 262: 263: my @tic_edit_order = ('location','mirror','start','increment','end'); 264: my %tic_defaults = 265: ( 266: location => { 267: default => 'border', 268: test => sub {$_[0]=~/^(border|axis)$/}, 269: description => 'Location of tick marks', 270: edit_type => 'choice', 271: choices => ['border','axis'] 272: }, 273: mirror => { 274: default => 'on', 275: test => $onoff_test, 276: description => 'mirror ticks on opposite axis?', 277: edit_type => 'onoff' 278: }, 279: start => { 280: default => '-10.0', 281: test => $real_test, 282: description => 'Start ticks at', 283: edit_type => 'entry', 284: size => '10' 285: }, 286: increment => { 287: default => '1.0', 288: test => $real_test, 289: description => 'Place a tick every', 290: edit_type => 'entry', 291: size => '10' 292: }, 293: end => { 294: default => ' 10.0', 295: test => $real_test, 296: description => 'Stop ticks at ', 297: edit_type => 'entry', 298: size => '10' 299: }, 300: ); 301: 302: my %axis_defaults = 303: ( 304: color => { 305: default => 'x000000', 306: test => $color_test, 307: description => 'color of axes (x000000)', 308: edit_type => 'entry', 309: size => '10' 310: }, 311: xmin => { 312: default => '-10.0', 313: test => $real_test, 314: description => 'minimum x-value shown in plot', 315: edit_type => 'entry', 316: size => '10' 317: }, 318: xmax => { 319: default => ' 10.0', 320: test => $real_test, 321: description => 'maximum x-value shown in plot', 322: edit_type => 'entry', 323: size => '10' 324: }, 325: ymin => { 326: default => '-10.0', 327: test => $real_test, 328: description => 'minimum y-value shown in plot', 329: edit_type => 'entry', 330: size => '10' 331: }, 332: ymax => { 333: default => ' 10.0', 334: test => $real_test, 335: description => 'maximum y-value shown in plot', 336: edit_type => 'entry', 337: size => '10' 338: } 339: ); 340: 341: my $curve_help_text = <<"ENDCURVEHELP"; 342: The curve tag is where you set the data to be plotted by gnuplot. 343: There are two ways of entering the information: 344: <dl> 345: <dt> Curve Data 346: <dd> Using a data tag you can specify the numbers used to produce 347: the plot. 348: 349: By default, two data tags will be available in a plot. The 350: first will specify X coordinates of the data and the second will 351: give the Y coordinates of the data. When working with a linestyle that 352: requires more than two data sets, inserting another data tag is 353: required. Unfortunately, you must make sure the data tags appear 354: in the order gnuplot expects the data. 355: 356: Specifying the data should usually be done with a perl variable or array, 357: such as \@Xdata and \@Ydata. You may also specify numerical data seperated 358: by commas. Again, the order of the data tags is important. The 359: first tag will be the X data and the second will be the Y data. 360: 361: <dt> Curve Function 362: <dd> The function tag allows you to specify the curve to be 363: plotted as a formula that gnuplot can understand. Be careful using this 364: tag - it is surprisingly easy to give gnuplot a function it cannot deal 365: with properly. Be explicit: 2*sin(2*3.141592*x/4) will work but 366: 2sin(2*3.141592x/4) will not. If you do not receive any errors in the 367: gnuplot data but still do not have an image produced, it is likely there 368: is an error in your function tag. 369: </dl> 370: ENDCURVEHELP 371: 372: my %curve_defaults = 373: ( 374: color => { 375: default => 'x000000', 376: test => $color_test, 377: description => 'color of curve (x000000)', 378: edit_type => 'entry', 379: size => '10' 380: }, 381: name => { 382: default => '', 383: test => $words_test, 384: description => 'name of curve to appear in key', 385: edit_type => 'entry', 386: size => '20' 387: }, 388: linestyle => { 389: default => 'lines', 390: test => $linestyle_test, 391: description => 'Line style', 392: edit_type => 'choice', 393: choices => [keys(%linestyles)] 394: } 395: ); 396: 397: ################################################################### 398: ## ## 399: ## parsing and edit rendering ## 400: ## ## 401: ################################################################### 402: my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); 403: 404: sub start_gnuplot { 405: %plot = (); %key = (); %axis = (); 406: $title = undef; $xlabel = undef; $ylabel = undef; 407: $#labels = -1; $#curves = -1; 408: %xtics = (); %ytics = (); 409: # 410: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 411: my $result=''; 412: &Apache::lonxml::register('Apache::lonplot', 413: ('title','xlabel','ylabel','key','axis','label','curve', 414: 'xtics','ytics')); 415: push (@Apache::lonxml::namespace,'lonplot'); 416: if ($target eq 'web' || $target eq 'tex') { 417: my $inside = &Apache::lonxml::get_all_text("/gnuplot",$$parser[-1]); 418: $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); 419: &Apache::lonxml::newparser($parser,\$inside); 420: &get_attributes(\%plot,\%gnuplot_defaults,$parstack,$safeeval, 421: $tagstack->[-1]); 422: } elsif ($target eq 'edit') { 423: $result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); 424: $result .= &make_javascript(); 425: $result .= &help_win($gnuplot_help_text); 426: $result .= &edit_attributes($target,$token,\%gnuplot_defaults, 427: \@gnuplot_edit_order); 428: } elsif ($target eq 'modified') { 429: my $constructtag=&Apache::edit::get_new_args 430: ($token,$parstack,$safeeval,keys(%gnuplot_defaults)); 431: if ($constructtag) { 432: $result = &Apache::edit::rebuild_tag($token); 433: } 434: } 435: return $result; 436: } 437: 438: sub end_gnuplot { 439: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 440: pop @Apache::lonxml::namespace; 441: &Apache::lonxml::deregister('Apache::lonplot', 442: ('title','xlabel','ylabel','key','axis','label','curve')); 443: my $result = ''; 444: if ($target eq 'web' || $target eq 'tex') { 445: &check_inputs(); # Make sure we have all the data we need 446: ## 447: ## Determine filename 448: my $tmpdir = '/home/httpd/perl/tmp/'; 449: my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}. 450: '_'.time.'_'.$$.int(rand(1000)).'_plot.data'; 451: ## Write the plot description to the file 452: &write_gnuplot_file($tmpdir,$filename,$target); 453: ## return image tag for the plot 454: if ($target eq 'web') { 455: $result .= <<"ENDIMAGE"; 456: <img src = "/cgi-bin/plot.gif?$filename" 457: width = "$plot{'width'}" 458: height = "$plot{'height'}" 459: align = "$plot{'align'}" 460: alt = "image should be /cgi-bin/plot.gif?$filename" /> 461: ENDIMAGE 462: } elsif ($target eq 'tex') { 463: $result = "$filename.eps"; 464: } 465: } elsif ($target eq 'edit') { 466: $result.=&Apache::edit::tag_end($target,$token); 467: } 468: return $result; 469: } 470: 471: 472: ##--------------------------------------------------------------- xtics 473: sub start_xtics { 474: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 475: my $result=''; 476: if ($target eq 'web' || $target eq 'tex') { 477: &get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval, 478: $tagstack->[-1]); 479: } elsif ($target eq 'edit') { 480: $result .= &Apache::edit::tag_start($target,$token,'xtics'); 481: $result .= &edit_attributes($target,$token,\%tic_defaults, 482: \@tic_edit_order); 483: } elsif ($target eq 'modified') { 484: my $constructtag=&Apache::edit::get_new_args 485: ($token,$parstack,$safeeval,keys(%tic_defaults)); 486: if ($constructtag) { 487: $result = &Apache::edit::rebuild_tag($token); 488: } 489: } 490: return $result; 491: } 492: 493: sub end_xtics { 494: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 495: my $result = ''; 496: if ($target eq 'web' || $target eq 'tex') { 497: } elsif ($target eq 'edit') { 498: $result.=&Apache::edit::tag_end($target,$token); 499: } 500: return $result; 501: } 502: 503: ##--------------------------------------------------------------- ytics 504: sub start_ytics { 505: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 506: my $result=''; 507: if ($target eq 'web' || $target eq 'tex') { 508: &get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval, 509: $tagstack->[-1]); 510: } elsif ($target eq 'edit') { 511: $result .= &Apache::edit::tag_start($target,$token,'ytics'); 512: $result .= &edit_attributes($target,$token,\%tic_defaults, 513: \@tic_edit_order); 514: } elsif ($target eq 'modified') { 515: my $constructtag=&Apache::edit::get_new_args 516: ($token,$parstack,$safeeval,keys(%tic_defaults)); 517: if ($constructtag) { 518: $result = &Apache::edit::rebuild_tag($token); 519: } 520: } 521: return $result; 522: } 523: 524: sub end_ytics { 525: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 526: my $result = ''; 527: if ($target eq 'web' || $target eq 'tex') { 528: } elsif ($target eq 'edit') { 529: $result.=&Apache::edit::tag_end($target,$token); 530: } 531: return $result; 532: } 533: 534: 535: ##----------------------------------------------------------------- key 536: sub start_key { 537: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 538: my $result=''; 539: if ($target eq 'web' || $target eq 'tex') { 540: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, 541: $tagstack->[-1]); 542: } elsif ($target eq 'edit') { 543: $result .= &Apache::edit::tag_start($target,$token,'Plot Key'); 544: $result .= &edit_attributes($target,$token,\%key_defaults); 545: } elsif ($target eq 'modified') { 546: my $constructtag=&Apache::edit::get_new_args 547: ($token,$parstack,$safeeval,keys(%key_defaults)); 548: if ($constructtag) { 549: $result = &Apache::edit::rebuild_tag($token); 550: } 551: } 552: return $result; 553: } 554: 555: sub end_key { 556: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 557: my $result = ''; 558: if ($target eq 'web' || $target eq 'tex') { 559: } elsif ($target eq 'edit') { 560: $result.=&Apache::edit::tag_end($target,$token); 561: } 562: return $result; 563: } 564: 565: ##------------------------------------------------------------------- title 566: sub start_title { 567: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 568: my $result=''; 569: if ($target eq 'web' || $target eq 'tex') { 570: $title = &Apache::lonxml::get_all_text("/title",$$parser[-1]); 571: $title =~ s/\n/ /g; 572: if (length($title) > $max_str_len) { 573: $title = substr($title,0,$max_str_len); 574: } 575: } elsif ($target eq 'edit') { 576: $result.=&Apache::edit::tag_start($target,$token,'Plot Title'); 577: my $text=&Apache::lonxml::get_all_text("/title",$$parser[-1]); 578: $result.=&Apache::edit::end_row(). 579: &Apache::edit::start_spanning_row(). 580: &Apache::edit::editfield('',$text,'',60,1); 581: } elsif ($target eq 'modified') { 582: my $text=$$parser[-1]->get_text("/title"); 583: $result.=&Apache::edit::rebuild_tag($token); 584: $result.=&Apache::edit::modifiedfield($token); 585: } 586: return $result; 587: } 588: 589: sub end_title { 590: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 591: my $result = ''; 592: if ($target eq 'web' || $target eq 'tex') { 593: } elsif ($target eq 'edit') { 594: $result.=&Apache::edit::tag_end($target,$token); 595: } 596: return $result; 597: } 598: ##------------------------------------------------------------------- xlabel 599: sub start_xlabel { 600: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 601: my $result=''; 602: if ($target eq 'web' || $target eq 'tex') { 603: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); 604: $xlabel =~ s/\n/ /g; 605: if (length($xlabel) > $max_str_len) { 606: $xlabel = substr($xlabel,0,$max_str_len); 607: } 608: } elsif ($target eq 'edit') { 609: $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel'); 610: my $text=&Apache::lonxml::get_all_text("/xlabel",$$parser[-1]); 611: $result.=&Apache::edit::end_row(). 612: &Apache::edit::start_spanning_row(). 613: &Apache::edit::editfield('',$text,'',60,1); 614: } elsif ($target eq 'modified') { 615: my $text=$$parser[-1]->get_text("/xlabel"); 616: $result.=&Apache::edit::rebuild_tag($token); 617: $result.=&Apache::edit::modifiedfield($token); 618: } 619: return $result; 620: } 621: 622: sub end_xlabel { 623: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 624: my $result = ''; 625: if ($target eq 'web' || $target eq 'tex') { 626: } elsif ($target eq 'edit') { 627: $result.=&Apache::edit::tag_end($target,$token); 628: } 629: return $result; 630: } 631: 632: ##------------------------------------------------------------------- ylabel 633: sub start_ylabel { 634: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 635: my $result=''; 636: if ($target eq 'web' || $target eq 'tex') { 637: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); 638: $ylabel =~ s/\n/ /g; 639: if (length($ylabel) > $max_str_len) { 640: $ylabel = substr($ylabel,0,$max_str_len); 641: } 642: } elsif ($target eq 'edit') { 643: $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel'); 644: my $text = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]); 645: $result .= &Apache::edit::end_row(). 646: &Apache::edit::start_spanning_row(). 647: &Apache::edit::editfield('',$text,'',60,1); 648: } elsif ($target eq 'modified') { 649: my $text=$$parser[-1]->get_text("/ylabel"); 650: $result.=&Apache::edit::rebuild_tag($token); 651: $result.=&Apache::edit::modifiedfield($token); 652: } 653: return $result; 654: } 655: 656: sub end_ylabel { 657: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 658: my $result = ''; 659: if ($target eq 'web' || $target eq 'tex') { 660: } elsif ($target eq 'edit') { 661: $result.=&Apache::edit::tag_end($target,$token); 662: } 663: return $result; 664: } 665: 666: ##------------------------------------------------------------------- label 667: sub start_label { 668: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 669: my $result=''; 670: if ($target eq 'web' || $target eq 'tex') { 671: my %label; 672: &get_attributes(\%label,\%label_defaults,$parstack,$safeeval, 673: $tagstack->[-1]); 674: my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); 675: $text =~ s/\n/ /g; 676: $text = substr($text,0,$max_str_len) if (length($text) > $max_str_len); 677: $label{'text'} = $text; 678: push(@labels,\%label); 679: } elsif ($target eq 'edit') { 680: $result .= &Apache::edit::tag_start($target,$token,'Plot Label'); 681: $result .= &edit_attributes($target,$token,\%label_defaults); 682: my $text = &Apache::lonxml::get_all_text("/label",$$parser[-1]); 683: $result .= &Apache::edit::end_row(). 684: &Apache::edit::start_spanning_row(). 685: &Apache::edit::editfield('',$text,'',60,1); 686: } elsif ($target eq 'modified') { 687: &Apache::edit::get_new_args 688: ($token,$parstack,$safeeval,keys(%label_defaults)); 689: $result.=&Apache::edit::rebuild_tag($token); 690: my $text=$$parser[-1]->get_text("/label"); 691: $result.=&Apache::edit::modifiedfield($token); 692: } 693: return $result; 694: } 695: 696: sub end_label { 697: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 698: my $result = ''; 699: if ($target eq 'web' || $target eq 'tex') { 700: } elsif ($target eq 'edit') { 701: $result.=&Apache::edit::tag_end($target,$token); 702: } 703: return $result; 704: } 705: 706: ##------------------------------------------------------------------- curve 707: sub start_curve { 708: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 709: my $result=''; 710: &Apache::lonxml::register('Apache::lonplot',('function','data')); 711: push (@Apache::lonxml::namespace,'curve'); 712: if ($target eq 'web' || $target eq 'tex') { 713: my %curve; 714: &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, 715: $tagstack->[-1]); 716: push (@curves,\%curve); 717: } elsif ($target eq 'edit') { 718: $result .= &Apache::edit::tag_start($target,$token,'Curve'); 719: $result .= &help_win($curve_help_text); 720: $result .= &edit_attributes($target,$token,\%curve_defaults); 721: } elsif ($target eq 'modified') { 722: my $constructtag=&Apache::edit::get_new_args 723: ($token,$parstack,$safeeval,keys(%curve_defaults)); 724: if ($constructtag) { 725: $result = &Apache::edit::rebuild_tag($token); 726: $result.= &Apache::edit::handle_insert(); 727: } 728: } 729: return $result; 730: } 731: 732: sub end_curve { 733: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 734: my $result = ''; 735: pop @Apache::lonxml::namespace; 736: &Apache::lonxml::deregister('Apache::lonplot',('function','data')); 737: if ($target eq 'web' || $target eq 'tex') { 738: } elsif ($target eq 'edit') { 739: $result.=&Apache::edit::tag_end($target,$token); 740: } 741: return $result; 742: } 743: 744: ##------------------------------------------------------------ curve function 745: sub start_function { 746: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 747: my $result=''; 748: if ($target eq 'web' || $target eq 'tex') { 749: if (exists($curves[-1]->{'data'})) { 750: &Apache::lonxml::warning('Use of <function> precludes use of <data>. The <data> will be omitted in favor of the <function> declaration.'); 751: delete $curves[-1]->{'data'} ; 752: } 753: $curves[-1]->{'function'} = 754: &Apache::lonxml::get_all_text("/function",$$parser[-1]); 755: } elsif ($target eq 'edit') { 756: $result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); 757: my $text = &Apache::lonxml::get_all_text("/function",$$parser[-1]); 758: $result .= &Apache::edit::end_row(). 759: &Apache::edit::start_spanning_row(). 760: &Apache::edit::editfield('',$text,'',60,1); 761: } elsif ($target eq 'modified') { 762: $result.=&Apache::edit::rebuild_tag($token); 763: my $text=$$parser[-1]->get_text("/function"); 764: $result.=&Apache::edit::modifiedfield($token); 765: } 766: return $result; 767: } 768: 769: sub end_function { 770: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 771: my $result = ''; 772: if ($target eq 'web' || $target eq 'tex') { 773: } elsif ($target eq 'edit') { 774: $result .= &Apache::edit::end_table(); 775: } 776: return $result; 777: } 778: 779: ##------------------------------------------------------------ curve data 780: sub start_data { 781: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 782: my $result=''; 783: if ($target eq 'web' || $target eq 'tex') { 784: if (exists($curves[-1]->{'function'})) { 785: &Apache::lonxml::warning('Use of <data> precludes use of .'. 786: '<function>. The <function> will be omitted in favor of '. 787: 'the <data> declaration.'); 788: delete($curves[-1]->{'function'}); 789: } 790: my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); 791: # Deal with cases where we're given an array... 792: if ($datatext =~ /^\@/) { 793: $datatext = &Apache::run::run('return "'.$datatext.'"', 794: $safeeval,1); 795: } 796: $datatext =~ s/\s+/ /g; 797: # Need to do some error checking on the @data array - 798: # make sure it's all numbers and make sure each array 799: # is of the same length. 800: my @data; 801: if ($datatext =~ /,/) { # comma deliminated 802: @data = split /,/,$datatext; 803: } else { # Assume it's space seperated. 804: @data = split / /,$datatext; 805: } 806: for (my $i=0;$i<=$#data;$i++) { 807: # Check that it's non-empty 808: if (! defined($data[$i])) { 809: &Apache::lonxml::warning( 810: 'undefined <data> value. Replacing with '. 811: ' pi/e = 1.15572734979092'); 812: $data[$i] = 1.15572734979092; 813: } 814: # Check that it's a number 815: if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) { 816: &Apache::lonxml::warning( 817: 'Bad <data> value of '.$data[$i].' Replacing with '. 818: ' pi/e = 1.15572734979092'); 819: $data[$i] = 1.15572734979092; 820: } 821: } 822: # complain if the number of data points is not the same as 823: # in previous sets of data. 824: if (($curves[-1]->{'data'}) && ($#data != $#{@{$curves[-1]->{'data'}->[0]}})){ 825: &Apache::lonxml::warning 826: ('Number of data points is not consistent with previous '. 827: 'number of data points'); 828: } 829: push @{$curves[-1]->{'data'}},\@data; 830: } elsif ($target eq 'edit') { 831: $result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data'); 832: my $text = &Apache::lonxml::get_all_text("/data",$$parser[-1]); 833: $result .= &Apache::edit::end_row(). 834: &Apache::edit::start_spanning_row(). 835: &Apache::edit::editfield('',$text,'',60,1); 836: } elsif ($target eq 'modified') { 837: $result.=&Apache::edit::rebuild_tag($token); 838: my $text=$$parser[-1]->get_text("/data"); 839: $result.=&Apache::edit::modifiedfield($token); 840: } 841: return $result; 842: } 843: 844: sub end_data { 845: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 846: my $result = ''; 847: if ($target eq 'web' || $target eq 'tex') { 848: } elsif ($target eq 'edit') { 849: $result .= &Apache::edit::end_table(); 850: } 851: return $result; 852: } 853: 854: ##------------------------------------------------------------------- axis 855: sub start_axis { 856: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 857: my $result=''; 858: if ($target eq 'web' || $target eq 'tex') { 859: &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, 860: $tagstack->[-1]); 861: } elsif ($target eq 'edit') { 862: $result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); 863: $result .= &edit_attributes($target,$token,\%axis_defaults); 864: } elsif ($target eq 'modified') { 865: my $constructtag=&Apache::edit::get_new_args 866: ($token,$parstack,$safeeval,keys(%axis_defaults)); 867: if ($constructtag) { 868: $result = &Apache::edit::rebuild_tag($token); 869: } 870: } 871: return $result; 872: } 873: 874: sub end_axis { 875: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 876: my $result = ''; 877: if ($target eq 'web' || $target eq 'tex') { 878: } elsif ($target eq 'edit') { 879: $result.=&Apache::edit::tag_end($target,$token); 880: } elsif ($target eq 'modified') { 881: } 882: return $result; 883: } 884: 885: ################################################################### 886: ## ## 887: ## Utility Functions ## 888: ## ## 889: ################################################################### 890: 891: ##----------------------------------------------------------- set_defaults 892: sub set_defaults { 893: my ($var,$defaults) = @_; 894: my $key; 895: foreach $key (keys(%$defaults)) { 896: $var->{$key} = $defaults->{$key}->{'default'}; 897: } 898: } 899: 900: ##------------------------------------------------------------------- misc 901: sub get_attributes{ 902: my ($values,$defaults,$parstack,$safeeval,$tag) = @_; 903: foreach my $attr (keys(%{$defaults})) { 904: $values->{$attr} = 905: &Apache::lonxml::get_param($attr,$parstack,$safeeval); 906: if ($values->{$attr} eq '' | !defined($values->{$attr})) { 907: $values->{$attr} = $defaults->{$attr}->{'default'}; 908: next; 909: } 910: my $test = $defaults->{$attr}->{'test'}; 911: if (! &$test($values->{$attr})) { 912: &Apache::lonxml::warning 913: ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' 914: .$defaults->{$attr}->{'default'} ); 915: $values->{$attr} = $defaults->{$attr}->{'default'}; 916: } 917: } 918: return ; 919: } 920: 921: ##------------------------------------------------------- write_gnuplot_file 922: sub write_gnuplot_file { 923: my ($tmpdir,$filename,$target)= @_; 924: my $gnuplot_input = ''; 925: my $curve; 926: # Collect all the colors 927: my @Colors; 928: push @Colors, $plot{'bgcolor'}; 929: push @Colors, $plot{'fgcolor'}; 930: push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'}); 931: foreach $curve (@curves) { 932: push @Colors, ($curve->{'color'} ne '' ? 933: $curve->{'color'} : 934: $plot{'fgcolor'} ); 935: } 936: # set term 937: if ($target eq 'web') { 938: $gnuplot_input .= 'set term gif '; 939: $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on'); 940: $gnuplot_input .= $plot{'font'} . ' '; 941: $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' '; 942: $gnuplot_input .= "@Colors\n"; 943: # set output 944: $gnuplot_input .= "set output\n"; 945: } elsif ($target eq 'tex') { 946: $gnuplot_input .= "set term postscript eps monochrome\n"; 947: $gnuplot_input .= "set output \"$filename.eps\"\n"; 948: } 949: # grid 950: $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on'); 951: # border 952: $gnuplot_input .= ($plot{'border'} eq 'on'? 953: 'set border'.$/ : 954: 'set noborder'.$/ ); # title, xlabel, ylabel 955: # titles 956: $gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ; 957: $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel)); 958: $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel)); 959: # tics 960: if (%xtics) { 961: $gnuplot_input .= "set xtics $xtics{'location'} "; 962: $gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror "); 963: $gnuplot_input .= "$xtics{'start'}, "; 964: $gnuplot_input .= "$xtics{'increment'}, "; 965: $gnuplot_input .= "$xtics{'end'}\n"; 966: } 967: if (%ytics) { 968: $gnuplot_input .= "set ytics $ytics{'location'} "; 969: $gnuplot_input .= ( $ytics{'mirror'} eq 'on'?"mirror ":"nomirror "); 970: $gnuplot_input .= "$ytics{'start'}, "; 971: $gnuplot_input .= "$ytics{'increment'}, "; 972: $gnuplot_input .= "$ytics{'end'}\n"; 973: } 974: # axis 975: if (%axis) { 976: $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; 977: $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; 978: } 979: # Key 980: if (%key) { 981: $gnuplot_input .= 'set key '.$key{'pos'}.' '; 982: if ($key{'title'} ne '') { 983: $gnuplot_input .= 'title " '.$key{'title'}.'" '; 984: } 985: $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; 986: } else { 987: $gnuplot_input .= 'set nokey'.$/; 988: } 989: # labels 990: my $label; 991: foreach $label (@labels) { 992: $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. 993: $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ; 994: } 995: # curves 996: $gnuplot_input .= 'plot '; 997: for (my $i = 0;$i<=$#curves;$i++) { 998: $curve = $curves[$i]; 999: $gnuplot_input.= ', ' if ($i > 0); 1000: if (exists($curve->{'function'})) { 1001: $gnuplot_input.= 1002: $curve->{'function'}.' title "'. 1003: $curve->{'name'}.'" with '. 1004: $curve->{'linestyle'}; 1005: } elsif (exists($curve->{'data'})) { 1006: # Store data values in $datatext 1007: my $datatext = ''; 1008: # get new filename 1009: my $datafilename = "$tmpdir/$filename.$i"; 1010: my $fh=Apache::File->new(">$datafilename"); 1011: # Compile data 1012: my @Data = @{$curve->{'data'}}; 1013: my @Data0 = @{$Data[0]}; 1014: for (my $i =0; $i<=$#Data0; $i++) { 1015: my $dataset; 1016: foreach $dataset (@Data) { 1017: $datatext .= $dataset->[$i] . ' '; 1018: } 1019: $datatext .= $/; 1020: } 1021: # write file 1022: print $fh $datatext; 1023: close ($fh); 1024: # generate gnuplot text 1025: $gnuplot_input.= '"'.$datafilename.'" title "'. 1026: $curve->{'name'}.'" with '. 1027: $curve->{'linestyle'}; 1028: } 1029: } 1030: # Write the output to a file. 1031: my $fh=Apache::File->new(">$tmpdir$filename"); 1032: print $fh $gnuplot_input; 1033: close($fh); 1034: # That's all folks. 1035: return ; 1036: } 1037: 1038: #---------------------------------------------- check_inputs 1039: sub check_inputs { 1040: ## Note: no inputs, no outputs - this acts only on global variables. 1041: ## Make sure we have all the input we need: 1042: if (! %plot) { &set_defaults(\%plot,\%gnuplot_defaults); } 1043: if (! %key ) {} # No key for this plot, thats okay 1044: # if (! %axis) { &set_defaults(\%axis,\%axis_defaults); } 1045: if (! defined($title )) {} # No title for this plot, thats okay 1046: if (! defined($xlabel)) {} # No xlabel for this plot, thats okay 1047: if (! defined($ylabel)) {} # No ylabel for this plot, thats okay 1048: if ($#labels < 0) { } # No labels for this plot, thats okay 1049: if ($#curves < 0) { 1050: &Apache::lonxml::warning("No curves specified for plot!!!!"); 1051: return ''; 1052: } 1053: my $curve; 1054: foreach $curve (@curves) { 1055: if (!defined($curve->{'function'})&&!defined($curve->{'data'})){ 1056: &Apache::lonxml::warning("One of the curves specified did not contain any <data> or <function> declarations\n"); 1057: return ''; 1058: } 1059: } 1060: } 1061: 1062: #------------------------------------------------ make_edit 1063: sub edit_attributes { 1064: my ($target,$token,$defaults,$keys) = @_; 1065: my ($result,@keys); 1066: if ($keys && ref($keys) eq 'ARRAY') { 1067: @keys = @$keys; 1068: } else { 1069: @keys = sort(keys(%$defaults)); 1070: } 1071: foreach my $attr (@keys) { 1072: # append a ' ' to the description if it doesn't have one already. 1073: my $description = $defaults->{$attr}->{'description'}; 1074: $description .= ' ' if ($description !~ / $/); 1075: if ($defaults->{$attr}->{'edit_type'} eq 'entry') { 1076: $result .= &Apache::edit::text_arg 1077: ($description,$attr,$token, 1078: $defaults->{$attr}->{'size'}); 1079: } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { 1080: $result .= &Apache::edit::select_arg 1081: ($description,$attr,$defaults->{$attr}->{'choices'},$token); 1082: } elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') { 1083: $result .= &Apache::edit::select_arg 1084: ($description,$attr,['on','off'],$token); 1085: } 1086: $result .= ' '; 1087: } 1088: return $result; 1089: } 1090: 1091: 1092: ################################################################### 1093: ## ## 1094: ## Insertion functions for editing plots ## 1095: ## ## 1096: ################################################################### 1097: 1098: sub insert_gnuplot { 1099: my $result = ''; 1100: # plot attributes 1101: $result .= "<gnuplot \n"; 1102: foreach my $attr (keys(%gnuplot_defaults)) { 1103: $result .= " $attr=\"$gnuplot_defaults{$attr}->{'default'}\"\n"; 1104: } 1105: $result .= ">\n"; 1106: # Add the components (most are commented out for simplicity) 1107: # $result .= &insert_key(); 1108: # $result .= &insert_axis(); 1109: # $result .= &insert_title(); 1110: # $result .= &insert_xlabel(); 1111: # $result .= &insert_ylabel(); 1112: $result .= &insert_curve(); 1113: # close up the <gnuplot> 1114: $result .= "</gnuplot>\n"; 1115: return $result; 1116: } 1117: 1118: sub insert_tics { 1119: my $result; 1120: $result .= &insert_xtics() . &insert_ytics; 1121: return $result; 1122: } 1123: 1124: sub insert_xtics { 1125: my $result; 1126: $result .= "\n <xtics "; 1127: foreach my $attr (keys(%tic_defaults)) { 1128: $result .= "$attr=\"$tic_defaults{$attr}->{'default'}\" "; 1129: } 1130: $result .= "/>\n"; 1131: return $result; 1132: } 1133: 1134: sub insert_ytics { 1135: my $result; 1136: $result .= "\n <ytics "; 1137: foreach my $attr (keys(%tic_defaults)) { 1138: $result .= "$attr=\"$tic_defaults{$attr}->{'default'}\" "; 1139: } 1140: $result .= "/>\n"; 1141: return $result; 1142: } 1143: 1144: sub insert_key { 1145: my $result; 1146: $result .= "\n <key \n"; 1147: foreach my $attr (keys(%key_defaults)) { 1148: $result .= " $attr=\"$key_defaults{$attr}->{'default'}\"\n"; 1149: } 1150: $result .= " />\n"; 1151: return $result; 1152: } 1153: 1154: sub insert_axis{ 1155: my $result; 1156: $result .= "\n <axis "; 1157: foreach my $attr (keys(%axis_defaults)) { 1158: $result .= " $attr=\"$axis_defaults{$attr}->{'default'}\"\n"; 1159: } 1160: $result .= " />\n"; 1161: return $result; 1162: } 1163: 1164: sub insert_title { return "\n <title></title>\n"; } 1165: sub insert_xlabel { return "\n <xlabel></xlabel>\n"; } 1166: sub insert_ylabel { return "\n <ylabel></ylabel>\n"; } 1167: 1168: sub insert_label { 1169: my $result; 1170: $result .= "\n <label "; 1171: foreach my $attr (keys(%label_defaults)) { 1172: $result .= ' '.$attr.'="'. 1173: $label_defaults{$attr}->{'default'}."\"\n"; 1174: } 1175: $result .= " ></label>\n"; 1176: return $result; 1177: } 1178: 1179: sub insert_curve { 1180: my $result; 1181: $result .= "\n <curve "; 1182: foreach my $attr (keys(%curve_defaults)) { 1183: $result .= ' '.$attr.'="'. 1184: $curve_defaults{$attr}->{'default'}."\"\n"; 1185: } 1186: $result .= " >\n"; 1187: $result .= &insert_data().&insert_data()."</curve>\n"; 1188: } 1189: 1190: sub insert_function { 1191: my $result; 1192: $result .= "<function></function>\n"; 1193: return $result; 1194: } 1195: 1196: sub insert_data { 1197: my $result; 1198: $result .= " <data></data>\n"; 1199: return $result; 1200: } 1201: 1202: ##---------------------------------------------------------------------- 1203: # Javascript functions to display help for tags 1204: 1205: sub make_javascript { 1206: my $helpwindowwidth = 400; 1207: my $helpwindowheight = 400; 1208: my $result = ''; 1209: $result.=<<"ENDFUNCTION"; 1210: <script language="JavaScript"> 1211: function openWin(text) 1212: { 1213: newWin = open("", "new_W", "width=$helpwindowwidth,height=$helpwindowheight,resizable=1,scrollbars=1"); 1214: newWin.document.open("text/html", "replace"); 1215: newWin.document.writeln(text); 1216: newWin.document.writeln('<center><a href=\"javascript:window.close()\">close this window</a></center>'); 1217: newWin.document.close(); 1218: } 1219: </script> 1220: ENDFUNCTION 1221: return $result; 1222: } 1223: 1224: sub help_win { 1225: my ($helptext)=@_; 1226: $helptext =~ s/\n/ /g; 1227: $helptext =~ s/\'/\\\'/g; 1228: my $result = ''; 1229: $result.=<<"ENDWIN"; 1230: <table width="100%"><tr><td align="right"> 1231: <a href="javascript:openWin('$helptext')">help</a> 1232: </td></tr></table><hr /> 1233: ENDWIN 1234: return $result; 1235: } 1236: ##---------------------------------------------------------------------- 1237: 1; 1238: __END__ 1239: 1240: