#! /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

### tiff2mpg, marty sereno, version 0.1, 18 Feb 2012
# 120218: no tile/scale/crop, concatenates optional multiple pattern args
# 160125: re-add tile, using ImageMagick montage if there

### defaults
set pg tiff2mpg
set tmpname TmpConvertToMpg
set quality 1
set gamma 1.0
set tileflag 0
set keeptiled 0
set trimarg ""

### help
if {$argc < 1} {
  puts ""
  puts "Use: $pg \[options\] <imgpatt> ... <outfile.mpg>"
  puts ""
  puts "  imgpatt        backslashed pattern matching ordered image set"
  puts " \[imgpatt2\]      patterns for opt concat'd or tiled image sets"
  puts "  outfile        suffix must be .mpg"
  puts ""
  puts "  Options:"
  puts ""
  puts "   -quality <num>      (-q) 1 is best (default=$quality)"
  puts "   -gamma <num>        (-g) (default=$gamma)"
  puts "   -tile <cols> <rows> (-t) ImageMagick: num diff patts => cols*rows"
  puts "   -keeptiled          (-k) ImageMagick: save indiv tiled tiffs"
  puts "   -trim               (-c) ImageMagick: montage -trim"
  puts ""
  puts "  N.B.: generates tmpfiles in cwd"
  puts ""
  return
}

### check bins
proc foundbywhich { somebinary } {
  catch { eval exec /usr/bin/which $somebinary } ret
  if { [string match "" $ret] || \
       [string match "*no $somebinary*" $ret] || \
       [string match "*no [file tail $somebinary]*" $ret] ||
       [string match "*child process exited abnormally*" $ret] } {
    return 0
  } else {
    return 1
  }
}
set bin mpeg_encode
if ![foundbywhich $bin] {
  puts "${pg}: ### couldn't find binary: $bin on \$path"
  return
}

### get/strip option(s) 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 == "-keeptiled" || $arg == "-k"} {
      set keeptiled 1
    } elseif {$arg == "-trim" || $arg == "-c"} {
      set trimarg "-trim"
    } 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]]
      if {[expr $xn * $yn] != 1} { set tileflag 1 }
    } else {
      puts "${pg}: ### error parsing option: $arg"
      exit
    }
  }
}

### check outsuff
set outfile [lindex $argv end]
if { ![string match *.mpg $outfile] } {
  puts "${pg}: ### bad outfile: $outfile (suffix must be .mpg)"
  return
}

### if tile, check filecnts, pattcnt/tilecnt match, tile to tmp frames
if {$tileflag} {
  set bin /opt/local/bin/montage
  if ![foundbywhich $bin] {
    puts "${pg}: ### couldn't find ImageMagick binary: $bin on \$path"
    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
  }
  ## tile to tmpfiles
  set frame 0
  set fullimlist ""
  while {$frame < $imcnt(0)} {
    set framelist ""
    for {set n 0} {$n < $pattcnt} {incr n} {
      set framelist "$framelist [lindex $imlist($n) $frame]"
    }
    #puts "${pg}: framelist: $framelist"
    set tmpfile $tmpname.$pattcnt.[format "%04d" $frame].tiff
    set cmd "/opt/local/bin/montage $framelist $trimarg \
      -geometry +${xn}+${yn} -background black $tmpfile"
    #puts "${pg}: $cmd"
    eval exec $cmd
    puts "${pg}: assembled file: $tmpfile"
    set fullimlist "$fullimlist $tmpfile"
    incr frame
  }
}

### else just concat list(s)
if {!$tileflag} {
  set impattlist [lrange $argv2 0 [expr [llength $argv2]-2]]
  set fullimlist ""
  foreach impatt $impattlist {
    set imlist [lsort [glob -nocomplain $impatt]]
    if ![llength $imlist] { puts "${pg}: ### no match to: $impatt" }
    set fullimlist "$fullimlist $imlist"
  }
  if ![llength $fullimlist] {
    puts "${pg}: ### no files to convert  ...quitting"
    return
  }
}

### 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 $fullimlist { 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] } ret
puts "$ret"

### cleanup
eval exec rm -f $tmpname.parm
if {$tileflag && !$keeptiled} {
  eval exec rm -f [glob $tmpname.$pattcnt.????.tiff]
} else {
  puts "${pg}: kept tiled images"
}

