#! /bin/sh
# (next line not seen by tcl) \
exec tclsh $0 ${1+"$@"}    # goto tcl

### alternate 3rd line: but breaks standalone
#DYLD_LIBRARY_PATH=$CSURF_LIBRARY_PATH exec tclsh $0 ${1+"$@"}  # goto my tcl

### rgb2mpg (for IRIX), marty sereno, version 0.1, 6/18/00
# TODO: change to use pnm, or port SGI progs

### defaults
set pg rgb2mpg
set tmpname TmpConvertToMpg
set scale 1.0
set quality 6
set gamma 1.0
set xn 1
set yn 1
set xcr1 0
set xcr2 0
set ycr1 0
set ycr2 0
set keeprgb 0

### help
if {$argc < 1} {
  puts "\nUse: $pg \[options\] <imgpatt1> ... <outfile.mpg>\n"
  puts "    imgpatt1              backslashed pattern matching first image set"
  puts "   \[imgpatt2\]             patterns for optional additional image sets"
  puts "    outfile               suffix must be .mpg (N.B.: generates mpg1)"
  puts "\nOptions:\n"
  puts "    -scale <num>          (-s) (default=$scale)"
  puts "    -quality <num>        (-q) 1 is best (default=$quality)"
  puts "    -gamma <num>          (-g) (default=$scale)"
  puts "    -tile <cols> <rows>   (-t) num diff patterns must be cols*rows"
  puts "    -crop <l> <r> <b> <t> (-c) % crop left,right,bot,top (def=none)"
  puts "    -keeprgb              (-k) save indiv scale/tile/crop'd rgb frames"
  puts ""
  return
}

if { [exec uname] != "IRIX" && [exec uname] != "IRIX64" } {
  puts "${pg}: ### uses IRIX free utilities for scale/gamma/tile/crop rgb's"
  puts "${pg}: ### only direct rgb->mpg will work on Linux/Darwin"
  #return
}

### check bins
set binlist { izoom subimg assemble mpeg_encode }
foreach bin $binlist {
  if [catch {exec which $bin}] {  ;# exec which $list faster, broken some vers
    puts "${pg}: ### couldn't find IRIX binary: $bin on \$path"
    #return
  }
}

### get/strip options from argv
set argv2 {}
for {set i 0} {$i < $argc} {incr i} {
  set arg [lindex $argv $i]
  if ![string match -* $arg] {
    lappend argv2 $arg
  } else {
    if {$arg == "-keeprgb" || $arg == "-k"} {
      set keeprgb 1
    } elseif { [expr {$arg == "-scale" || $arg == "-s"}] && \
               [expr $i+1] < $argc} {
      set scale [lindex $argv [incr i]]
    } elseif { [expr {$arg == "-quality" || $arg == "-q"}] && \
               [expr $i+1] < $argc} {
      set quality [lindex $argv [incr i]]
    } elseif { [expr {$arg == "-gamma" || $arg == "-g"}] && \
               [expr $i+1] < $argc} {
      set gamma [lindex $argv [incr i]]
    } elseif { [expr {$arg == "-tile" || $arg == "-t"}] && \
               [expr $i+2] < $argc} {
      set xn [lindex $argv [incr i]]
      set yn [lindex $argv [incr i]]
    } elseif { [expr {$arg == "-crop" || $arg == "-c"}] && \
               [expr $i+4] < $argc} {
      set xcr1 [lindex $argv [incr i]]
      set xcr2 [lindex $argv [incr i]]
      set ycr1 [lindex $argv [incr i]]
      set ycr2 [lindex $argv [incr i]]
    } else {
      puts "${pg}: ### error parsing option: $arg"
      exit
    }
  }
}

