bin/objline.pl
changeset 2 d59fbab896ad
child 32 ea86d26c63ed
equal deleted inserted replaced
1:869909d14a39 2:d59fbab896ad
       
     1 #!/usr/bin/perl -w
       
     2 
       
     3 use strict;
       
     4 use warnings;
       
     5 use File::Temp qw/ tempdir /;
       
     6 use File::Basename;
       
     7 
       
     8 #my $td = tempdir( CLEANUP => 0 );
       
     9 my $td = "/tmp/objline";
       
    10 mkdir $td;
       
    11 #print "Temdir: $td\n";
       
    12 my @rad = ();
       
    13 my @prllmgf = ();
       
    14 my @oblqmgf = ();
       
    15 
       
    16 #my $name;
       
    17 #my $path;
       
    18 #my $extn;
       
    19 my $fn = "";
       
    20 
       
    21 my $oblqxf = "-rz 45 -ry 45";
       
    22 
       
    23 if ($#ARGV < 0) {
       
    24 	# Input is from STDIN: Capture to file
       
    25 	open(FH, ">$td/stdin.rad");
       
    26 	while (<>) {
       
    27 		print FH;
       
    28 	}
       
    29 	close FH;
       
    30 	# Pretend stdin.rad was passed as a filename
       
    31 	@ARGV = ("$td/stdin.rad");
       
    32 }
       
    33 
       
    34 foreach (@ARGV) {
       
    35 	my ($name, $path, $extn) = fileparse($_);
       
    36 	$fn = $name.$extn;
       
    37 	push(@rad, "$td/$fn.orig");
       
    38 	push(@prllmgf, "$td/$fn.orig.mgf");
       
    39 	push(@oblqmgf, "$td/$fn.oblq.mgf");
       
    40 
       
    41 	# Expand in-line commands such as !genbox
       
    42 	system "xform $_ > $td/$fn.orig";
       
    43 	system "rad2mgf $td/$fn.orig > $td/$fn.orig.mgf";
       
    44 
       
    45 	open (FH, ">$td/$fn.oblq.mgf");
       
    46 	print FH "i $fn.orig.mgf $oblqxf > $td/$fn.oblq.mgf\n";
       
    47 	close (FH);
       
    48 }
       
    49 
       
    50 my $rce = '\'xm=($1+$2)/2;ym=($3+$4)/2;zm=($5+$6)/2';
       
    51 $rce .= ';max(a,b):if(a-b,a,b);r=max(max($2-$1,$4-$3),$6-$5)*.52';
       
    52 $rce .= ';$1=xm-r;$2=xm+r;$3=ym-r;$4=ym+r;$5=zm-r;$6=zm+r\'';
       
    53 
       
    54 my $rads = join(' ', @rad);
       
    55 my $prlldim = `getbbox -h $rads |rcalc -t' ' -e $rce`;
       
    56 chomp($prlldim);
       
    57 print "prlldim: $prlldim\n";
       
    58 my $oblqdim = `xform $oblqxf $rads |getbbox -h|rcalc -t' ' -e $rce`;
       
    59 chomp($oblqdim);
       
    60 print "oblqdim: $oblqdim\n";
       
    61 
       
    62 my $prlls = join(' ', @prllmgf); #!!!
       
    63 print "prlls: $prlls\n";
       
    64 my $oblqs = join(' ', @oblqmgf);
       
    65 my $cmd;
       
    66 foreach ('x', 'y', 'z') {
       
    67 	$cmd = "mgf2meta -t .005 $_ " . $prlldim . ' ' . $prlls . " >$td/$_.mta";
       
    68 	#system "mgf2meta -t .005 $_ $prlldim $prlls >$td/$_.mta";
       
    69 	system "$cmd";
       
    70 }
       
    71 $cmd = "mgf2meta -t .005 x " . $oblqdim . ' ' . $oblqs . " >$td/o.mta";
       
    72 system "$cmd";
       
    73 
       
    74 system("plot4", "$td/x.mta", "$td/y.mta", "$td/z.mta", "$td/o.mta");
       
    75 
       
    76 #EOF