#!/bin/sh
# \
    exec tclsh "$0" ${1+"$@"}

proc oops emsg {

  # Print an error message and die.

  puts stderr "!!! $emsg."
  exit 1
  }


namespace eval key {

  proc block.length { } {

    # Return the length of the compressed block defined by the key.

    variable lengths 
    variable pair_cnt

    set bl 0
    for { set i 0 } { $i < $pair_cnt } { incr i } {
      set bl [ expr $bl + $lengths($i) ]
      }
    return $bl
    }


  proc from.string { str } {

    # Create an uncompression key from the given string.

    variable lengths
    variable pair_cnt
    variable starts

    regsub {[ \t\n]} $str " " str
    set str [ string trim $str ]

    if { [ regexp {[^0-9 ]} $str bad ] } {
      oops "Invalid character '$bad' in uncompression-key string"
      }

    set str [ split $str " " ]
    set i [ llength $str ]
    if { [ expr $i % 2 == 1 ] } {
      oops "The uncompression-key string has an odd number of values ($i)"
      }

    set pair_cnt [ expr $i/2 ]
    if { ! $pair_cnt } return
     
    set starts(0) [ lindex $str 0 ]
    set previous_length [ lindex $str 1 ]
    set lengths(0) $previous_length

    for { set i 1 } { $i < $pair_cnt } { incr i } {
      set s [ lindex $str [ expr $i*2 ] ]
      set e [ lindex $str [ expr $i*2 + 1 ] ]
      if { [ expr $s > $previous_length + 1 ] } {
	oops [ concat "Uncompression key pair $i has a start ($s) " \
	              "larger than the previous string's length ($previous_length)" ]
        }
      set starts($i) $s
      set previous_length [ expr $previous_length - $s + 1 + $e ]
      set lengths($i) $previous_length
      }
    }


  proc generate { pairs_max string_max } {

    # Generate an uncompression key.

    variable pair_cnt $pairs_max

    variable lengths
    for { set i 0 } { $i < $pair_cnt } { incr i } {
      set lengths($i) [ expr [ rint $string_max ] + 1 ]
      }

    variable starts
    for { set i 1 } { $i < $pair_cnt } { incr i } {
      set plen $lengths([ expr $i - 1 ])
      set starts($i) [ expr [ rint [ expr $plen + 1 ] ] + 1 ]
      while { [ expr $starts($i) + $lengths($i) - 1 < $plen ] } {
	set lengths($i) [ expr $lengths($i) + [ rint $string_max ] + 1 ]
        }
      }
    if { $pair_cnt } {
      set starts(0) 0
      }
    }


  proc pair.cnt { } {

    # Return the number of pairs in the generated uncompression key.

    variable pair_cnt
    return $pair_cnt
    }


  proc string.length i {

    # Return the lenght of the ith string in the uncompression key.

    variable lengths
    return $lengths($i)
    }


  proc string.start i {

    # Return the start of the ith string in the incompression key.

    variable starts
    return $starts($i)
    }
  }


# $Log: utils.tcl,v $
# Revision 1.2  2004/02/14 22:58:39  rclayton
# Don't randomize the pair count in generate.
#
# Revision 1.1  2004/02/09 20:04:05  rclayton
# Initial revision
#


proc read.block inf {

  # Read the given input file and return as a string the compressed block
  # therein.

  set str ""

  while 1 {
    if { [ catch { gets $inf ln } err ] } {
      oops "Error while reading compressed block:  $err"
      }
    if { [ string length $ln ] == 0 } break
    if { [ eof $inf ] } {
      oops "Unexpected end-of-file during compressed-block read"
      }
    set str "$str$ln"
    }

  return $str
  }


proc read.key inf {

  # Read the given input file and return as a string the uncompression key
  # therein.

  set key ""

  while 1 {
    if { [ catch { gets $inf ln } err ] } {
      oops "Error while reading uncompression key:  $err"
      }
    if { [ eof $inf ] } break
    set key "$key $ln"
    }

  return $key  
  }


set block [ read.block stdin ]
key::from.string [ read.key stdin ]
set start 1
set end -1

for { set i 0 } { $i < [ key::pair.cnt ] } { incr i } {
  set start [ expr $start + [ key::string.start $i ] - 1 ]
  set end [ expr $start + [ key::string.length $i ] - 1 ]
  puts stdout [ string range $block $start $end ]
  }

incr end
if { $end != [ string length $block ] } {
  oops [ concat "Uncompression key length ($end) does not match " \
	        "compressed string length ([ string length $block ])" ]
  }

# $Log: ouroboros-uncompress.tcl,v $
# Revision 1.3  2004/02/14 23:01:20  rclayton
# Compare the length implied by the key to the string length.
#
# Revision 1.2  2004/02/09 20:04:05  rclayton
# Check the key extents against the string lengths.
#
# Revision 1.1  2004/02/09 14:40:23  rclayton
# Initial revision
#

# Local Variables:
# mode: tcl
# tcl-application: "tclsh"
# End: