1################################################################
2# copyright (c) 2012, 2014 by William R. Pearson and The Rector &
3# Visitors of the University of Virginia */
4################################################################
5# Licensed under the Apache License, Version 2.0 (the "License");
6# you may not use this file except in compliance with the License.
7# You may obtain a copy of the License at
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing,
12# software distributed under this License is distributed on an "AS
13# IS" BASIS, WITHOUT WRRANTIES OR CONDITIONS OF ANY KIND, either
14# express or implied.  See the License for the specific language
15# governing permissions and limitations under the License.
16################################################################
17
18#define SX(x) (int)((double)(x)*fxscal+fxoff+24)
19sub SX {
20  my $xx = shift;
21  return int($xx*$fxscal+$fxoff+24);
22}
23
24#define SY(y) (int)((double)(y)*fyscal+fyoff+48)
25sub SY {
26  my $yy = shift;
27  return int($yy*$fyscal+$fyoff+84);
28}
29
30# alignment lines: black blue cyan green lt_green */
31my @rlincol=(0.0,0.0,0.0,0.45,0.0);
32my @glincol=(0.0,0.0,0.5,0.30,1.0);
33my @blincol=(0.0,0.8,0.5,0.15,0.0);
34
35my @line_colors=qw(black blue cyan green lightgreen);
36my @block_colors = qw( slategrey lightgreen lightblue pink cyan tan gold plum mediumplum );
37
38# domain blocks: grey blue cyan green lt_green
39my @rblk_col=(0.33, 0.0, 0.0, 0.45, 0.0);
40my @gblk_col=(0.33, 0.0, 0.5, 0.30, 1.0);
41my @bblk_col=(0.33, 0.8, 0.5, 0.15, 0.0);
42
43# void openplt(long n0, long n1, int sq0off, int sq1off, char *xtitle, char *ytitle)
44sub openplt {
45  my ($n0, $n1, $sq0off, $sq1off, $xtitle, $ytitle, $x_annot_r, $y_annot_r, $have_zdb, $have_bits) = @_;
46
47  if ($lvstr) {
48    @elinval = split(/\s+/,$lvstr);
49  }
50  elsif ($ENV{LINEVAL}) {
51    @elinval = split(/\s+/,$ENV{LINEVAL});
52  }
53
54## 8.5 x 11 paper is 612 pt x 792 pt -- important to stay on one page, with comments
55## max_x, max_y are set to 540 pt -- 7.5 in, 9pt (0.75 in) margins, leaving little extra space
56## if comments are provided, max_x, max_y must be reduced (max_x for space, max_y to keep things square)
57##
58
59  my ($xbound, $ybound) = ($max_x + 24, $max_y + 72);
60  if ($x_annot_r) {$ybound += 64;}
61  if ($y_annot_r) {
62    $xbound += 100;
63    $max_x -= $max_x/10;
64    $max_y -= $max_x/10;
65  }
66
67  print("%!PS-Adobe-2.0\n");
68  print("%%Creator: plalign\n");
69  print("%%CreationDate: %s","2012-01-01");
70  print("%%DocumentFonts: Courier\n");
71  print("%%Pages: 1\n");
72  print("%%BoundingBox: 18 18 $xbound $ybound\n");
73  print("%%EndComments\n");
74  print("%%EndProlog\n");
75  print("%%Page: 1 1\n");
76  print("/Courier findfont 14 scalefont setfont\n");
77  print("/vcprint { gsave 90 rotate dup stringwidth pop 2 div neg 0 rmoveto\n");
78  print("show newpath stroke grestore } def\n");
79  print("/vprint { gsave 90 rotate\n");
80  print("show newpath stroke grestore } def\n");
81  print("/hcprint { gsave dup stringwidth pop 2 div neg 0 rmoveto\n");
82  print("show newpath stroke grestore } def\n");
83  print("/hrprint { gsave dup stringwidth pop neg 0 rmoveto\n");
84  print("show newpath stroke grestore } def\n");
85  print("/hprint { gsave show newpath stroke grestore } def\n");
86  # % x y w h RT - % draw a rectangle size w h at x y
87  print("/RT { [ ] 0 setdash newpath 4 -2 roll moveto dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath }  def \n");
88
89  ($pmaxx, $pmaxy) = ($n0, $n1);
90
91# $max_x, $max_y define the maximum plotting area
92# the actual bounding box/view area will be larger if annotation comments are available
93
94  $fxscal = ($max_x-1)/$n1;
95  $fyscal = ($max_y-1)/$n0;
96
97  if ($fxscal > $fyscal) {$fxscal = $fyscal;}
98  else {$fyscal = $fxscal;}
99
100  if ($fyscal * $n0 < $max_y/5.0) {
101    $fyscal = ($max_y-1)/($n0*5.0);
102  }
103
104  $fxscal *= 0.9; $fxoff = ($max_x-1)/11.0;
105  $fyscal *= 0.9; $fyoff = ($max_y-1)/11.0;
106
107  printf("%% openplt - frame - %ld %ld\n", $n0, $n1);
108
109  # draw the plot frame
110  linetype(0);
111  print("gsave\n");
112  print("currentlinewidth 1.5 mul setlinewidth\n");
113  newline();
114  move(SX(0),SY(0));
115  draw(SX(0),SY($n1+1));
116  draw(SX($n0+1),SY($n1+1));
117  draw(SX($n0+1),SY(0));
118  draw(SX(0),SY(0));
119  clsline($n0,$n1,100000);
120  print("grestore\n");
121
122  my $n_div = 11;
123  xaxis($n0,$sq1off, $xtitle, $n_div);
124
125  $n_div = 21 unless $n0 == $n1;
126  yaxis($n1,$sq0off, $ytitle, $n_div);
127  legend($have_zdb, $have_bits);
128
129  print("%% openplt done\n");
130
131  if ($x_annot_r) {xgrid($x_annot_r, $n0, $sq0off, $n1, $sq1off);}
132  if ($y_annot_r) {ygrid($y_annot_r, $n0, $sq0off, $n1, $sq1off);}
133}
134
135#void drawdiag(long n0, long n1)
136sub drawdiag  {
137  my ($n0, $n1) = @_;
138  linetype(0);
139  printf("%% drawdiag %ld %ld\n",$n0, $n1);
140  print("gsave\n");
141  print("currentlinewidth 1.5 mul setlinewidth\n");
142  newline();
143  move(SX(0),SY(0));
144  draw(SX($n0+1),SY($n1+1));
145  clsline($n0,$n1,10000);
146  print("grestore\n");
147  print("%% drawdiag done\n");
148}
149
150# tick array - values */
151my @tarr = (10,20,50,100,200,500,1000,2000,5000,10000,20000,50000,100000,200000,500000,1000000);
152
153# void xaxis(long n, int offset, char *title)
154sub xaxis {
155  my ($n, $offset, $title, $n_div) = @_;
156
157  my ($i, $jm, $tick);
158  my ($js, $jo, $jl);
159  my $num_len;
160  my $numstr;
161
162  $tick = 6;
163
164  # search for the correct increment for the tick array */
165  for ($i=0; $i< @tarr; $i++) {
166    # seek to divide into 20 or fewer divisions */
167    if (($jm = $n/$tarr[$i])<$n_div) {goto found;}
168  }
169  $i=scalar(@tarr)-1;
170  $jm = $n/$tarr[$i];
171 found:
172  # js is the start of the value - modify to accomodate offset */
173  $js = $tarr[$i];
174
175  # jo is the offset */
176  $jo = ($offset-1) % $tarr[$i];	# figure out offset in tarr[i] increments */
177
178  # jl is the label */
179  $jl = ($offset-1)/$tarr[$i];	# figure out offset in tarr[i] increments */
180  $jl *= $tarr[$i];
181
182  newline();
183  for ($i=1; $i<=$jm; $i++) {
184    move(SX($i*$js - $jo),SY(0));
185    draw(SX($i*$js - $jo),SY(0)-$tick);
186  }
187  clsline($n,$n,10000);
188
189  $numstr = sprintf("%ld",$js + $jl );
190  $num_len = length($numstr);
191
192  if ($num_len > 4) {
193    move(SX($js-$jo),SY(0)-$tick-16);
194    printf("(%s) hcprint\n",$numstr);
195
196    $numstr=sprintf("%ld",$jm*$js+$jl);
197    move(SX($jm*$js-$jo),SY(0)-$tick-16);
198    printf("(%s) hcprint\n",$numstr);
199  }
200  else {	# put in all the axis values */
201    for ($i=1; $i<=$jm; $i++) {
202      $numstr=sprintf("%ld",$i*$js+$jl);
203      move(SX($i*$js-$jo),SY(0)-$tick-16);
204      printf("(%s) hcprint\n",$numstr);
205    }
206  }
207
208  print("newpath\n");
209  move(SX($n/2),SY(0)-$tick-30);
210
211#  for (bp = strchr(title,'('); (bp!=NULL); bp = strchr(bp+1,'(')) *bp=' ';
212#  for (bp = strchr(title,')'); (bp!=NULL); bp = strchr(bp+1,')')) *bp=' ';
213  $title =~ s/\(/ /g;
214  $title =~ s/\)/ /g;
215  printf("(%s) hcprint\n",$title);
216}
217
218# void yaxis(long n, int offset, char *title)
219sub yaxis {
220  my ($n, $offset, $title, $n_div) = @_;
221
222  my  ($i, $jm, $tick);
223  my ($js, $jo, $jl);
224  my ($num_len, $numstr);
225
226  $tick = 6;
227
228  for ($i=0; $i<@tarr; $i++) {
229    if (($jm = $n/$tarr[$i])<$n_div) {goto found;}
230  }
231  $jm = $n/5000;
232  $i= scalear(@tarr)-1;
233
234 found:
235  $js = $tarr[$i];
236
237  # $jo is the offset */
238  $jo = ($offset-1) % $tarr[$i];	# figure out offset in tarr[i] increments */
239  # jl is the label */
240  $jl = ($offset-1)/$tarr[$i];	# figure out offset in tarr[i] increments */
241  $jl *= $tarr[$i];
242
243  newline();
244  for ($i=1; $i<=$jm; $i++) {
245    move(SX(0),SY($i*$js-$jo));
246    draw(SX(0)-$tick,SY($i*$js-$jo));
247  }
248  clsline($n,$n,10000);
249
250  $numstr = sprintf("%ld",$js+$jl);
251
252  $num_len = length($numstr);
253
254  if ($num_len > 4) {
255    move(SX(0)-$tick-4,SY($js-$jo)-4);
256    printf("(%s) hrprint\n",$numstr);
257
258    $numstr = sprintf("%ld",$jm*$js+$jl);
259    move(SX(0)-$tick-4,SY($jm*$js-$jo)-4);
260    printf("(%s) hrprint\n",$numstr);
261  }
262  else {
263    for ($i=1; $i<=$jm; $i++) {
264      $numstr = sprintf("%ld",$i*$js+$jl);
265      move(SX(0)-$tick-4,SY($i*$js-$jo)-4);
266      printf("(%s) hrprint\n",$numstr);
267    }
268  }
269
270  move(SX(0)-$tick-42,SY($n/2));
271#  for (bp = strchr(title,'('); (bp!=NULL); bp = strchr(bp+1,'(')) *bp=' ';
272#  for (bp = strchr(title,')'); (bp!=NULL); bp = strchr(bp+1,')')) *bp=' ';
273  $title =~ s/\(/\\(/g;
274  $title =~ s/\)/\\)/g;
275  printf("(%s) vcprint\n",$title);
276
277}
278
279sub xgrid {
280  my ($annot_arr_r, $n0, $sq0_off, $n1, $sq1_off) = @_;
281
282  my $sq_off = $sq0_off;
283
284  my $show_block = 1;
285  my $text_offset = 8;
286  if ($show_block) {$text_offset = 24;}
287  my $color = 1;
288
289  print("%% xgrid: $n0 $n1\n");
290  print("gsave\n");
291  print("/Courier findfont 11 scalefont setfont\n");
292  print("currentlinewidth 0.5 mul setlinewidth\n");
293  for my $annot ( @$annot_arr_r) {
294    next unless $annot->{beg} >= $sq_off;
295    next if ($annot->{end} > $sq_off + $n0 - 1);
296    last if ($annot->{beg} > $sq_off + $n0 - 1);
297    newline();
298    print("0.33 0.33 0.33 setrgbcolor\n");
299    move(SX($annot->{beg}-$sq_off),SY(0));
300    print("[3 6] 0 setdash\n");
301    draw(SX($annot->{beg}-$sq_off),SY($n1));
302    clsline();
303    newline();
304    print("0.33 0.33 0.33 setrgbcolor\n");
305    move(SX($annot->{end}-$sq_off),SY(0));
306    print("[6 3] 0 setdash\n");
307    draw(SX($annot->{end}-$sq_off),SY($n1));
308    clsline();
309
310    # show rotated label
311    my $xpos = SX(($annot->{end} - $annot->{beg})/2 + $annot->{beg} - $sq_off) + 4;
312    my $ypos = SY($n1) + $text_offset;
313    # printf("<text x=\"0\" y=\"0\" text-anchor=\"left\" transform=\"translate($xpos, $ypos) rotate(-90,0,0)\">%s</text>\n",$annot->{sdescr});
314    if ($show_block) {
315      draw_block(SX($annot->{beg} - $sq_off), SY($n1) + 6,
316		 SX($annot->{end} - $sq_off)-SX($annot->{beg} - $sq_off),12,
317		 $annot_names{$annot->{sname}});
318    }
319    move($xpos, $ypos);
320    my $str = $annot->{sdescr};
321    $str =~ s/\(/\\(/g;
322    $str =~ s/\)/\\)/g;
323    print "($str) vprint\n";
324  }
325  print("grestore\n");
326}
327
328sub ygrid {
329  my ($annot_arr_r, $n0, $sq0_off, $n1, $sq1_off) = @_;
330
331  my $sq_off = $sq1_off;
332
333  my $show_block = 1;
334
335  my $text_offset = 8;
336  if ($show_block) {$text_offset = 24;}
337  my $color=4;
338
339  print("gsave\n");
340  print("/Courier findfont 11 scalefont setfont\n");
341  print("currentlinewidth 0.5 mul setlinewidth\n");
342  for my $annot ( @$annot_arr_r) {
343    next unless $annot->{beg} >= $sq_off;
344    next if ($annot->{end} > $sq_off + $n1 - 1);
345    last if ($annot->{beg} > $sq_off + $n1 - 1);
346    newline();
347    print("0.33 0.33 0.33 setrgbcolor\n");
348    move(SX(0), SY($annot->{beg}-$sq_off));
349    print("[3 6] 0 setdash\n");
350    draw(SX($n0), SY($annot->{beg}-$sq_off));
351    clsline();
352    newline();
353    move(SX(0), SY($annot->{end}-$sq_off));
354    print("[6 3] 0 setdash\n");
355    draw(SX($n0), SY($annot->{end}-$sq_off));
356    clsline();
357
358    my $xpos = SX($n0) + $text_offset;
359    my $ypos = SY(($annot->{end} - $annot->{beg})/2 + $annot->{beg} - $sq_off) - 3;
360
361    if ($show_block) {
362      draw_block(SX($n0)+6, SY($annot->{beg} - $sq_off), 12,
363		 SY($annot->{end} - $sq_off)-SY($annot->{beg} - $sq_off),
364		 $annot_names{$annot->{sname}});
365    }
366
367#    printf("<text x=\"$xpos\" y=\"$ypos\" text-anchor=\"left\">%s</text>\n",$annot->{sdescr});
368    move($xpos, $ypos);
369    my $str = $annot->{sdescr};
370    $str =~ s/\(/\\(/g;
371    $str =~ s/\)/\\)/g;
372    print "($str) hprint\n";
373  }
374  print("grestore\n");
375}
376
377sub draw_block {
378  my ($x, $y, $w, $h, $color) = @_;
379
380  $color = ($color % scalar(@block_colors));
381  my $rgb = $color_names{$block_colors[$color]};
382
383# color is index into @[rgb]blk_color
384  print "gsave\n";
385
386  printf("%.3f %.3f %.3f setrgbcolor\n",
387	 $rgb->[0]/255,$rgb->[1]/255,$rgb->[2]/255);
388
389  printf "%d %d %d %d RT\n",$x+1,$y+1,$w-2,$h-2;
390  print "fill\n";
391  print "stroke\n";
392
393  print "1.0 1.0 1.0 setrgbcolor\n";
394  print "$x $y $w $h RT\n";
395  print "stroke\n";
396  print "grestore\n";
397}
398
399# void legend()
400sub legend {
401  my ($have_zdb, $have_bits) = @_;
402
403  my ($i, $last);
404  my ($ixp, $iyp);
405  my $numstr;
406  my @xpos=(144,144,288,288,432);
407  my @ypos=(36,18,36,18,27);
408
409  if ($have_zdb || $have_bits) {$last = 5;}
410  else {$last = 4;}
411
412  move(60,27+18);
413  if ($have_zdb)  {draw_str("E():  ");}
414  elsif ($have_bits) {draw_str("Bits:  ");}
415
416  for ($i=0; $i<$last ; $i++) {
417    print("gsave currentlinewidth 1.5 mul setlinewidth\n");
418    newline();
419    linetype($i);
420    move($xpos[$i]-36,$ypos[$i]+18);
421    draw($xpos[$i]+24,$ypos[$i]+18);
422    clsline(1000,1000,10000);
423    print("grestore\n");
424    move($xpos[$i]+36,$ypos[$i]-4+18);
425    if ($have_zdb) {
426      if ($i==4) {$numstr = sprintf(">%.1lg",$elinval[3]);}
427      else {$numstr = sprintf("<%.1lg",$elinval[$i]);}
428    }
429    elsif ($have_bits) {
430      if ($i==4) {$numstr = sprintf("<%.1lf",$blinval[3]);}
431      else {$numstr = sprintf(">=%.1lf",$blinval[$i]);}
432    }
433    else {
434      if ($i==3) {$numstr = sprintf("<%d",$ilinval[3]);}
435      else {$numstr = sprintf(">%d",$ilinval[$i]);}
436    }
437    printf("(%s) hprint\n",$numstr);
438  }
439}
440
441#void linetype(type)
442sub linetype {
443  my $type = shift;
444
445  my $rgb_name = $line_colors[$type];
446  my $rgb = $color_names{$rgb_name};
447
448  printf("%5.3f %5.3f %5.3f setrgbcolor\n",
449	 $rgb->[0]/256, $rgb->[1]/256, $rgb->[2]/256);
450}
451
452#void closeplt()
453sub closeplt {
454  print("%%Trailer\n");
455  print("showpage\n");
456  print("%%EOF\n");
457}
458
459# void opnline(int s, double bits)
460sub opnline {
461  my ($s, $bits) = shift;
462
463  my $e_val;
464
465  if ($have_zdb) {
466    $e_val = bit_to_E($bits);
467    if ($e_val < $elinval[0]) {linetype(0);}
468    elsif ($e_val < $elinval[1]) {linetype(1);}
469    elsif ($e_val < $elinval[2]) {linetype(2);}
470    elsif ($e_val < $elinval[3]) {linetype(3);}
471    else {linetype(4);}
472  }
473  elsif ($have_bits) {
474    if ($bits >= $blinval[0]) {linetype(0);}
475    elsif ($bits >= $blinval[1]) {linetype(1);}
476    elsif ($bits >= $blinval[2]) {linetype(2);}
477    elsif ($bits >= $blinval[3]) {linetype(3);}
478    else {linetype(4);}
479  }
480  else {
481    if ($s > $ilinval[0]) {linetype(0);}
482    elsif ($s > $ilinval[1]) {linetype(1);}
483    elsif ($s > $ilinval[2]) {linetype(2);}
484    else {linetype(3);}
485  }
486
487  print("newpath\n");
488}
489
490# void newline()
491sub newline {
492  print("0 0 0 setrgbcolor\n newpath\n");
493}
494
495# void clsline(long x,long y,int s)
496sub clsline {
497  print("stroke\n");
498}
499
500# void move(int x, int y)
501sub move {
502  my ($xx, $yy) = @_;
503
504  printf("%d %d moveto\n",$xx,$yy);
505}
506
507# void sxy_move(int x, int y)
508sub sxy_move {
509  my ($x, $y) = @_;
510  printf("%d %d moveto\n",SX($x),SY($y));
511}
512
513# void draw(int x, int y)
514sub draw {
515  my ($x,$y) = @_;
516  printf("%d %d lineto\n",$x,$y);
517}
518
519# void sxy_draw(int x, int y)
520sub sxy_draw {
521  my ($x,$y) = @_;
522  printf("%d %d lineto\n",SX($x),SY($y));
523}
524
525#void draw_str(char *str)
526sub draw_str
527{
528  my $str = shift;
529
530#  for (bp = strchr(str,'('); (bp!=NULL); bp = strchr(bp+1,'(')) *bp=' ';
531#  for (bp = strchr(str,')'); (bp!=NULL); bp = strchr(bp+1,')')) *bp=' ';
532
533  $str =~ s/\(/\\(/g;
534  $str =~ s/\)/\\)/g;
535
536  printf("(%s) show\n",$str);
537}
538
539#void cal_coord(int n0, int n1, long *a_start0, long *a_stop0, long *a_start1, long *a_stop1 )
540sub cal_coord {}
541