![]() ![]() | ![]() |
- add ability to change grid lines to polar
1: # The LearningOnline Network with CAPA 2: # Dynamic plot 3: # 4: # $Id: lonplot.pm,v 1.115 2007/02/21 20:34:58 albertel 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: 29: package Apache::lonplot; 30: 31: use strict; 32: use warnings FATAL=>'all'; 33: no warnings 'uninitialized'; 34: use Apache::File; 35: use Apache::response; 36: use Apache::lonxml; 37: use Apache::edit; 38: use Apache::lonnet; 39: use lib '/home/httpd/lib/perl/'; 40: use LONCAPA; 41: 42: 43: use vars qw/$weboutputformat $versionstring/; 44: 45: 46: 47: BEGIN { 48: &Apache::lonxml::register('Apache::lonplot',('gnuplot')); 49: # 50: # Determine the version of GNUPLOT 51: $weboutputformat = 'gif'; 52: $versionstring = `gnuplot --version 2>/dev/null`; 53: if ($versionstring =~ /^gnuplot 4/) { 54: $weboutputformat = 'png'; 55: } 56: 57: } 58: 59: 60: ## 61: ## Description of data structures: 62: ## 63: ## %plot %key %axis 64: ## -------------------------- 65: ## height title color 66: ## width box xmin 67: ## bgcolor pos xmax 68: ## fgcolor ymin 69: ## transparent ymax 70: ## grid 71: ## border 72: ## font 73: ## align 74: ## 75: ## @labels: $labels[$i] = \%label 76: ## %label: text, xpos, ypos, justify 77: ## 78: ## @curves: $curves[$i] = \%curve 79: ## %curve: name, linestyle, ( function | data ) 80: ## 81: ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], 82: ## [y1,y2,y3,y4] ] 83: ## 84: 85: ################################################################### 86: ## ## 87: ## Tests used in checking the validitity of input ## 88: ## ## 89: ################################################################### 90: 91: my $max_str_len = 50; # if a label, title, xlabel, or ylabel text 92: # is longer than this, it will be truncated. 93: 94: my %linestyles = 95: ( 96: lines => 2, # Maybe this will be used in the future 97: linespoints => 2, # to check on whether or not they have 98: dots => 2, # supplied enough <data></data> fields 99: points => 2, # to use the given line style. But for 100: steps => 2, # now there are more important things 101: fsteps => 2, # for me to deal with. 102: histeps => 2, 103: errorbars => 3, 104: xerrorbars => [3,4], 105: yerrorbars => [3,4], 106: xyerrorbars => [4,6], 107: boxes => 3, 108: filledcurves => 2, 109: vector => 4 110: ); 111: 112: my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; 113: my $real_test = 114: sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/}; 115: my $pos_real_test = 116: sub {$_[0]=~s/\s+//g;$_[0]=~/^[+]?\d*\.?\d*([eE][+-]\d+)?$/}; 117: my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-fA-F]{6}$/}; 118: my $onoff_test = sub {$_[0]=~/^(on|off)$/}; 119: my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/}; 120: my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; 121: my $linestyle_test = sub {exists($linestyles{$_[0]})}; 122: my $words_test = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w~!\@\#\$\%^&\*\(\)-=_\+\[\]\{\}:\;\'<>,\.\/\?\\]+ ?)+$/}; 123: 124: ################################################################### 125: ## ## 126: ## Attribute metadata ## 127: ## ## 128: ################################################################### 129: my @gnuplot_edit_order = 130: qw/alttag bgcolor fgcolor height width font transparent grid samples 131: border align texwidth texfont plotcolor plottype gridtype lmargin rmargin 132: tmargin bmargin major_ticscale minor_ticscale boxwidth gridlayer fillstyle 133: pattern solid/; 134: 135: my $margin_choices = ['default',0..20]; 136: 137: my %gnuplot_defaults = 138: ( 139: alttag => { 140: default => 'dynamically generated plot', 141: test => $words_test, 142: description => 'brief description of the plot', 143: edit_type => 'entry', 144: size => '40' 145: }, 146: height => { 147: default => 300, 148: test => $int_test, 149: description => 'height of image (pixels)', 150: edit_type => 'entry', 151: size => '10' 152: }, 153: width => { 154: default => 400, 155: test => $int_test, 156: description => 'width of image (pixels)', 157: edit_type => 'entry', 158: size => '10' 159: }, 160: bgcolor => { 161: default => 'xffffff', 162: test => $color_test, 163: description => 'background color of image (xffffff)', 164: edit_type => 'entry', 165: size => '10' 166: }, 167: fgcolor => { 168: default => 'x000000', 169: test => $color_test, 170: description => 'foreground color of image (x000000)', 171: edit_type => 'entry', 172: size => '10' 173: }, 174: transparent => { 175: default => 'off', 176: test => $onoff_test, 177: description => 'Transparent image', 178: edit_type => 'onoff' 179: }, 180: grid => { 181: default => 'on', 182: test => $onoff_test, 183: description => 'Display grid', 184: edit_type => 'onoff' 185: }, 186: gridlayer => { 187: default => 'off', 188: test => $onoff_test, 189: description => 'Display grid front layer over filled boxes or filled curves', 190: edit_type => 'onoff' 191: }, 192: box_border => { 193: default => 'noborder', 194: test => sub {$_[0]=~/^(noborder|border)$/}, 195: description => 'Draw border for boxes', 196: edit_type => 'choice', 197: choices => ['border','noborder'] 198: }, 199: border => { 200: default => 'on', 201: test => $onoff_test, 202: description => 'Draw border around plot', 203: edit_type => 'onoff' 204: }, 205: font => { 206: default => 'medium', 207: test => $sml_test, 208: description => 'Size of font to use', 209: edit_type => 'choice', 210: choices => ['small','medium','large'] 211: }, 212: samples => { 213: default => '100', 214: test => $int_test, 215: description => 'Number of samples for non-data plots', 216: edit_type => 'choice', 217: choices => ['100','200','500','1000','2000','5000'] 218: }, 219: align => { 220: default => 'center', 221: test => sub {$_[0]=~/^(left|right|center)$/}, 222: description => 'alignment for image in html', 223: edit_type => 'choice', 224: choices => ['left','right','center'] 225: }, 226: texwidth => { 227: default => '93', 228: test => $int_test, 229: description => 'Width of plot when printed (mm)', 230: edit_type => 'entry', 231: size => '5' 232: }, 233: texfont => { 234: default => '22', 235: test => $int_test, 236: description => 'Font size to use in TeX output (pts):', 237: edit_type => 'choice', 238: choices => [qw/8 10 12 14 16 18 20 22 24 26 28 30 32 34 36/], 239: }, 240: plotcolor => { 241: default => 'monochrome', 242: test => sub {$_[0]=~/^(monochrome|color|colour)$/}, 243: description => 'Color setting for printing:', 244: edit_type => 'choice', 245: choices => [qw/monochrome color colour/], 246: }, 247: pattern => { 248: default => '', 249: test => $int_test, 250: description => 'pattern value for boxes:', 251: edit_type => 'choice', 252: choices => [0,1,2,3,4,5,6] 253: }, 254: solid => { 255: default => 0, 256: test => $real_test, 257: description => 'The density of fill style for boxes', 258: edit_type => 'entry', 259: size => '5' 260: }, 261: fillstyle => { 262: default => 'empty', 263: test => sub {$_[0]=~/^(empty|solid|pattern)$/}, 264: description => 'Filled style for boxes:', 265: edit_type => 'choice', 266: choices => ['empty','solid','pattern'] 267: }, 268: plottype => { 269: default => 'Cartesian', 270: test => sub {$_[0]=~/^(Polar|Cartesian)$/}, 271: description => 'Plot type:', 272: edit_type => 'choice', 273: choices => ['Cartesian','Polar'] 274: }, 275: gridtype => { 276: default => 'Cartesian', 277: test => sub {$_[0]=~/^(Polar|Cartesian)$/}, 278: description => 'Grid type:', 279: edit_type => 'choice', 280: choices => ['Cartesian','Polar'] 281: }, 282: lmargin => { 283: default => 'default', 284: test => sub {$_[0]=~/^(default|\d+)$/}, 285: description => 'Left margin width (pts):', 286: edit_type => 'choice', 287: choices => $margin_choices, 288: }, 289: rmargin => { 290: default => 'default', 291: test => sub {$_[0]=~/^(default|\d+)$/}, 292: description => 'Right margin width (pts):', 293: edit_type => 'choice', 294: choices => $margin_choices, 295: }, 296: tmargin => { 297: default => 'default', 298: test => sub {$_[0]=~/^(default|\d+)$/}, 299: description => 'Top margin width (pts):', 300: edit_type => 'choice', 301: choices => $margin_choices, 302: }, 303: bmargin => { 304: default => 'default', 305: test => sub {$_[0]=~/^(default|\d+)$/}, 306: description => 'Bottom margin width (pts):', 307: edit_type => 'choice', 308: choices => $margin_choices, 309: }, 310: boxwidth => { 311: default => '', 312: test => $real_test, 313: description => 'width of boxes default auto', 314: edit_type => 'entry', 315: size => '5' 316: }, 317: major_ticscale => { 318: default => '1', 319: test => $real_test, 320: description => 'Size of major tic marks (plot coordinates)', 321: edit_type => 'entry', 322: size => '5' 323: }, 324: minor_ticscale => { 325: default => '0.5', 326: test => $real_test, 327: description => 'Size of minor tic mark (plot coordinates)', 328: edit_type => 'entry', 329: size => '5' 330: }, 331: ); 332: 333: my %key_defaults = 334: ( 335: title => { 336: default => '', 337: test => $words_test, 338: description => 'Title of key', 339: edit_type => 'entry', 340: size => '40' 341: }, 342: box => { 343: default => 'off', 344: test => $onoff_test, 345: description => 'Draw a box around the key?', 346: edit_type => 'onoff' 347: }, 348: pos => { 349: default => 'top right', 350: test => $key_pos_test, 351: description => 'position of the key on the plot', 352: edit_type => 'choice', 353: choices => ['top left','top right','bottom left','bottom right', 354: 'outside','below'] 355: } 356: ); 357: 358: my %label_defaults = 359: ( 360: xpos => { 361: default => 0, 362: test => $real_test, 363: description => 'x position of label (graph coordinates)', 364: edit_type => 'entry', 365: size => '10' 366: }, 367: ypos => { 368: default => 0, 369: test => $real_test, 370: description => 'y position of label (graph coordinates)', 371: edit_type => 'entry', 372: size => '10' 373: }, 374: justify => { 375: default => 'left', 376: test => sub {$_[0]=~/^(left|right|center)$/}, 377: description => 'justification of the label text on the plot', 378: edit_type => 'choice', 379: choices => ['left','right','center'] 380: } 381: ); 382: 383: my @tic_edit_order = ('location','mirror','start','increment','end', 384: 'minorfreq'); 385: my %tic_defaults = 386: ( 387: location => { 388: default => 'border', 389: test => sub {$_[0]=~/^(border|axis)$/}, 390: description => 'Location of major tic marks', 391: edit_type => 'choice', 392: choices => ['border','axis'] 393: }, 394: mirror => { 395: default => 'on', 396: test => $onoff_test, 397: description => 'mirror tics on opposite axis?', 398: edit_type => 'onoff' 399: }, 400: start => { 401: default => '-10.0', 402: test => $real_test, 403: description => 'Start major tics at', 404: edit_type => 'entry', 405: size => '10' 406: }, 407: increment => { 408: default => '1.0', 409: test => $real_test, 410: description => 'Place a major tic every', 411: edit_type => 'entry', 412: size => '10' 413: }, 414: end => { 415: default => ' 10.0', 416: test => $real_test, 417: description => 'Stop major tics at ', 418: edit_type => 'entry', 419: size => '10' 420: }, 421: minorfreq => { 422: default => '0', 423: test => $int_test, 424: description => 'Number of minor tics per major tic mark', 425: edit_type => 'entry', 426: size => '10' 427: }, 428: ); 429: 430: my @axis_edit_order = ('color','xmin','xmax','ymin','ymax'); 431: my %axis_defaults = 432: ( 433: color => { 434: default => 'x000000', 435: test => $color_test, 436: description => 'color of grid lines (x000000)', 437: edit_type => 'entry', 438: size => '10' 439: }, 440: xmin => { 441: default => '-10.0', 442: test => $real_test, 443: description => 'minimum x-value shown in plot', 444: edit_type => 'entry', 445: size => '10' 446: }, 447: xmax => { 448: default => ' 10.0', 449: test => $real_test, 450: description => 'maximum x-value shown in plot', 451: edit_type => 'entry', 452: size => '10' 453: }, 454: ymin => { 455: default => '-10.0', 456: test => $real_test, 457: description => 'minimum y-value shown in plot', 458: edit_type => 'entry', 459: size => '10' 460: }, 461: ymax => { 462: default => ' 10.0', 463: test => $real_test, 464: description => 'maximum y-value shown in plot', 465: edit_type => 'entry', 466: size => '10' 467: } 468: ); 469: 470: my @curve_edit_order = ('color','name','linestyle','pointtype','pointsize','limit'); 471: 472: my %curve_defaults = 473: ( 474: color => { 475: default => 'x000000', 476: test => $color_test, 477: description => 'color of curve (x000000)', 478: edit_type => 'entry', 479: size => '10' 480: }, 481: name => { 482: default => '', 483: test => $words_test, 484: description => 'name of curve to appear in key', 485: edit_type => 'entry', 486: size => '20' 487: }, 488: linestyle => { 489: default => 'lines', 490: test => $linestyle_test, 491: description => 'Line style', 492: edit_type => 'choice', 493: choices => [keys(%linestyles)] 494: }, 495: # gnuplots term=gif driver does not handle linewidth :( 496: # linewidth => { 497: # default => 1, 498: # test => $int_test, 499: # description => 'Line width (may not apply to all line styles)', 500: # edit_type => 'choice', 501: # choices => [1,2,3,4,5,6,7,8,9,10] 502: # }, 503: pointsize => { 504: default => 1, 505: test => $pos_real_test, 506: description => 'point size (may not apply to all line styles)', 507: edit_type => 'entry', 508: size => '5' 509: }, 510: pointtype => { 511: default => 1, 512: test => $int_test, 513: description => 'point type (may not apply to all line styles)', 514: edit_type => 'choice', 515: choices => [0,1,2,3,4,5,6] 516: }, 517: limit => { 518: default => 'closed', 519: test => sub {$_[0]=~/^(closed|x1|x2|y1|y2)$/}, 520: description => 'point to fill -- for filledcurves', 521: edit_type => 'choice', 522: choices => ['closed','x1','x2','y1','y2'] 523: }, 524: ); 525: 526: ################################################################### 527: ## ## 528: ## parsing and edit rendering ## 529: ## ## 530: ################################################################### 531: 532: undef %Apache::lonplot::plot; 533: my (%key,%axis,$title,$xlabel,$ylabel,@labels,@curves,%xtics,%ytics); 534: 535: sub start_gnuplot { 536: undef(%Apache::lonplot::plot); undef(%key); undef(%axis); 537: undef($title); undef($xlabel); undef($ylabel); 538: undef(@labels); undef(@curves); 539: undef(%xtics); undef(%ytics); 540: # 541: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 542: my $result=''; 543: &Apache::lonxml::register('Apache::lonplot', 544: ('title','xlabel','ylabel','key','axis','label','curve', 545: 'xtics','ytics')); 546: push (@Apache::lonxml::namespace,'lonplot'); 547: if ($target eq 'web' || $target eq 'tex') { 548: &get_attributes(\%Apache::lonplot::plot,\%gnuplot_defaults,$parstack,$safeeval, 549: $tagstack->[-1]); 550: } elsif ($target eq 'edit') { 551: $result .= &Apache::edit::tag_start($target,$token,'GnuPlot'); 552: $result .= &edit_attributes($target,$token,\%gnuplot_defaults, 553: \@gnuplot_edit_order); 554: } elsif ($target eq 'modified') { 555: my $constructtag=&Apache::edit::get_new_args 556: ($token,$parstack,$safeeval,keys(%gnuplot_defaults)); 557: if ($constructtag) { 558: $result = &Apache::edit::rebuild_tag($token); 559: } 560: } 561: return $result; 562: } 563: 564: sub end_gnuplot { 565: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 566: pop @Apache::lonxml::namespace; 567: &Apache::lonxml::deregister('Apache::lonplot', 568: ('title','xlabel','ylabel','key','axis','label','curve')); 569: my $result = ''; 570: my $randnumber; 571: # need to call rand everytime start_script would evaluate, as the 572: # safe space rand number generator and the global rand generator 573: # are not separate 574: if ($target eq 'web' || $target eq 'tex' || $target eq 'grade' || 575: $target eq 'answer') { 576: $randnumber=int(rand(1000)); 577: } 578: if ($target eq 'web' || $target eq 'tex') { 579: &check_inputs(); # Make sure we have all the data we need 580: ## 581: ## Determine filename 582: my $tmpdir = '/home/httpd/perl/tmp/'; 583: my $filename = $env{'user.name'}.'_'.$env{'user.domain'}. 584: '_'.time.'_'.$$.$randnumber.'_plot'; 585: ## Write the plot description to the file 586: &write_gnuplot_file($tmpdir,$filename,$target); 587: $filename = &escape($filename); 588: ## return image tag for the plot 589: if ($target eq 'web') { 590: $result .= <<"ENDIMAGE"; 591: <img src = "/cgi-bin/plot.$weboutputformat?file=$filename.data" 592: width = "$Apache::lonplot::plot{'width'}" 593: height = "$Apache::lonplot::plot{'height'}" 594: align = "$Apache::lonplot::plot{'align'}" 595: alt = "$Apache::lonplot::plot{'alttag'}" /> 596: ENDIMAGE 597: } elsif ($target eq 'tex') { 598: &Apache::lonxml::debug(" gnuplot wid = $Apache::lonplot::plot{'width'}"); 599: &Apache::lonxml::debug(" gnuplot ht = $Apache::lonplot::plot{'height'}"); 600: #might be inside the safe space, register the URL for later 601: &Apache::lonxml::register_ssi("/cgi-bin/plot.gif?file=$filename.data&output=eps"); 602: $result = "%DYNAMICIMAGE:$Apache::lonplot::plot{'width'}:$Apache::lonplot::plot{'height'}:$Apache::lonplot::plot{'texwidth'}\n"; 603: $result .= '\graphicspath{{/home/httpd/perl/tmp/}}'."\n"; 604: $result .= '\includegraphics[width='.$Apache::lonplot::plot{'texwidth'}.' mm]{'.&unescape($filename).'.eps}'; 605: } 606: } elsif ($target eq 'edit') { 607: $result.=&Apache::edit::tag_end($target,$token); 608: } 609: return $result; 610: } 611: 612: 613: ##--------------------------------------------------------------- xtics 614: sub start_xtics { 615: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 616: my $result=''; 617: if ($target eq 'web' || $target eq 'tex') { 618: &get_attributes(\%xtics,\%tic_defaults,$parstack,$safeeval, 619: $tagstack->[-1]); 620: } elsif ($target eq 'edit') { 621: $result .= &Apache::edit::tag_start($target,$token,'xtics'); 622: $result .= &edit_attributes($target,$token,\%tic_defaults, 623: \@tic_edit_order); 624: } elsif ($target eq 'modified') { 625: my $constructtag=&Apache::edit::get_new_args 626: ($token,$parstack,$safeeval,keys(%tic_defaults)); 627: if ($constructtag) { 628: $result = &Apache::edit::rebuild_tag($token); 629: } 630: } 631: return $result; 632: } 633: 634: sub end_xtics { 635: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 636: my $result = ''; 637: if ($target eq 'web' || $target eq 'tex') { 638: } elsif ($target eq 'edit') { 639: $result.=&Apache::edit::tag_end($target,$token); 640: } 641: return $result; 642: } 643: 644: ##--------------------------------------------------------------- ytics 645: sub start_ytics { 646: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 647: my $result=''; 648: if ($target eq 'web' || $target eq 'tex') { 649: &get_attributes(\%ytics,\%tic_defaults,$parstack,$safeeval, 650: $tagstack->[-1]); 651: } elsif ($target eq 'edit') { 652: $result .= &Apache::edit::tag_start($target,$token,'ytics'); 653: $result .= &edit_attributes($target,$token,\%tic_defaults, 654: \@tic_edit_order); 655: } elsif ($target eq 'modified') { 656: my $constructtag=&Apache::edit::get_new_args 657: ($token,$parstack,$safeeval,keys(%tic_defaults)); 658: if ($constructtag) { 659: $result = &Apache::edit::rebuild_tag($token); 660: } 661: } 662: return $result; 663: } 664: 665: sub end_ytics { 666: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 667: my $result = ''; 668: if ($target eq 'web' || $target eq 'tex') { 669: } elsif ($target eq 'edit') { 670: $result.=&Apache::edit::tag_end($target,$token); 671: } 672: return $result; 673: } 674: 675: 676: ##----------------------------------------------------------------- key 677: sub start_key { 678: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 679: my $result=''; 680: if ($target eq 'web' || $target eq 'tex') { 681: &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, 682: $tagstack->[-1]); 683: } elsif ($target eq 'edit') { 684: $result .= &Apache::edit::tag_start($target,$token,'Plot Key'); 685: $result .= &edit_attributes($target,$token,\%key_defaults); 686: } elsif ($target eq 'modified') { 687: my $constructtag=&Apache::edit::get_new_args 688: ($token,$parstack,$safeeval,keys(%key_defaults)); 689: if ($constructtag) { 690: $result = &Apache::edit::rebuild_tag($token); 691: } 692: } 693: return $result; 694: } 695: 696: sub end_key { 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: ##------------------------------------------------------------------- title 707: sub start_title { 708: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 709: my $result=''; 710: if ($target eq 'web' || $target eq 'tex') { 711: $title = &Apache::lonxml::get_all_text("/title",$parser,$style); 712: $title=&Apache::run::evaluate($title,$safeeval,$$parstack[-1]); 713: $title =~ s/\n/ /g; 714: if (length($title) > $max_str_len) { 715: $title = substr($title,0,$max_str_len); 716: } 717: } elsif ($target eq 'edit') { 718: $result.=&Apache::edit::tag_start($target,$token,'Plot Title'); 719: my $text=&Apache::lonxml::get_all_text("/title",$parser,$style); 720: $result.=&Apache::edit::end_row(). 721: &Apache::edit::start_spanning_row(). 722: &Apache::edit::editline('',$text,'',60); 723: } elsif ($target eq 'modified') { 724: $result.=&Apache::edit::rebuild_tag($token); 725: $result.=&Apache::edit::modifiedfield("/title",$parser); 726: } 727: return $result; 728: } 729: 730: sub end_title { 731: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 732: my $result = ''; 733: if ($target eq 'web' || $target eq 'tex') { 734: } elsif ($target eq 'edit') { 735: $result.=&Apache::edit::tag_end($target,$token); 736: } 737: return $result; 738: } 739: ##------------------------------------------------------------------- xlabel 740: sub start_xlabel { 741: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 742: my $result=''; 743: if ($target eq 'web' || $target eq 'tex') { 744: $xlabel = &Apache::lonxml::get_all_text("/xlabel",$parser,$style); 745: $xlabel=&Apache::run::evaluate($xlabel,$safeeval,$$parstack[-1]); 746: $xlabel =~ s/\n/ /g; 747: if (length($xlabel) > $max_str_len) { 748: $xlabel = substr($xlabel,0,$max_str_len); 749: } 750: } elsif ($target eq 'edit') { 751: $result.=&Apache::edit::tag_start($target,$token,'Plot Xlabel'); 752: my $text=&Apache::lonxml::get_all_text("/xlabel",$parser,$style); 753: $result.=&Apache::edit::end_row(). 754: &Apache::edit::start_spanning_row(). 755: &Apache::edit::editline('',$text,'',60); 756: } elsif ($target eq 'modified') { 757: $result.=&Apache::edit::rebuild_tag($token); 758: $result.=&Apache::edit::modifiedfield("/xlabel",$parser); 759: } 760: return $result; 761: } 762: 763: sub end_xlabel { 764: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 765: my $result = ''; 766: if ($target eq 'web' || $target eq 'tex') { 767: } elsif ($target eq 'edit') { 768: $result.=&Apache::edit::tag_end($target,$token); 769: } 770: return $result; 771: } 772: 773: ##------------------------------------------------------------------- ylabel 774: sub start_ylabel { 775: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 776: my $result=''; 777: if ($target eq 'web' || $target eq 'tex') { 778: $ylabel = &Apache::lonxml::get_all_text("/ylabel",$parser,$style); 779: $ylabel = &Apache::run::evaluate($ylabel,$safeeval,$$parstack[-1]); 780: $ylabel =~ s/\n/ /g; 781: if (length($ylabel) > $max_str_len) { 782: $ylabel = substr($ylabel,0,$max_str_len); 783: } 784: } elsif ($target eq 'edit') { 785: $result .= &Apache::edit::tag_start($target,$token,'Plot Ylabel'); 786: my $text = &Apache::lonxml::get_all_text("/ylabel",$parser,$style); 787: $result .= &Apache::edit::end_row(). 788: &Apache::edit::start_spanning_row(). 789: &Apache::edit::editline('',$text,'',60); 790: } elsif ($target eq 'modified') { 791: $result.=&Apache::edit::rebuild_tag($token); 792: $result.=&Apache::edit::modifiedfield("/ylabel",$parser); 793: } 794: return $result; 795: } 796: 797: sub end_ylabel { 798: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 799: my $result = ''; 800: if ($target eq 'web' || $target eq 'tex') { 801: } elsif ($target eq 'edit') { 802: $result.=&Apache::edit::tag_end($target,$token); 803: } 804: return $result; 805: } 806: 807: ##------------------------------------------------------------------- label 808: sub start_label { 809: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 810: my $result=''; 811: if ($target eq 'web' || $target eq 'tex') { 812: my %label; 813: &get_attributes(\%label,\%label_defaults,$parstack,$safeeval, 814: $tagstack->[-1]); 815: my $text = &Apache::lonxml::get_all_text("/label",$parser,$style); 816: $text = &Apache::run::evaluate($text,$safeeval,$$parstack[-1]); 817: $text =~ s/\n/ /g; 818: $text = substr($text,0,$max_str_len) if (length($text) > $max_str_len); 819: $label{'text'} = $text; 820: push(@labels,\%label); 821: } elsif ($target eq 'edit') { 822: $result .= &Apache::edit::tag_start($target,$token,'Plot Label'); 823: $result .= &edit_attributes($target,$token,\%label_defaults); 824: my $text = &Apache::lonxml::get_all_text("/label",$parser,$style); 825: $result .= &Apache::edit::end_row(). 826: &Apache::edit::start_spanning_row(). 827: &Apache::edit::editline('',$text,'',60); 828: } elsif ($target eq 'modified') { 829: &Apache::edit::get_new_args 830: ($token,$parstack,$safeeval,keys(%label_defaults)); 831: $result.=&Apache::edit::rebuild_tag($token); 832: $result.=&Apache::edit::modifiedfield("/label",$parser); 833: } 834: return $result; 835: } 836: 837: sub end_label { 838: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 839: my $result = ''; 840: if ($target eq 'web' || $target eq 'tex') { 841: } elsif ($target eq 'edit') { 842: $result.=&Apache::edit::tag_end($target,$token); 843: } 844: return $result; 845: } 846: 847: ##------------------------------------------------------------------- curve 848: sub start_curve { 849: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 850: my $result=''; 851: &Apache::lonxml::register('Apache::lonplot',('function','data')); 852: push (@Apache::lonxml::namespace,'curve'); 853: if ($target eq 'web' || $target eq 'tex') { 854: my %curve; 855: &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, 856: $tagstack->[-1]); 857: push (@curves,\%curve); 858: } elsif ($target eq 'edit') { 859: $result .= &Apache::edit::tag_start($target,$token,'Curve'); 860: $result .= &edit_attributes($target,$token,\%curve_defaults, 861: \@curve_edit_order); 862: } elsif ($target eq 'modified') { 863: my $constructtag=&Apache::edit::get_new_args 864: ($token,$parstack,$safeeval,keys(%curve_defaults)); 865: if ($constructtag) { 866: $result = &Apache::edit::rebuild_tag($token); 867: $result.= &Apache::edit::handle_insert(); 868: } 869: } 870: return $result; 871: } 872: 873: sub end_curve { 874: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 875: my $result = ''; 876: pop @Apache::lonxml::namespace; 877: &Apache::lonxml::deregister('Apache::lonplot',('function','data')); 878: if ($target eq 'web' || $target eq 'tex') { 879: } elsif ($target eq 'edit') { 880: $result.=&Apache::edit::tag_end($target,$token); 881: } 882: return $result; 883: } 884: 885: ##------------------------------------------------------------ curve function 886: sub start_function { 887: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 888: my $result=''; 889: if ($target eq 'web' || $target eq 'tex') { 890: if (exists($curves[-1]->{'data'})) { 891: &Apache::lonxml::warning 892: ('Use of the <b>curve function</b> tag precludes use of '. 893: ' the <b>curve data</b> tag. '. 894: 'The curve data tag will be omitted in favor of the '. 895: 'curve function declaration.'); 896: delete $curves[-1]->{'data'} ; 897: } 898: my $function = &Apache::lonxml::get_all_text("/function",$parser, 899: $style); 900: $function = &Apache::run::evaluate($function,$safeeval,$$parstack[-1]); 901: $curves[-1]->{'function'} = $function; 902: } elsif ($target eq 'edit') { 903: $result .= &Apache::edit::tag_start($target,$token,'Gnuplot compatible curve function'); 904: my $text = &Apache::lonxml::get_all_text("/function",$parser,$style); 905: $result .= &Apache::edit::end_row(). 906: &Apache::edit::start_spanning_row(). 907: &Apache::edit::editline('',$text,'',60); 908: } elsif ($target eq 'modified') { 909: $result.=&Apache::edit::rebuild_tag($token); 910: $result.=&Apache::edit::modifiedfield("/function",$parser); 911: } 912: return $result; 913: } 914: 915: sub end_function { 916: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 917: my $result = ''; 918: if ($target eq 'web' || $target eq 'tex') { 919: } elsif ($target eq 'edit') { 920: $result .= &Apache::edit::end_table(); 921: } 922: return $result; 923: } 924: 925: ##------------------------------------------------------------ curve data 926: sub start_data { 927: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 928: my $result=''; 929: if ($target eq 'web' || $target eq 'tex') { 930: if (exists($curves[-1]->{'function'})) { 931: &Apache::lonxml::warning 932: ('Use of the <b>curve function</b> tag precludes use of '. 933: ' the <b>curve data</b> tag. '. 934: 'The curve function tag will be omitted in favor of the '. 935: 'curve data declaration.'); 936: delete($curves[-1]->{'function'}); 937: } 938: my $datatext = &Apache::lonxml::get_all_text("/data",$parser,$style); 939: $datatext=&Apache::run::evaluate($datatext,$safeeval,$$parstack[-1]); 940: # Deal with cases where we're given an array... 941: if ($datatext =~ /^\@/) { 942: $datatext = &Apache::run::run('return "'.$datatext.'"', 943: $safeeval,1); 944: } 945: $datatext =~ s/\s+/ /g; 946: # Need to do some error checking on the @data array - 947: # make sure it's all numbers and make sure each array 948: # is of the same length. 949: my @data; 950: if ($datatext =~ /,/) { # comma deliminated 951: @data = split /,/,$datatext; 952: } else { # Assume it's space separated. 953: @data = split / /,$datatext; 954: } 955: for (my $i=0;$i<=$#data;$i++) { 956: # Check that it's non-empty 957: if (! defined($data[$i])) { 958: &Apache::lonxml::warning( 959: 'undefined curve data value. Replacing with '. 960: ' pi/e = 1.15572734979092'); 961: $data[$i] = 1.15572734979092; 962: } 963: # Check that it's a number 964: if (! &$real_test($data[$i]) & ! &$int_test($data[$i])) { 965: &Apache::lonxml::warning( 966: 'Bad curve data value of '.$data[$i].' Replacing with '. 967: ' pi/e = 1.15572734979092'); 968: $data[$i] = 1.15572734979092; 969: } 970: } 971: # complain if the number of data points is not the same as 972: # in previous sets of data. 973: if (($curves[-1]->{'data'}) && ($#data != $#{@{$curves[-1]->{'data'}->[0]}})){ 974: &Apache::lonxml::warning 975: ('Number of data points is not consistent with previous '. 976: 'number of data points'); 977: } 978: push @{$curves[-1]->{'data'}},\@data; 979: } elsif ($target eq 'edit') { 980: $result .= &Apache::edit::tag_start($target,$token,'Comma or space deliminated curve data'); 981: my $text = &Apache::lonxml::get_all_text("/data",$parser,$style); 982: $result .= &Apache::edit::end_row(). 983: &Apache::edit::start_spanning_row(). 984: &Apache::edit::editline('',$text,'',60); 985: } elsif ($target eq 'modified') { 986: $result.=&Apache::edit::rebuild_tag($token); 987: $result.=&Apache::edit::modifiedfield("/data",$parser); 988: } 989: return $result; 990: } 991: 992: sub end_data { 993: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 994: my $result = ''; 995: if ($target eq 'web' || $target eq 'tex') { 996: } elsif ($target eq 'edit') { 997: $result .= &Apache::edit::end_table(); 998: } 999: return $result; 1000: } 1001: 1002: ##------------------------------------------------------------------- axis 1003: sub start_axis { 1004: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1005: my $result=''; 1006: if ($target eq 'web' || $target eq 'tex') { 1007: &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, 1008: $tagstack->[-1]); 1009: } elsif ($target eq 'edit') { 1010: $result .= &Apache::edit::tag_start($target,$token,'Plot Axes'); 1011: $result .= &edit_attributes($target,$token,\%axis_defaults, 1012: \@axis_edit_order); 1013: } elsif ($target eq 'modified') { 1014: my $constructtag=&Apache::edit::get_new_args 1015: ($token,$parstack,$safeeval,keys(%axis_defaults)); 1016: if ($constructtag) { 1017: $result = &Apache::edit::rebuild_tag($token); 1018: } 1019: } 1020: return $result; 1021: } 1022: 1023: sub end_axis { 1024: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1025: my $result = ''; 1026: if ($target eq 'web' || $target eq 'tex') { 1027: } elsif ($target eq 'edit') { 1028: $result.=&Apache::edit::tag_end($target,$token); 1029: } elsif ($target eq 'modified') { 1030: } 1031: return $result; 1032: } 1033: 1034: ################################################################### 1035: ## ## 1036: ## Utility Functions ## 1037: ## ## 1038: ################################################################### 1039: 1040: ##----------------------------------------------------------- set_defaults 1041: sub set_defaults { 1042: my ($var,$defaults) = @_; 1043: my $key; 1044: foreach $key (keys(%$defaults)) { 1045: $var->{$key} = $defaults->{$key}->{'default'}; 1046: } 1047: } 1048: 1049: ##------------------------------------------------------------------- misc 1050: sub get_attributes{ 1051: my ($values,$defaults,$parstack,$safeeval,$tag) = @_; 1052: foreach my $attr (keys(%{$defaults})) { 1053: if ($attr eq 'texwidth' || $attr eq 'texfont') { 1054: $values->{$attr} = 1055: &Apache::lonxml::get_param($attr,$parstack,$safeeval,undef,1); 1056: } else { 1057: $values->{$attr} = 1058: &Apache::lonxml::get_param($attr,$parstack,$safeeval); 1059: } 1060: if ($values->{$attr} eq '' | !defined($values->{$attr})) { 1061: $values->{$attr} = $defaults->{$attr}->{'default'}; 1062: next; 1063: } 1064: my $test = $defaults->{$attr}->{'test'}; 1065: if (! &$test($values->{$attr})) { 1066: &Apache::lonxml::warning 1067: ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' 1068: .$defaults->{$attr}->{'default'} ); 1069: $values->{$attr} = $defaults->{$attr}->{'default'}; 1070: } 1071: } 1072: return ; 1073: } 1074: 1075: ##------------------------------------------------------- write_gnuplot_file 1076: sub write_gnuplot_file { 1077: my ($tmpdir,$filename,$target)= @_; 1078: my $gnuplot_input = ''; 1079: my $curve; 1080: my $pt = $Apache::lonplot::plot{'texfont'}; 1081: # 1082: # Check to be sure we do not have any empty curves 1083: my @curvescopy; 1084: foreach my $curve (@curves) { 1085: if (exists($curve->{'function'})) { 1086: if ($curve->{'function'} !~ /^\s*$/) { 1087: push(@curvescopy,$curve); 1088: } 1089: } elsif (exists($curve->{'data'})) { 1090: foreach my $data (@{$curve->{'data'}}) { 1091: if (scalar(@$data) > 0) { 1092: push(@curvescopy,$curve); 1093: last; 1094: } 1095: } 1096: } 1097: } 1098: @curves = @curvescopy; 1099: # Collect all the colors 1100: my @Colors; 1101: push @Colors, $Apache::lonplot::plot{'bgcolor'}; 1102: push @Colors, $Apache::lonplot::plot{'fgcolor'}; 1103: push @Colors, (defined($axis{'color'})?$axis{'color'}:$Apache::lonplot::plot{'fgcolor'}); 1104: foreach $curve (@curves) { 1105: push @Colors, ($curve->{'color'} ne '' ? 1106: $curve->{'color'} : 1107: $Apache::lonplot::plot{'fgcolor'} ); 1108: } 1109: # set term 1110: if ($target eq 'web') { 1111: $gnuplot_input .= 'set term '.$weboutputformat .' '; 1112: $gnuplot_input .= 'transparent ' if ($Apache::lonplot::plot{'transparent'} eq 'on'); 1113: $gnuplot_input .= $Apache::lonplot::plot{'font'} . ' '; 1114: $gnuplot_input .= 'size '.$Apache::lonplot::plot{'width'}.','.$Apache::lonplot::plot{'height'}.' '; 1115: $gnuplot_input .= "@Colors\n"; 1116: # set output 1117: $gnuplot_input .= "set output\n"; 1118: } elsif ($target eq 'tex') { 1119: $gnuplot_input .= "set term postscript eps $Apache::lonplot::plot{'plotcolor'} solid \"Helvetica\" $pt \n"; 1120: $gnuplot_input .= "set output \"/home/httpd/perl/tmp/". 1121: &unescape($filename).".eps\"\n"; 1122: } 1123: # cartesian or polar plot? 1124: if (lc($Apache::lonplot::plot{'plottype'}) eq 'polar') { 1125: $gnuplot_input .= 'set polar'.$/; 1126: } else { 1127: # Assume Cartesian 1128: } 1129: # cartesian or polar grid? 1130: if (lc($Apache::lonplot::plot{'gridtype'}) eq 'polar') { 1131: $gnuplot_input .= 'set grid polar'.$/; 1132: } else { 1133: # Assume Cartesian 1134: } 1135: # solid or pattern for boxes? 1136: if (lc($Apache::lonplot::plot{'fillstyle'}) eq 'solid') { 1137: $gnuplot_input .= 'set style fill solid '. 1138: $Apache::lonplot::plot{'solid'}.$Apache::lonplot::plot{'box_border'}.$/; 1139: } elsif (lc($Apache::lonplot::plot{'fillstyle'}) eq 'pattern') { 1140: $gnuplot_input .= 'set style fill pattern '.$Apache::lonplot::plot{'pattern'}.$Apache::lonplot::plot{'box_border'}.$/; 1141: } elsif (lc($Apache::lonplot::plot{'fillstyle'}) eq 'empty') { 1142: } 1143: # margin 1144: if (lc($Apache::lonplot::plot{'lmargin'}) ne 'default') { 1145: $gnuplot_input .= 'set lmargin '.$Apache::lonplot::plot{'lmargin'}.$/; 1146: } 1147: if (lc($Apache::lonplot::plot{'rmargin'}) ne 'default') { 1148: $gnuplot_input .= 'set rmargin '.$Apache::lonplot::plot{'rmargin'}.$/; 1149: } 1150: if (lc($Apache::lonplot::plot{'tmargin'}) ne 'default') { 1151: $gnuplot_input .= 'set tmargin '.$Apache::lonplot::plot{'tmargin'}.$/; 1152: } 1153: if (lc($Apache::lonplot::plot{'bmargin'}) ne 'default') { 1154: $gnuplot_input .= 'set bmargin '.$Apache::lonplot::plot{'bmargin'}.$/; 1155: } 1156: # tic scales 1157: $gnuplot_input .= 'set ticscale '. 1158: $Apache::lonplot::plot{'major_ticscale'}.' '.$Apache::lonplot::plot{'minor_ticscale'}.$/; 1159: #boxwidth 1160: if (lc($Apache::lonplot::plot{'boxwidth'}) ne '') { 1161: $gnuplot_input .= 'set boxwidth '.$Apache::lonplot::plot{'boxwidth'}.$/; 1162: } 1163: # gridlayer 1164: $gnuplot_input .= 'set grid noxtics noytics front '.$/ 1165: if ($Apache::lonplot::plot{'gridlayer'} eq 'on'); 1166: 1167: # grid 1168: $gnuplot_input .= 'set grid'.$/ if ($Apache::lonplot::plot{'grid'} eq 'on'); 1169: # border 1170: $gnuplot_input .= ($Apache::lonplot::plot{'border'} eq 'on'? 1171: 'set border'.$/ : 1172: 'set noborder'.$/ ); 1173: # sampling rate for non-data curves 1174: $gnuplot_input .= "set samples $Apache::lonplot::plot{'samples'}\n"; 1175: # title, xlabel, ylabel 1176: # titles 1177: if ($target eq 'tex') { 1178: $gnuplot_input .= "set title \"$title\" font \"Helvetica,".$pt."pt\"\n" if (defined($title)) ; 1179: $gnuplot_input .= "set xlabel \"$xlabel\" font \"Helvetica,".$pt."pt\" \n" if (defined($xlabel)); 1180: $gnuplot_input .= "set ylabel \"$ylabel\" font \"Helvetica,".$pt."pt\"\n" if (defined($ylabel)); 1181: } else { 1182: $gnuplot_input .= "set title \"$title\" \n" if (defined($title)) ; 1183: $gnuplot_input .= "set xlabel \"$xlabel\" \n" if (defined($xlabel)); 1184: $gnuplot_input .= "set ylabel \"$ylabel\" \n" if (defined($ylabel)); 1185: } 1186: # tics 1187: if (%xtics) { 1188: $gnuplot_input .= "set xtics $xtics{'location'} "; 1189: $gnuplot_input .= ( $xtics{'mirror'} eq 'on'?"mirror ":"nomirror "); 1190: $gnuplot_input .= "$xtics{'start'}, "; 1191: $gnuplot_input .= "$xtics{'increment'}, "; 1192: $gnuplot_input .= "$xtics{'end'}\n"; 1193: if ($xtics{'minorfreq'} != 0) { 1194: $gnuplot_input .= "set mxtics ".$xtics{'minorfreq'}."\n"; 1195: } 1196: } 1197: if (%ytics) { 1198: $gnuplot_input .= "set ytics $ytics{'location'} "; 1199: $gnuplot_input .= ( $ytics{'mirror'} eq 'on'?"mirror ":"nomirror "); 1200: $gnuplot_input .= "$ytics{'start'}, "; 1201: $gnuplot_input .= "$ytics{'increment'}, "; 1202: $gnuplot_input .= "$ytics{'end'}\n"; 1203: if ($ytics{'minorfreq'} != 0) { 1204: $gnuplot_input .= "set mytics ".$ytics{'minorfreq'}."\n"; 1205: } 1206: } 1207: # axis 1208: if (%axis) { 1209: $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; 1210: $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; 1211: } 1212: # Key 1213: if (%key) { 1214: $gnuplot_input .= 'set key '.$key{'pos'}.' '; 1215: if ($key{'title'} ne '') { 1216: $gnuplot_input .= 'title "'.$key{'title'}.'" '; 1217: } 1218: $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; 1219: } else { 1220: $gnuplot_input .= 'set nokey'.$/; 1221: } 1222: # labels 1223: my $label; 1224: foreach $label (@labels) { 1225: $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. 1226: $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}; 1227: if ($target eq 'tex') { 1228: $gnuplot_input .=' font "Helvetica,'.$pt.'pt"' ; 1229: } 1230: $gnuplot_input .= $/; 1231: } 1232: if ($target eq 'tex') { 1233: $gnuplot_input .="set size 1,".$Apache::lonplot::plot{'height'}/$Apache::lonplot::plot{'width'}*1.38; 1234: $gnuplot_input .="\n"; 1235: } 1236: # curves 1237: $gnuplot_input .= 'plot '; 1238: for (my $i = 0;$i<=$#curves;$i++) { 1239: $curve = $curves[$i]; 1240: $gnuplot_input.= ', ' if ($i > 0); 1241: if (exists($curve->{'function'})) { 1242: $gnuplot_input.= 1243: $curve->{'function'}.' title "'. 1244: $curve->{'name'}.'" with '. 1245: $curve->{'linestyle'}; 1246: $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex'); 1247: if (($curve->{'linestyle'} eq 'points') || 1248: ($curve->{'linestyle'} eq 'linespoints') || 1249: ($curve->{'linestyle'} eq 'errorbars') || 1250: ($curve->{'linestyle'} eq 'xerrorbars') || 1251: ($curve->{'linestyle'} eq 'yerrorbars') || 1252: ($curve->{'linestyle'} eq 'xyerrorbars')) { 1253: $gnuplot_input.=' pointtype '.$curve->{'pointtype'}; 1254: $gnuplot_input.=' pointsize '.$curve->{'pointsize'}; 1255: } elsif ($curve->{'linestyle'} eq 'filledcurves') { 1256: $gnuplot_input.= ' '.$curve->{'limit'}; 1257: } 1258: } elsif (exists($curve->{'data'})) { 1259: # Store data values in $datatext 1260: my $datatext = ''; 1261: # get new filename 1262: my $datafilename = "$tmpdir/$filename.data.$i"; 1263: my $fh=Apache::File->new(">$datafilename"); 1264: # Compile data 1265: my @Data = @{$curve->{'data'}}; 1266: my @Data0 = @{$Data[0]}; 1267: for (my $i =0; $i<=$#Data0; $i++) { 1268: my $dataset; 1269: foreach $dataset (@Data) { 1270: $datatext .= $dataset->[$i] . ' '; 1271: } 1272: $datatext .= $/; 1273: } 1274: # write file 1275: print $fh $datatext; 1276: close ($fh); 1277: # generate gnuplot text 1278: $gnuplot_input.= '"'.$datafilename.'" title "'. 1279: $curve->{'name'}.'" with '. 1280: $curve->{'linestyle'}; 1281: $gnuplot_input.= ' linewidth 4 ' if ($target eq 'tex'); 1282: if (($curve->{'linestyle'} eq 'points') || 1283: ($curve->{'linestyle'} eq 'linespoints') || 1284: ($curve->{'linestyle'} eq 'errorbars') || 1285: ($curve->{'linestyle'} eq 'xerrorbars') || 1286: ($curve->{'linestyle'} eq 'yerrorbars') || 1287: ($curve->{'linestyle'} eq 'xyerrorbars')) { 1288: $gnuplot_input.=' pointtype '.$curve->{'pointtype'}; 1289: $gnuplot_input.=' pointsize '.$curve->{'pointsize'}; 1290: } elsif ($curve->{'linestyle'} eq 'filledcurves') { 1291: $gnuplot_input.= ' '.$curve->{'limit'}; 1292: } 1293: } 1294: } 1295: # Write the output to a file. 1296: my $fh=Apache::File->new(">$tmpdir$filename.data"); 1297: print $fh $gnuplot_input; 1298: close($fh); 1299: # That's all folks. 1300: return ; 1301: } 1302: 1303: #---------------------------------------------- check_inputs 1304: sub check_inputs { 1305: ## Note: no inputs, no outputs - this acts only on global variables. 1306: ## Make sure we have all the input we need: 1307: if (! %Apache::lonplot::plot) { &set_defaults(\%Apache::lonplot::plot,\%gnuplot_defaults); } 1308: if (! %key ) {} # No key for this plot, thats okay 1309: # if (! %axis) { &set_defaults(\%axis,\%axis_defaults); } 1310: if (! defined($title )) {} # No title for this plot, thats okay 1311: if (! defined($xlabel)) {} # No xlabel for this plot, thats okay 1312: if (! defined($ylabel)) {} # No ylabel for this plot, thats okay 1313: if ($#labels < 0) { } # No labels for this plot, thats okay 1314: if ($#curves < 0) { 1315: &Apache::lonxml::warning("No curves specified for plot!!!!"); 1316: return ''; 1317: } 1318: my $curve; 1319: foreach $curve (@curves) { 1320: if (!defined($curve->{'function'})&&!defined($curve->{'data'})){ 1321: &Apache::lonxml::warning("One of the curves specified did not contain any curve data or curve function declarations\n"); 1322: return ''; 1323: } 1324: } 1325: } 1326: 1327: #------------------------------------------------ make_edit 1328: sub edit_attributes { 1329: my ($target,$token,$defaults,$keys) = @_; 1330: my ($result,@keys); 1331: if ($keys && ref($keys) eq 'ARRAY') { 1332: @keys = @$keys; 1333: } else { 1334: @keys = sort(keys(%$defaults)); 1335: } 1336: foreach my $attr (@keys) { 1337: # append a ' ' to the description if it doesn't have one already. 1338: my $description = $defaults->{$attr}->{'description'}; 1339: $description .= ' ' if ($description !~ / $/); 1340: if ($defaults->{$attr}->{'edit_type'} eq 'entry') { 1341: $result .= &Apache::edit::text_arg 1342: ($description,$attr,$token, 1343: $defaults->{$attr}->{'size'}); 1344: } elsif ($defaults->{$attr}->{'edit_type'} eq 'choice') { 1345: $result .= &Apache::edit::select_or_text_arg 1346: ($description,$attr,$defaults->{$attr}->{'choices'},$token); 1347: } elsif ($defaults->{$attr}->{'edit_type'} eq 'onoff') { 1348: $result .= &Apache::edit::select_or_text_arg 1349: ($description,$attr,['on','off'],$token); 1350: } 1351: $result .= '<br />'; 1352: } 1353: return $result; 1354: } 1355: 1356: 1357: ################################################################### 1358: ## ## 1359: ## Insertion functions for editing plots ## 1360: ## ## 1361: ################################################################### 1362: 1363: sub insert_gnuplot { 1364: my $result = ''; 1365: # plot attributes 1366: $result .= "\n<gnuplot "; 1367: foreach my $attr (keys(%gnuplot_defaults)) { 1368: $result .= "\n $attr=\"$gnuplot_defaults{$attr}->{'default'}\""; 1369: } 1370: $result .= ">"; 1371: # Add the components (most are commented out for simplicity) 1372: # $result .= &insert_key(); 1373: # $result .= &insert_axis(); 1374: # $result .= &insert_title(); 1375: # $result .= &insert_xlabel(); 1376: # $result .= &insert_ylabel(); 1377: $result .= &insert_curve(); 1378: # close up the <gnuplot> 1379: $result .= "\n</gnuplot>"; 1380: return $result; 1381: } 1382: 1383: sub insert_tics { 1384: my $result; 1385: $result .= &insert_xtics() . &insert_ytics; 1386: return $result; 1387: } 1388: 1389: sub insert_xtics { 1390: my $result; 1391: $result .= "\n <xtics "; 1392: foreach my $attr (keys(%tic_defaults)) { 1393: $result .= "\n $attr=\"$tic_defaults{$attr}->{'default'}\" "; 1394: } 1395: $result .= "/>"; 1396: return $result; 1397: } 1398: 1399: sub insert_ytics { 1400: my $result; 1401: $result .= "\n <ytics "; 1402: foreach my $attr (keys(%tic_defaults)) { 1403: $result .= "\n $attr=\"$tic_defaults{$attr}->{'default'}\" "; 1404: } 1405: $result .= "/>"; 1406: return $result; 1407: } 1408: 1409: sub insert_key { 1410: my $result; 1411: $result .= "\n <key "; 1412: foreach my $attr (keys(%key_defaults)) { 1413: $result .= "\n $attr=\"$key_defaults{$attr}->{'default'}\""; 1414: } 1415: $result .= " />"; 1416: return $result; 1417: } 1418: 1419: sub insert_axis{ 1420: my $result; 1421: $result .= "\n <axis "; 1422: foreach my $attr (keys(%axis_defaults)) { 1423: $result .= "\n $attr=\"$axis_defaults{$attr}->{'default'}\""; 1424: } 1425: $result .= " />"; 1426: return $result; 1427: } 1428: 1429: sub insert_title { return "\n <title></title>"; } 1430: sub insert_xlabel { return "\n <xlabel></xlabel>"; } 1431: sub insert_ylabel { return "\n <ylabel></ylabel>"; } 1432: 1433: sub insert_label { 1434: my $result; 1435: $result .= "\n <label "; 1436: foreach my $attr (keys(%label_defaults)) { 1437: $result .= "\n $attr=\"". 1438: $label_defaults{$attr}->{'default'}."\""; 1439: } 1440: $result .= "></label>"; 1441: return $result; 1442: } 1443: 1444: sub insert_curve { 1445: my $result; 1446: $result .= "\n <curve "; 1447: foreach my $attr (keys(%curve_defaults)) { 1448: $result .= "\n $attr=\"". 1449: $curve_defaults{$attr}->{'default'}."\""; 1450: } 1451: $result .= " >"; 1452: $result .= &insert_data().&insert_data()."\n </curve>"; 1453: } 1454: 1455: sub insert_function { 1456: my $result; 1457: $result .= "\n <function></function>"; 1458: return $result; 1459: } 1460: 1461: sub insert_data { 1462: my $result; 1463: $result .= "\n <data></data>"; 1464: return $result; 1465: } 1466: 1467: ##---------------------------------------------------------------------- 1468: 1; 1469: __END__ 1470: 1471: