old/PAS/RayTracing/InpSet.pl

#c:\Perl\bin\Perl.exe -w

$TRAHeader = "\013Rod'sTracer";
$curver    = 0x00010001;
%OBJId = ('obj_sphere',0,'light_omni',1,'viewport',2,'ambient',3,'obj_plane',4,
	  'null',5,'camera',6,'tri_plane',7,'tri',8,'quad',9,'translate',10,
	  'rotate',11,'scale',12,'spot',13,'texture',14,'intersphere',15,'cone',16);


if (@ARGV < 1 ) 
{
  die  "Usage: InpSet.pl <infile.txt> [outfile.tra]\n";
}

if (!-f $ARGV[0])
{
  die "Error opening $ARGV[0]\n";
}

$INname =  $ARGV[0];
$ARGV[0] =~ /(.+)\../;
$OUTname = $1.'.tra';
if (defined $ARGV[1])
 {
   $OUTname = $ARGV[1] 
 }

open IN, "<$INname" ||
  die "Error opening $INname:$!\n";
open OUT, ">$OUTname" ||
  die "Error opening $OUTname:$!\n";

print OUT $TRAHeader;
print OUT pack('L',$curver);

while (<IN>)
{ 
  chomp;
  next if (/^$/ || /^\s*#/);
  /^\s*sphere\s*\{/i 		&& loadSphere();
  /^\s*((cone)||(cyl))\s*\{/i 	&& loadCone();
  /^\s*ambient\s*\{/i 		&& loadAmbient();
  /^\s*plane\s*\{/i  		&& loadPlane();
  /^\s*viewport\s*\{/i		&& loadViewport();
  /^\s*camera\s*\{/i		&& loadCamera();
  /^\s*omni\s*\{/		&& loadOmni();
  /^\s*tri_plane\s*\{/		&& loadTriPlane();
  /^\s*tri\s*\{/		&& loadTri();
  /^\s*quad\s*\{/		&& loadQuad();
  /^\s*texture\s*\{/		&& loadTexture();
  /^\s*rotate\s*\{/		&& loadRotate();
  /^\s*translate\s*\{/		&& loadTranslate();
  /^\s*(scale)\s*\{/		&& loadScale();
  /^\s*intersphere\s*\{/	&& loadInterS();
}
close IN;
close OUT;

#----------------------------------------------------------------

sub loadCone {
  my(%apex,%base,$apex_rad,$base_rad,%color,%surf);
  print "Loading cone/cylinder\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*apex\s*\{/i     && loadVec(\%apex,$_);
    /^\s*base\s*\{/i     && loadVec(\%base,$_);
    /^\s*apex_rad\s*\{/i && loadDouble(\$apex_rad,$_);
    /^\s*base_rad\s*\{/i && loadDouble(\$base_rad,$_);
    if (/radius/i){
    		   loadDouble(\$apex_rad,$_);
    		   $base_rad = $apex_rad;
    		  };
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'cone'});
  saveVec(%apex);
  saveVec(%base);
  saveDouble($apex_rad);
  saveDouble($base_rad);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadInterS {
  my(%color,%surf,$inv,$temp);
  $inv = 1;
  print "Loading Intersphere\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*inv\s*\{/      	&& loadDouble(\$inv,$_);
    /^\s*color\s*\{/i   	&& loadCol(\%color,$_);
    /^\s*RGB\s*\{/i     	&& loadRGB(\%color,$_);
    /^\s*surface\s*\{/i 	&& loadSurf(\%surf,$_);
    /^\s*sphere\s*\{/i  	&& last;
    /^\s*plane\s*\{/i  		&& last;
    /^\s*tri_plane\s*\{/	&& last;
  }
  $temp = $_;
  print OUT pack("C",$OBJId{'intersphere'});
  saveDouble($inv);
  saveRGB(%color);
  saveSurf(%surf);
  $_ = $temp;
  {
    /^\s*sphere\s*\{/i  	&& loadSphere();
    /^\s*plane\s*\{/i  		&& loadPlane();
    /^\s*tri_plane\s*\{/	&& loadTriPlane();
    /^\s*\}\s*$/ && last;
    <IN>;
    chomp;
    redo;
  }
};

sub loadTexture {
  my ($count,$fname,$rad,$len);
  ($count,$rad,$len,$fname) = (1,1,1,'suxx');
  print "Loading Texture\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*count\s*\{/i	&& loadDouble(\$count,$_);
    /^\s*rad\s*\{/i	&& loadDouble(\$rad,$_);
    /^\s*len\s*\{/i	&& loadDouble(\$len,$_);
    /^\s*name\s*\{\s*\'(.*)\'\s*/  && {$fname = $1};
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'texture'});
  print OUT pack("L",$count);
  print OUT pack("C",length($fname));
  print OUT pack("a12",$fname);
  saveDouble($rad);
  saveDouble($len);
}
sub loadTranslate {
  my(%v,$count);
  $count=1;
  print "Loading Translate\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*v\s*\{/i       && loadVec(\%v,$_);
    /^\s*count\s*\{/i	&& loadDouble(\$count,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'translate'});
  print OUT pack("L",$count);
  saveVec(%v);
};

sub loadScale {
  my(%pivot,%v,$count);
  $count=1;
  print "Loading scale\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*v\s*\{/i       && loadVec(\%v,$_);
    /^\s*pivot\s*\{/i   && loadVec(\%pivot,$_);
    /^\s*count\s*\{/i	&& loadDouble(\$count,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'scale'});
  print OUT pack("L",$count);
  saveVec(%pivot);
  saveVec(%v);
};

sub loadRotate {
  my(%pivot,%axis,$angle,$count);
  $count=1;
  print "Loading Rotation\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /^\s*count\s*\{/i	&& loadDouble(\$count,$_);
    /Axis/i        && loadVec(\%axis,$_);
    /Angle/i       && loadDouble(\$angle,$_);
    /pivot/i   && loadVec(\%pivot,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'rotate'});
  print OUT pack("L",$count);
  saveVec(%pivot);
  saveVec(%axis);
  saveDouble($angle);
};

sub loadCamera {
  my(%Org,%Dest,$roll,$fov,$xtoy);
  print "Loading camera\n";
  $xtoy = 1.0;
  $fov  = 60.0;
  $Org{'Z'} = -320;
  

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /Origin/i    && loadVec(\%Org,$_);
    /Target/i    && loadVec(\%Dest,$_);
    /Roll/i      && loadDouble(\$roll,$_);
    /Fov/i       && loadDouble(\$fov,$_);
    /XtoY/i      && loadDouble(\$xtoy,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'camera'});
  saveVec(%Org);
  saveVec(%Dest);
  saveDouble($roll);
  saveDouble($fov);
  saveDouble($xtoy);
};

sub loadViewPort {
  my(%LLpos,%CamPos,%Up,%Right);
  print "Loading viewport\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /LLpos/i    && loadVec(\%LLpos,$_);
    /CamPos/i    && loadVec(\%CamPos,$_);
    /Up/i    && loadVec(\%Up,$_);
    /Right/i    && loadVec(\%Right,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'viewport'});
  saveVec(%CamPos);
  saveVec(%LLpos);
  saveVec(%Up);
  saveVec(%Right);
};

sub loadPlane {
  my(%norm,$dist,%color,%surf);
  print "Loading Plane\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /norm/i    && loadVec(\%norm,$_);
    /dist/i    && loadDouble(\$dist,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'obj_plane'});
  saveVec(%norm);
  saveDouble($dist);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadTriPlane {
  my($v1,$v2,$v3,%color,%surf);
  print "Loading TriPlane\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /v1/i      && loadVec(\%v1,$_);
    /v2/i      && loadVec(\%v2,$_);
    /v3/i      && loadVec(\%v3,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'tri_plane'});
  saveVec(%v1);
  saveVec(%v2);
  saveVec(%v3);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadTri {
  my($v1,$v2,$v3,%color,%surf);
  print "Loading Tri\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /v1/i      && loadVec(\%v1,$_);
    /v2/i      && loadVec(\%v2,$_);
    /v3/i      && loadVec(\%v3,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'tri'});
  saveVec(%v1);
  saveVec(%v2);
  saveVec(%v3);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadQuad {
  my($v1,$v2,$v3,$v4,%color,%surf);
  print "Loading Quad\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /v1/i      && loadVec(\%v1,$_);
    /v2/i      && loadVec(\%v2,$_);
    /v3/i      && loadVec(\%v3,$_);
    /v4/i      && loadVec(\%v4,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'quad'});
  saveVec(%v1);
  saveVec(%v2);
  saveVec(%v3);
  saveVec(%v4);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadSphere {
  my(%pos,$rad,%color,%surf);
  print "Loading sphere\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /pos/i     && loadVec(\%pos,$_);
    /radius/i  && loadDouble(\$rad,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /surface/i && loadSurf(\%surf,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'obj_sphere'});
  saveVec(%pos);
  saveDouble($rad);
  saveRGB(%color);
  saveSurf(%surf);
};

sub loadOmni {
  my(%pos,%color);
  print "Loading omni\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /pos/i     && loadVec(\%pos,$_);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'light_omni'});
  saveVec(%pos);
  saveRGB(%color);
};


sub loadAmbient {
  my(%color);
  print "Loading ambient\n";

  while (<IN>)
  {
    chomp;
    next if (/^$/ || /^\s*#/);
    /color/i   && loadCol(\%color,$_);
    /RGB/i     && loadRGB(\%color,$_);
    /^\s*\}\s*$/ && last;
  }
  print OUT pack("C",$OBJId{'ambient'});
  saveRGB(%color);
};

sub loadVec {
  my ($ph, $str) = @_;
  print "LoadVec: $str \n";
  $str =~ /\{\s*([-\d\.]+)\s+([-\d\.]+)\s+([-\d\.]+)\s*\}/i;
  $ph->{'X'} = $1;
  $ph->{'Y'} = $2;
  $ph->{'Z'} = $3;
};

sub loadCol {
  my ($ph,$str) = @_;
  print "LoadCol: $str \n";
  $str =~ /\{\s*([-\d\.]+)\s+([-\d\.]+)\s+([-\d\.]+)\s*\}/i;
  $ph->{'R'} = $1;
  $ph->{'G'} = $2;
  $ph->{'B'} = $3;
};

sub loadRGB {
  my($ph,$str) = @_;
  print "LoadRGB: $str \n";
  $str =~ /\{\s*([-\d\.]+)\s+([-\d\.]+)\s+([-\d\.]+)\s*\}/i;
  $ph->{'R'} = $1/255;
  $ph->{'G'} = $2/255;
  $ph->{'B'} = $3/255;
};

sub loadSurf {
  my($ph,$str) = @_;
  print "LoadSurf: $str \n";
  $str =~ /\{\s*([-\d\.]+)\s+([-\d\.]+)\s+([-\d\.]+)\s*\}/i;
  $ph->{'Kd'} = $1;
  $ph->{'Ks'} = $2;
  $ph->{'Ns'} = $3;
};

sub loadDouble {
  my($ph,$str) = @_;
  print "Loadval: $str \n";
  $str =~ /\{\s*([-\d\.]+)\s*\}/i;
  $$ph = $1;
};

sub saveVec {
  my (%vec) = @_;
  print OUT pack("d3",$vec{'X'},$vec{'Y'},$vec{'Z'});
};

sub saveRGB {
  my (%vec) = @_;
  print OUT pack("d3",$vec{'R'},$vec{'G'},$vec{'B'});
};

sub saveSurf {
  my (%vec) = @_;
  print OUT pack("d3",$vec{'Kd'},$vec{'Ks'},$vec{'Ns'});
};

sub saveDouble {
  my ($val) = @_;
  print OUT pack("d",$val);
};