### check outsuffix, filecnts, pattcnt/tilecnt match
set outfile [lindex $argv end]
if { ![string match *.mpg $outfile] } {
  puts "${pg}: ### bad outfile: $outfile (suffix must be .mpg)"
  return
}
set impattlist [lrange $argv2 0 [expr [llength $argv2]-2]]
set n 0
foreach impatt $impattlist {
  set imlist($n) [lsort [glob -nocomplain $impatt]]
  if {$imlist($n) == ""} {puts "${pg}: ### no match to patt$n:  $impatt";return}
  set imcnt($n) [llength $imlist($n)]
  if {$n == 0} {
    set firstcnt $imcnt($n)
  } else {
    if {$imcnt($n) != $firstcnt} {
      puts \
       "${pg}: ### $imcnt($n) (not $imcnt(0)) files match pattern [expr $n+1]"
      return
    }
  }
  incr n
}
set pattcnt $n
if {$pattcnt != [expr $xn * $yn] } {
  puts "${pg}: ### num patterns ($pattcnt) doesn't match tiles ($xn x $yn)"
  return
}

### reduce
for {set n 0} {$n < $pattcnt} {incr n} {
  set frame 0
  foreach file $imlist($n) {
    set tmpfile $tmpname.$n.[format "%04d" $frame].rgb
    if {$scale != 1.0} {
      eval exec izoom $file $tmpfile $scale $scale
      puts "reduced file: $tmpfile"
    } else {
      exec cp $file $tmpfile
      puts "non-reduced file: $tmpfile"
    }
    incr frame
  }
}

### crop by percent
if {$xcr1 != 0 || $xcr2 != 0 || $ycr1 != 0 || $ycr2 != 0} {
  set xysize [exec imgsize $tmpname.0.0000.rgb]
  set x [lindex $xysize 0]
  set y [lindex $xysize 1]
  set xcr1 [expr $x*$xcr1/100]
  set xcr2 [expr $x*(100-$xcr2)/100-1]
  set ycr1 [expr $y*$ycr1/100]
  set ycr2 [expr $y*(100-$ycr2)/100-1]
  foreach file [lsort [glob $tmpname.*.*.rgb]] {
    eval exec subimg $file zz.rgb $xcr1 $xcr2 $ycr1 $ycr2
    eval exec mv zz.rgb $file
    puts "cropped file: $file"
  }
}

### tile
set frame 0
while {$frame < $imcnt(0)} {
  set framelist [lsort [glob $tmpname.*.[format "%04d" $frame].rgb]]
  set tmpfile $tmpname.$pattcnt.[format "%04d" $frame].rgb
  if {$xn == 1 && $yn == 1} {
    eval exec cp $framelist $tmpfile
  } else {
    eval exec assemble $xn $yn $tmpfile $framelist
  }
  puts "assembled file: $tmpfile"
  incr frame
}

### make mpeg
set id [open $tmpname.parm w 0644]
puts $id "IQSCALE $quality"
puts $id "PQSCALE $quality"
puts $id "BQSCALE $quality"
puts $id "PSEARCH_ALG LOGARITHMIC"
puts $id "BSEARCH_ALG SIMPLE"
puts $id "GOP_SIZE 41"
puts $id "SLICES_PER_FRAME 1"
puts $id "PIXEL FULL"
puts $id "RANGE 10"
puts $id "PATTERN IBBPBBPBBPBBPB"
puts $id "FORCE_ENCODE_LAST_FRAME"
puts $id "BASE_FILE_FORMAT PPM"
if { [exec uname] == "Linux"} { puts $id "BASE_FILE_FORMAT PNM" }
puts $id "INPUT_DIR ."
puts $id "INPUT"
foreach file [lsort [glob $tmpname.$pattcnt.*.rgb]] { puts $id "$file" }
puts $id "END_INPUT"
puts $id "INPUT_CONVERT mytoppm *"
puts $id "OUTPUT $outfile"
puts $id "REFERENCE_FRAME ORIGINAL"
puts $id "GAMMA $gamma"
close $id
puts "making mpeg: $outfile"
catch { puts [exec mpeg_encode $tmpname.parm] }

### cleanup
if {$keeprgb} {
  set outroot [file rootname $outfile]
  puts "saving individual rgbs as: $outroot.????.rgb"
  set frame 0
  foreach file [lsort [glob $tmpname.$pattcnt.*.rgb]] {
    exec mv $file $outroot.[format "%04d" $frame].rgb
    incr frame
  }
}
eval exec rm $tmpname.parm
eval exec rm [glob $tmpname.*.*.rgb]

