#!/usr/bin/perl

# Makes a texture-mapped VRML cylinder from a series of images
# Copyright 1996 Andrew Daviel, Vancouver Webpages
# mailto:andrew@vancouver-webpages.com
# http://vancouver-webpages.com/vrml/
#
# This is free software. You may do what you like with it so long
# as the copyright notice and URL are retained

$debug=@ARGV[0] ;
if ($debug) {$|=1; }

$twopi = atan2(1.0,1)*8 ;
$fmt = "%7.3f" ;
$level = 0; 
# kludge since I can't have negative array indices
# (well, could use assoc. arrays, but why bother)
$minlevel = 1000; $base = 100 ;
$wid = 640 ; $hig = 480 ;  # default
# convert takes it's time, so we cache sizes.
# if you crop some images, you will need to delete the cache files
# (named "img_cache.db", or "img_cache.pag", "img_cache.dir", etc.)
# to do - actually check timestamps
dbmopen(IMG,"img_cache",0644) ;
while (<STDIN>) {
  chop ;
  tr/ / /s ; s/^[\s]// ;
  ($gif,$x0y0,$x0y1,$x1y1,$x1y0) = split(/ /) ;
  if (/^Level/i) {
    # "Level" command
    $level = $x0y0 + $base ;
    if ($level>$maxlevel) { $maxlevel = $level ; }
    if ($level<$minlevel) { $minlevel = $level ; }
    if ($debug) { print STDERR "Level $level\n"; }
    next ;
 }
  # Y1, Y2 commands
  if (/^Y1/i) {
    $Y1 = $x0y0 ;
    if ($debug) { print STDERR "Y1 $Y1\n"; }
    next ;
 }
  if (/^Y2/i) {
    $Y2 = $x0y0 ;
    if ($debug) { print STDERR "Y2 $Y2\n"; }
    next ;
 }
  if (/^Facets/i) {
    $nfacet = $x0y0 ;
    if ($debug) { print STDERR "No. facets $nfacet\n"; }
    next ;
 }
  if (/^Title/i) {
    $title= $_ ; $title =~ s/^\w+\s+// ;
    if ($debug) { print STDERR "Title $title\n"; }
    next ;
 }
  if (/^Description/i) {
    $description= $_ ; $description=~ s/^\w+\s+// ;
    if ($debug) { print STDERR "Description $description\n"; }
    next ;
 }
  if (/^Latlong/i) {
    $latlong = $_ ; $latlong =~ s/^\w+\s+// ;
    if ($debug) { print STDERR "Origin latlong $latlong \n"; }
    next ;
 }


  # wasn't a command, must be an image 
  if ($debug) {
    print STDERR "Image $gif co-ords $x0y0 $x0y1 $x1y1 $x1y0\n";
  }
  if ($ringgif[$level]) {
    $ringgif[$level] = $ringgif[$level]."+".$gif ;
  } else {
    $ringgif[$level] = $gif ;
  }
  $coords = $x0y0."*".$x0y1."*".$x1y1."*".$x1y0 ;
  if ($ringcoords[$level]) {
    $ringcoords[$level] = $ringcoords[$level]."&".$coords ;
  } else {
    $ringcoords[$level] = $coords ;
  }
}
unless ($ringgif[$base]) { die "No level 0 images" ; }
if (($Y1 eq "") || ($Y2 eq "") || !$nfacet) { die "Y1,Y2 nfacet undefined" ;}
@gifs = split(/\+/,$ringgif[$base]) ;
$ngifs[$base] = @gifs+0 ;
if ($debug) { print STDERR "$ngifs[$base] Images on level $base\n"; }
@coords = split(/&/,$ringcoords[$base]) ;
unless (@coords == @gifs) { print STDERR "No. of images doesn't match no. of co-ords, level 0\n"; }
$circum[$base] = 0 ; $height[$base] = 0 ;
for ($i=0;$i<@gifs;$i++) {
  ($x0y0,$x0y1,$x1y1,$x1y0) = split(/\*/,$coords[$i]) ;
  ($xa,$ya) = split(/,/,$x0y0) ;
  ($xb,$yb) = split(/,/,$x0y1) ;
  ($xc,$yc) = split(/,/,$x1y1) ;
  ($xd,$yd) = split(/,/,$x1y0) ;
  # normalize y
  # Image  co-ords  X +ve right, Y +ve down
  # picture co-ords X +ve right, Y +ve up
  $maxy = $ya ; if ($yb>$maxy) { $maxy=$yb ; }
  if ($yd>$maxy) { $maxy=$yd ; } if ($yd>$maxy) { $maxy=$yd ; }
  $ya = $maxy - $ya ; $yb = $maxy - $yb ; $yc = $maxy - $yc ;
  $yd = $maxy - $yd ;
  # simple checks to make sure corners are in the correct order
  # to do - sort them automatically
  if ($xa>$xd) { print STDERR "xa > xd image $i level $base\n"; }
  if ($xb>$xc) { print STDERR "xb > xc image $i level $base\n"; }
  if ($ya>$yb) { print STDERR "ya > yb image $i level $base\n"; }
  if ($yd>$yc) { print STDERR "yd > yc image $i level $base\n"; }

  $w1 = $xc-$xb ; $w[$i] = $xd - $xa ; if ($w[$i]<$w1) { $w[$i] = $w1 ; }
  $h1 = $yb-$ya ; $h[$i] = $yc - $yd ; if ($h[$i]<$h1) { $h[$i] = $h1 ; }
  if ($w >128 || $h>128) {
    print STDERR "WARNING - image $i level $base exceeds 128 x 128 pixels\n";
  }
  
  $circum[$base] += $w[$i] ;
  $height[$base] += $h[$i] ;
}
$height[$base] =  $height[$base]/@gifs ; 
$scale = ($Y2 - $Y1) / $height[$base] ;
$circum[$base] = $circum[$base] * $scale ;
$radius[$base] = $circum[$base] /$twopi ;

