#!/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 gen.block { len } {

  # Create a string of the given number of random characters.

  set chars "abcdefghijklmnopqrstuvwxyz 0123456789"
  set char_size [ string length $chars ]
  set str ""

  while { $len > 0 } {
    set i [ rint $char_size ]
    set str "$str[ string range $chars $i $i ]"
    incr len -1
    }

  return $str
  }


proc gen.output { of } {

  # Write to the given output file uncompressed data corresponding to the given
  # uncompression key.

  listify strings

  for { set i [ llength $strings ] } { $i > 0 } { incr i -1 } {
    set j [ rint [ llength $strings ] ]
    if { $j > 0 } {
      set s [ lindex $strings 0 ]
      set strings [ lreplace $strings 0 0 [ lindex $strings $j ] ]
      set strings [ lreplace $strings $j $j $s ]
      }
    }

  foreach s $strings {
    puts $of $s
    }
  }


proc listify { stringsref } {

  # Uncompress the compression string into the referenced list.

  upvar $stringsref strings

  set str [ gen.block [ key::block.length ] ]
  set b 1

  for { set i 0 } { $i < [ key::pair.cnt ] } { incr i } {
    set b [ expr $b + [ key::string.start $i ] - 1 ]
    set e [ expr $b + [ key::string.length $i ] - 1 ]
    lappend strings [ string range $str $b $e ]
    }
  }


proc rint { i } {

  # Generate a random interger in the range [0..i).

  set mx 1000000

  if { [ expr $mx < $i ] } {
    set i $mx
    }
  if { [ expr 0 >= $i ] } {
    set i 1
    }
  set bs [ expr $mx/$i ]
  
  while { 1 } {
    set r [ expr int(rand()*$mx)/$bs ]
    if { [ expr $r < $i ] } {
      return $r
      }
    }
  }


set str_cnt [ rint 25 ]

foreach i $argv {
  switch -regexp -- $i {
    {-c[0-9]*} {
      if { ! [ regexp -- {-c([0-9]+)} $i _ str_cnt ] } {
	oops "Missing count for -c argument"
        }
      }

    default {
      oops "\"$i\" is an unrecognized option"
      }
    }
  }


key::generate $str_cnt 25
gen.output stdout


# $Log: gen-strings.tcl,v $
# Revision 1.2  2004/02/14 22:59:23  rclayton
# Output strings in random order; add the -c option.
#
# Revision 1.1  2004/02/09 20:04:05  rclayton
# Initial revision
#
# Revision 1.1  2004/02/08 17:28:41  rclayton
# Initial revision
#


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