4 |
|
use warnings; |
5 |
|
use strict; |
6 |
|
use File::Temp qw/ tempdir /; |
7 |
– |
use POSIX qw/ floor /; |
7 |
|
|
8 |
|
my @palettes = ('def', 'spec', 'pm3d', 'hot', 'eco', 'tbo'); |
9 |
|
|
285 |
|
my $fcimg = "$td/$pal.hdr"; |
286 |
|
my $lbimg = "$td/${pal}_label.hdr"; |
287 |
|
system "psign -cb 0 0 0 -cf 1 1 1 -h 20 $pal > $lbimg"; |
289 |
– |
|
288 |
|
my $cmd = qq[pcomb $pc0args -e "v=x/256"]; |
289 |
|
$cmd .= qq[ -e "ro=clip(${pal}_red(v));go=clip(${pal}_grn(v));bo=clip(${pal}_blu(v))"]; |
290 |
|
$cmd .= qq[ -x 256 -y 30 > $fcimg]; |
321 |
|
my $cmd; |
322 |
|
if ($legwidth > 0) { |
323 |
|
# Legend: Create the text labels |
324 |
< |
my $sheight = floor($legheight / $ndivs ); |
325 |
< |
my $theight = floor($legwidth/(8/1.67)); |
324 |
> |
my $sheight = int($legheight / $ndivs ); |
325 |
> |
my $theight = int($legwidth/(8/1.67)); |
326 |
|
my $stheight = $sheight <= $theight ? $sheight : $theight; |
327 |
< |
my $vlegheight = $sheight * $ndivs * (1+1.5/$ndivs); |
327 |
> |
my $vlegheight = int($sheight * $ndivs * (1+1.5/$ndivs)); |
328 |
|
my $tslabpic = "$td/slabT.hdr"; |
329 |
|
system "psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight $label > $tslabpic"; |
330 |
|
my $loop = $ndivs+$haszero; |
331 |
< |
my $hlegheight = $sheight * ($loop) + $sheight * .5; |
331 |
> |
my $hlegheight = int($sheight * ($loop) + $sheight * .5); |
332 |
|
my $pcompost = qq[pcompos -b 0 0 0 =-0 $tslabpic 0 $hlegheight ]; |
333 |
|
for (my $i=0; $i<$loop; $i++) { |
334 |
|
my $imap = ($ndivs - $i) / $ndivs; |
346 |
|
} |
347 |
|
$tslabpic = "$td/slab$i.hdr"; |
348 |
|
system "psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $stheight $value > $tslabpic"; |
349 |
< |
$hlegheight = $sheight * ($loop - $i - 1) + $sheight * .5; |
349 |
> |
$hlegheight = int($sheight * ($loop - $i - 1) + $sheight * .5); |
350 |
|
$pcompost .= qq[=-0 $tslabpic 0 $hlegheight ]; |
351 |
|
} |
352 |
|
$pcompost .= qq[ > $slabpic]; |
371 |
|
my $slabinvpic = "$td/slabinv.hdr"; |
372 |
|
system qq[pcomb -e "lo=1-gi(1)" $slabpic > $slabinvpic]; |
373 |
|
|
374 |
< |
my $sh0 = -floor($legheight / $ndivs / 2); |
374 |
> |
my $sh0 = -int($legheight / $ndivs / 2); |
375 |
|
if ($haszero < 1) { |
376 |
< |
$sh0 = -floor($legheight / ($ndivs)*1.5); |
376 |
> |
$sh0 = -int($legheight / ($ndivs)*1.5); |
377 |
|
} |
378 |
|
|
379 |
|
# Command line without extrema |
386 |
|
my $cheight = 32; |
387 |
|
|
388 |
|
if ($overlayWH[0] && $overlayWH[1]) { |
389 |
< |
# Overlay picture matrix values |
389 |
> |
# Overlay picture matrix values |
390 |
|
my @picWH = split ' ', `getinfo -d < $picture`; |
391 |
|
@picWH = ($picWH[3], $picWH[1]); |
392 |
|
if ($#overlayRect != 3) { |
426 |
|
my $pscmd = qq[psign -s -.15 -cf 1 1 1 -cb 0 0 0 -h $cheight]; |
427 |
|
for (my $y = 0; $y < $cropWH[1]; $y++) { |
428 |
|
my $ymatch = grep /^$y$/, @ypos; |
429 |
+ |
my $cmd2 = qq[pcompos -b 0 0 0 -x $cropWH[0]]; |
430 |
|
for (my $x = 0; $x < $cropWH[0]; $x++) { |
431 |
|
my $sampv = <FHsamp>; |
432 |
|
next if (! $ymatch); |
437 |
|
my $manti = $1; |
438 |
|
my $mantf = $2; |
439 |
|
my $expi = $3; |
440 |
< |
if ($expi < -4) { |
440 |
> |
if ($expi < -3) { |
441 |
|
# use exponent format |
442 |
|
} elsif ($expi < 0) { |
443 |
|
my $pref = '0.'; |
447 |
|
$sampv = $pref . $manti . $mantf; |
448 |
|
} elsif ($expi < length($mantf)) { |
449 |
|
$sampv = sprintf("%g", $sampv); |
450 |
< |
} elsif ($expi <= 8) { |
450 |
> |
} elsif ($expi <= 6) { |
451 |
|
$sampv = $manti . $mantf; |
452 |
|
for (my $i = $expi - length($mantf); $i-- > 0; ) { |
453 |
|
$sampv .= '0'; |
454 |
|
} |
455 |
|
} # else use exponent format |
456 |
< |
$cmd1 .= qq[ =00 "!$pscmd $sampv" $x ] . ($cropWH[1]-1 - $y); |
456 |
> |
$cmd2 .= qq[ =0- "!$pscmd $sampv" $x 0]; |
457 |
|
} |
458 |
+ |
next if (! $ymatch); |
459 |
+ |
my $rowpic = "$td/mrow$y.hdr"; |
460 |
+ |
system "$cmd2 > $rowpic"; |
461 |
+ |
$cmd1 .= qq[ =-0 $rowpic 0 ] . ($cropWH[1]-1 - $y); |
462 |
|
} |
463 |
|
close(FHsamp); |
464 |
|
my $overpic = "$td/overlay.hdr"; |
465 |
|
system "$cmd1 > $overpic"; |
463 |
– |
die "Error creating overlay matrix image\n" if ($?); |
466 |
|
my $overinvpic = "$td/overinv.hdr"; |
467 |
|
system qq[pcomb -e "lo=1-gi(1)" $overpic > $overinvpic]; |
468 |
|
my $xleft = $legwidth + $overlayRect[0]; |
508 |
|
$cmd .= qq[ =00 $minvpic $lxmin $ymin =00 $maxvpic $lxmax $ymax]; |
509 |
|
} |
510 |
|
|
511 |
< |
# Clean up and simplify info header with out command arguments |
512 |
< |
$cmd .= qq[ | getinfo -r "pcompos " "falsecolor @savedARGV"]; |
511 |
> |
# Clean up and simplify info header without constituent commands |
512 |
> |
$cmd .= qq[ | getinfo -r "EXPOSURE" "pcompos " "falsecolor @savedARGV"]; |
513 |
|
|
514 |
|
# Process image and combine with legend |
515 |
< |
system "$cmd"; |
514 |
< |
exit $?; |
515 |
> |
exec $cmd; |
516 |
|
|
517 |
|
#EOF |