if ($debug) { 
  print STDERR "Base height $height[$base], circumference $circum[$base], radius $radius[$base]\n";
}

$r2 = 3 * $radius[$base] ;
print "#VRML V1.0 ascii\n";
if ($title) { print "DEF Title Info { string \"$title\" }\n"; }
if ($description) { print "DEF Description Info { string \"$description\" }\n"; }
if ($latlong) { print "DEF Origin-Latlong  Info { string \"$latlong\" }\n"; }
print <<EOT;
DEF Creator Info { string "Created by http://vancouver-webpages.com/vrml/mk-cyl2.pl" }
# $nfacet facets, $ngifs[$base] images; levels $minlevel - $maxlevel; texture
DEF Viewer Info { string "look" }
DEF Cameras Switch { whichChild  0
  DEF Looking_West PerspectiveCamera {
    position 0 0 0
  }
  DEF Looking_South PerspectiveCamera {
    position 0 0 0
    orientation 0 1 0  1.7
  }
  DEF Looking_East  PerspectiveCamera {
    position 0 0 0
    orientation 0 1 0  3.14
  }
  DEF Looking_North PerspectiveCamera {
    position 0 0 0
    orientation 0 1 0  4.8
  }
  DEF Virtual PerspectiveCamera {
    position 0 0  $r2
  }
}
# check these ...
ShapeHints {
  vertexOrdering COUNTERCLOCKWISE
  faceType CONCAVE
  creaseAngle     0.7

}
EOT

