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

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

namespace eval minmax {

  variable epsilon 0.001

  proc max { a b } {

    variable epsilon

    if { [ expr $a - $b < $epsilon ] } {
      return $b 
      } \
    else {
      return $a
      }
    }

  proc min { a b } {

    variable epsilon

    if { [ expr $a - $b < $epsilon ] } {
      return $a 
      } \
    else {
      return $b
      }
    }
  }

# $Log:$

# Local Variables:
# mode: tcl
# tcl-application: "tclsh"
# End:
#!/bin/sh
# \
    exec tclsh "$0" ${1+"$@"}


proc oops emsg {

  # Print the given error message and die.

  puts stderr "emsg."
  exit 1
  }


# $Log:$


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


proc find_bounding_box { pts } {

  # Return the bounding box enclosing the points in $pts.

  set pt [ lindex $pts 0 ]
  set llx [ lindex $pt 0 ]
  set lly [ lindex $pt 1 ]
  set urx $llx
  set ury $lly

  foreach pt $pts {
    set x [ lindex $pt 0 ]
    set y [ lindex $pt 1 ]

    set llx [ minmax::min $llx $x ]
    set lly [ minmax::min $lly $y ]
    set urx [ minmax::max $urx $x ]
    set ury [ minmax::max $ury $y ]
    }

  return [ list $llx $lly $urx $ury ]
  }


proc flatten l {

  # Flatten the list $l; return the flattened list.

  while {[string compare $l [set l [join $l]]]} {}

  return $l
  }


proc is_outline { ptlst } {

  # Return 1 iff $ptlst contains the points comprising the outline of a tangram
  # puzzle.

  # A tangram solution has seven lines, one for each tan.

  if { [ llength $ptlst ] != 7 } {
    return 1
    }

  # A tangram solution has an six or eight numbers on each line because each
  # tan is described as a set of x, y coordinates for eiher a triangle (six) or
  # a quadrangle (eight).

  foreach l $ptlst {
    set ll [ llength $l ] 
    if { $ll != 6 && $ll != 8 } {
      return 1
      }
    }

  # Assume it's a solution.
  
  return 0
  }


proc listify_numbers { str } {

  # Convert a string $str containing representations of floating-point numbers
  # into a list of floating-point numbers.

  set ls [ ]

  foreach n [ split $str ] { 
    if { [ string length $n ] > 0 } {
      if { [ scan $n %f x ] != 1 } {
	oops "unparsable word \"$n\" found"
	}
      lappend ls $x
      }
    }

  return $ls
  }


proc listify_points { pts } {

  # Given the list of numbers in $pts, return a list of x, y pairs; die with an
  # error message otherwise.

  set ll [ llength $pts ]
  if { [ expr $ll & 1 ] == 1 } {
    oops "an odd number of coordinates input"
    }

  set l []

  for { set i 0 } { $i < $ll } { incr i 2 } {
    lappend l [ list [ lindex $pts $i ] [ lindex $pts [ expr $i + 1 ] ] ]
    }

  return $l
  }


proc read { ins } {
  
  # Read numbers from the input stream ins.  Numbers are returned in a list of
  # lists; an element of the outer-most list holds the numbers read from one
  # input line (empty lines are skipped).

  set inp []

  while { [ gets $ins ln ] >= 0 } {
    set ln [ string trim $ln ]
    if { [ string length $ln ] == 0 } { 
      continue
      }

    lappend inp [ listify_numbers $ln ]
    }

  return $inp  
  }


proc set_transform { pts canvas_x canvas_y margin } {

  set bbox [ find_bounding_box [ listify_points [ flatten $pts ] ] ]
  
  set xscale \
    [ expr ($canvas_x - 2*$margin)/([ lindex $bbox 2 ] - [ lindex $bbox 0 ]) ]
  set yscale \
    [ expr ($canvas_y - 2*$margin)/([ lindex $bbox 3 ] - [ lindex $bbox 1 ]) ]
  set scale [ minmax::min $xscale $yscale ]

  return [ list [ minmax::min $xscale $yscale ] \
                [ lindex $bbox 0 ] [ lindex $bbox 1 ] \
		$canvas_y $margin ]
  }


proc show_outline { pts cvs } {

  # Display the tangram puzzle outline given by the list of points in $pts.

  global canvasx canvasy margin

  set pts [ listify_points [ flatten $pts ] ]
  set tform [ set_transform $pts $canvasx $canvasy $margin ]
  set pts [ transform_points $pts $tform ]

  eval $cvs create polygon [ flatten $pts ] -fill black
  }


proc show_solution { tans cvs } {

  # Display the tangram puzzle outline given by the list of points in $pts.

  global canvasx canvasy margin

  set tform [ set_transform $tans $canvasx $canvasy $margin ]

  foreach tan $tans {
    set tan [ transform_points [ listify_points $tan ] $tform ]
    eval $cvs create polygon [ flatten $tan ] -fill black -outline white
    }
  }


proc transform_points { pts tform } {

  # Transform the given point list by the given transform; return the list of
  # transformed points.

  set scale    [ lindex $tform 0 ]
  set xoffset  [ lindex $tform 1 ]
  set yoffset  [ lindex $tform 2 ]
  set canvas_y [ lindex $tform 3 ]
  set margin   [ lindex $tform 4 ]

  set newpts []

  foreach pt $pts {
    set x [expr ([ lindex $pt 0 ] - $xoffset)*$scale + $margin]
    set y [expr ([ lindex $pt 1 ] - $yoffset)*$scale*-1 + $canvas_y - $margin]
    lappend newpts [ list $x $y ]
    }

  return $newpts
  }


set canvasy 400
set canvasx 400
set margin   10

canvas .canvas -height $canvasy -width $canvasx -background white
pack .canvas

bind .canvas q { exit 0 }

set inp [ read stdin ]

if { [ is_outline $inp ] } {
  show_outline $inp .canvas
  } \
else {
  show_solution $inp .canvas
  }    
  
focus .canvas

# $Log: tg-viewer.tcl,v $
# Revision 1.1  2004/03/18 14:28:44  rclayton
# Initial revision
#

# Local Variables:
# mode: tcl