| 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 |
|
|
| 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) { |
| 393 |
|
@overlayRect = (0, 0, @picWH); |
| 394 |
< |
} |
| 396 |
< |
if ($overlayRect[2] <= $overlayRect[0] || |
| 394 |
> |
} elsif ($overlayRect[2] <= $overlayRect[0] || |
| 395 |
|
$overlayRect[3] <= $overlayRect[1]) { |
| 396 |
|
die("Illegal overlay rectangle\n"); |
| 397 |
|
} |
| 407 |
|
if ($cheight < 10) { |
| 408 |
|
die "Overlay matrix spacing too tight\n"; |
| 409 |
|
} |
| 410 |
< |
my $cmd1 = qq[pcompos -x $cropWH[0] -y $cropWH[1] "$picture" @overlayRect[0..1]]; |
| 410 |
> |
my $cmd1 = qq[pcompos -x $cropWH[0] -y $cropWH[1] "$picture"] . |
| 411 |
> |
qq[ -$overlayRect[0] -$overlayRect[1]]; |
| 412 |
|
$cmd1 .= qq[ | pfilt -1 -b -x /$cheight -y /$cheight]; |
| 413 |
|
$cmd1 .= qq[ | pfilt -1 -r .5 -x $cropWH[0] -y $cropWH[1]]; |
| 414 |
|
$cmd1 .= qq[ | pvalue -o -h -H -b -d -e $mult]; |
| 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'; |
| 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"; |
| 517 |
< |
exit $?; |
| 515 |
> |
system $cmd; |
| 516 |
|
|
| 517 |
|
#EOF |