for ($level=$minlevel;$level<=$maxlevel;$level++) {
  if ($debug) { print STDERR "\nDoing Level $level\n\n"; }
  @coords = split(/&/,$ringcoords[$level]) ;
  $y1 = $Y1+($level-$base)*($Y2-$Y1) ; $y2 = $Y2+($level-$base)*($Y2-$Y1)  ;
  print "# Level $level from y=$y1 to y=$y2\n";
  $circ = 0 ; $r = $radius[$base] ;
  for ($i=0;$i<@gifs;$i++) {
    $alpha[$i] = $circ/$circum[$base] * $twopi * $scale ;
    $circ += $w[$i] ;
  }
  @gifs = split(/\+/,$ringgif[$level]) ;

  for ($j=0;$j<@gifs;$j++) {
    $framej = $gifs[$j] ;
    $beta = $alpha[$j] ;   
    if ($j+1<@gifs) {
      $gamma = $alpha[$j+1] ;
    } else { 
      $gamma = $alpha[0] ;
    }
    $betaf = sprintf($fmt,$beta) ;

# uncomment this code if using GIFs and you don't have "convert"
#    open(GIF,$framej)||die "Can't open $framej";
#    $content = (<GIF>) ;
#    $wid = ord(substr($content,6,1)) + ord(substr($content,7,1)) * 256 ;
#    $hig = ord(substr($content,8,1))  + ord(substr($content,9,1)) * 256 ;
#    close(GIF) ;

    # determine image size using ImageMagick "convert"
    # and cache it
    # e.g. "w.jpg=>/dev/null 12x10 PseudoClass 1c JPEG 1s"
    if (!$IMG{$framej}) {
      $IMG{$framej} = `convert -verbose $framej /dev/null 2>&1` ;
    } else {
      if ($debug) {print STDERR "Using cached size for $framej\n";  }
    }
    $_ = $IMG{$framej} ;
    @ff = split(/ /) ;
    ($wid,$hig) = split(/x/,$ff[1]) ;

    ($x0y0,$x0y1,$x1y1,$x1y0) = split(/\*/,$coords[$j]) ;
    ($xa,$ya) = split(/,/,$x0y0) ; ($xb,$yb) = split(/,/,$x0y1) ;
    ($xc,$yc) = split(/,/,$x1y1) ; ($xd,$yd) = split(/,/,$x1y0) ;
    # normalize y
    $ya = $hig - $ya ; $yb = $hig - $yb ; $yc = $hig - $yc ;
    $yd = $hig - $yd ;
    if ($wid==0) { die "Illegal image width = zero" ; }
    if ($nfacet==0) { die "Illegal number of facets = zero" ; }
    print <<EOT;
Separator {
  # GIF $j (starts at $betaf radians; $nfacet facets)
  Texture2 { filename "$framej" }
  TextureCoordinate2 { point   [
EOT
    for ($i=0;$i<=$nfacet;$i++) {
      #$x = $i/$nfacet ; $x = sprintf($fmt,$x) ;
      $Xa = $xa/$wid + $i/$nfacet * ($xd-$xa)/$wid ;
      $Xb = $xb/$wid + $i/$nfacet * ($xc-$xb)/$wid ;
      $Ya = $ya/$hig ; $Yb = $yb/$hig ;
      $Xa = sprintf($fmt,$Xa) ; $Ya = sprintf($fmt,$Ya) ;
      $Xb = sprintf($fmt,$Xb) ; $Yb = sprintf($fmt,$Yb) ;
      print "  $Xa $Ya, $Xb $Yb";
      if ($i<$nfacet) { print ",\n" ; } else {  print "\n ] }\n" ; }
    }

    print "  Coordinate3 { point [\n";
    for ($i=0;$i<=$nfacet ; $i++) {
    $delta = $gamma-$beta ; if ($delta <0) { $delta = $twopi + $delta ; }
      $alpha = $i * ($delta) / $nfacet  + $beta ;
      $x1 = cos($alpha) * $r ; $x1 = sprintf($fmt,$x1) ;
      $z1 = sin($alpha) * $r ; $z1 = sprintf($fmt,$z1) ;
      $y1 = sprintf($fmt,$y1) ; $y2 = sprintf($fmt,$y2) ;
      print "    $x1 $y1 $z1,\n    $x1 $y2 $z1";
      if ($i<=$nfacet-1) { print "," ; }
      print "\n";
    }
    print " ] }\n IndexedFaceSet { coordIndex [ \n";
    for ($i=0;$i<$nfacet-1 ; $i++) {
      $j0 = $i*2 ; $j1 = ($i+1)*2; $j2 = $j1+1 ; $j3 = $j0+1 ;
      print "      $j0,$j1,$j2,$j3,-1,\n";
    }
    $i = $nfacet-1 ; $j0 = $i*2 ; $j1 = ($i+1)*2 ; $j2 = $j1+1 ; $j3 = $j0+1 ;
     print "      $j0,$j1,$j2,$j3,-1\n";
    print "    ]
    textureCoordIndex [\n";
    for ($i=0;$i<$nfacet-1 ; $i++) {
      $t0 = $i*2 ; $t1 = ($i+1)*2 ; $t2 = $t1+1 ; $t3 = $t0+1 ;
      print "      $t0,$t1,$t2,$t3,-1,\n";
    }
    $i=$nfacet-1 ; 
    $t0 = $i*2 ; $t1 = ($i+1)*2 ; $t2 = $t1+1 ; $t3 = $t0+1 ;
    print "      $t0,$t1,$t2,$t3,-1\n";
    print "    ]\n }\n }\n";
  } # for $j 
} # for $level