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

#!/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:
#!/bin/sh
# \
    exec tclsh "$0" ${1+"$@"}


namespace eval point {

  proc add { p1 p2 } {

    # Add the point p1 to the point p2; return the new point.

    set x [ expr [ get.x $p2 ] + [ get.x $p1 ] ]
    set y [ expr [ get.y $p2 ] + [ get.y $p1 ] ]

    return [ make $x $y ]
    }


  proc dot.product { p1 p2 } {

    # Return the dot product of the given points.

    return [ expr [ get.x $p1 ]*[ get.x $p2 ] + [ get.y $p1 ]*[ get.y $p2 ] ]
    }


  proc get.x pt {

    # Return the given point's x coordinate.

    return [ lindex $pt 0 ]
    }


  proc get.y pt {

    # Return the given point's y coordinate.

    return [ lindex $pt 1 ]
    }


  proc make { x y } {

    # Return a point with the given coordinates.

    return [ list $x $y ]
    }


  proc random { } {

    # Return a randomly generated point somewhere in the unit square centered
    # at the origin.

    set x [ expr 0.5 - rand() ]
    set y [ expr 0.5 - rand() ]

    return [ make $x $y ]
    }


  proc rotate { pt angle } {

    # Rotate the given point about the origin through the given angle; return
    # the rotated point.

    set cos_a [ expr cos($angle) ]
    set sin_a [ expr sin($angle) ]

    set x [ dot.product $pt [ make $cos_a -$sin_a ] ]
    set y [ dot.product $pt [ make $sin_a $cos_a ] ]

    return [ make $x $y ]
    }


  proc sub { p1 p2 } {

    # Subtract the point p1 from the point p2; return the new point.

    set x [ expr [ get.x $p2 ] - [ get.x $p1 ] ]
    set y [ expr [ get.y $p2 ] - [ get.y $p1 ] ]

    return [ make $x $y ]
    }
  }

# $Log:$

# Local Variables:
# mode: tcl
# tcl-application: "tclsh"
# End:
#!/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 } \
      { return $a }
    }

  proc min { a b } {

    variable epsilon

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

# $Log:$

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


proc draw.line { tform p1 p2 defaultsref } {

  # Draw the given edge using the given transform.

  global .canvas

  upvar $defaultsref defaults

  set p1 [ transform.point $tform $p1 ]
  set p2 [ transform.point $tform $p2 ]

  # puts "tform = $tform, p1 = $p1, p2 = $p2"

  eval .canvas create line $p1 $p2 -fill $defaults(color) -tag $defaults(tag) -width $defaults(width)
  }


proc draw.point { pt radius fill } {

  # Draw the given point.

  global .canvas

  set x [ point::get.x $pt ]
  set y [ point::get.y $pt ]

  .canvas create oval \
      [ expr $x - $radius ] \
      [ expr $y - $radius ] \
      [ expr $x + $radius ] \
      [ expr $y + $radius ] \
      -fill $fill
  }


proc draw.points { tform pts } {

  # Draw the given points under the given transform.

  global .canvas

  foreach p $pts {
    draw.point [ transform.point $tform $p ] 4 black
    }
  }


proc draw.polygons { tform polygons } {

  # Draw the polygons in the given list under the given trnasform.

  global .canvas

  set defaults(color) red
  set defaults(width) 1.0

  for { set pcnt [ expr [ llength $polygons ] - 1 ] } { $pcnt >= 0 } { incr pcnt -1 } {
    set poly [ lindex $polygons $pcnt ] 
    set pts [ order.points [ lindex $poly 1 ] ]

    foreach p $pts {
      draw.point [ transform.point $tform $p ] 3 red
      }

    set sides [ lindex $poly 0 ]

    set defaults(tag) p$pcnt

    for { set i 1 } { $i < $sides } { incr i } {
      draw.line $tform [ lindex $pts [ expr $i - 1 ] ] [ lindex $pts $i ] defaults
      }
    draw.line $tform [ lindex $pts [ expr $sides - 1 ] ] [ lindex $pts 0 ] defaults

    .canvas bind $defaults(tag) <Enter> \
      ".canvas itemconfigure $defaults(tag) -fill black -width 3.0"

    .canvas bind $defaults(tag) <Leave> \
      ".canvas itemconfigure $defaults(tag) -fill $defaults(color) -width $defaults(width)"
    }
  }


proc find.bbox { pts } {

  # Return the bounding box for the given list of points given.

  set pt [ lindex $pts 0 ]
  set minx [ point::get.x $pt ]
  set miny [ point::get.y $pt ]
  set maxx $minx
  set maxy $miny

  foreach pt $pts {
    set x [ point::get.x $pt ]
    set y [ point::get.y $pt ]
    set minx [ minmax::min $minx $x ]
    set miny [ minmax::min $miny $y ]
    set maxx [ minmax::max $maxx $x ]
    set maxy [ minmax::max $maxy $y ]
    }

  return [ list $minx $miny $maxx $maxy ]
  }


proc order.points { pts } {

  # Order the given polygon points counter-clockwise around the perimiter.

  set bbox [ find.bbox $pts ]
  set minx [ lindex $bbox 0 ]
  set x_shift [ expr $minx + ([ lindex $bbox 2 ] - $minx)/2 ]
  set miny [ lindex $bbox 1 ]
  set y_shift [ expr $miny + ([ lindex $bbox 3 ] - $miny)/2 ]

  foreach p $pts {
    lappend paired_pts [ list [ subtended.angle $p $x_shift $y_shift ] $p ]
    }

  set paired_pts [ sort.points $paired_pts ]

  set pts { }

  foreach p $paired_pts {
    lappend pts [ lindex $p 1 ]
    }

  return $pts
  }


proc pointify { coordinates } {

  # Pair the given coordinate list into a list of points.

  set coordinates [ string trim $coordinates ]
  regsub -all -- "\[ \t\n\r\b\f\v]+" $coordinates " " coordinates
  set coordinates [ split $coordinates " " ]

  set c [ llength $coordinates ]
  if { [ expr $c % 2 == 1 ] } {
    oops "Coordinate list has an odd number of coordinates ($c)"
    }

  set pts { }
  for { set i $c } { $i > 1 } { incr i -2 } {
    lappend pts [ point::make [ lindex $coordinates [ expr $i - 2 ] ] \
		              [ lindex $coordinates [ expr $i - 1 ] ] ]
    }

  return $pts
  }


proc read.points { inf } {
  
  # From the given input stream read the set of points used as input to the
  # regular-polygon finder.  Return the list of points.

  if { [ catch { set inp [ read $inf ] } size ] } {
    oops "Error during point read."
    }
       
  return [ pointify $inp ] 
  }


proc read.polygons { inf } {

  # Read polygons from the given input stream.

  if { [ catch { set inp [ read $inf ] } size ] } {
    oops "Error during polygon read."
    }

  set inp [ string trim $inp ]
  regsub -all -- "\n+" $inp "\n" inp
  set inp [ split $inp "\n" ]

  set sides ""
  set polygons { }

  foreach l $inp {
    if { ! [ regexp {^[0-9]+$} $l sides ] } {
      lappend polygons [ list $sides [ pointify $l ] ]
      }
    }

  return $polygons
  }


proc set.transform { bbox canvas_x canvas_y margin } {

  # Determine the transform elements that will uniformly scale the given
  # bounding box to the given canvas coordinates, assuming a margin of the
  # given size.

  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 $scale \
                [ expr $margin - $scale*[ lindex $bbox 0 ] ] \
		[ expr $margin - $scale*[ lindex $bbox 1 ] ] ]
  }


proc sort.points { pt_pairs } {

  # Sort the given list of point pairs by increasing angle of the
  # polar-coordinate half of the pair.

  for { set i 0 } { $i < [ llength $pt_pairs ] } { incr i } {
    set min $i
    set min_theta [ lindex [ lindex $pt_pairs $i ] 0 ]
    for { set j [ expr $i + 1 ] } { $j < [ llength $pt_pairs ] } { incr j } {
      set theta [ lindex [ lindex $pt_pairs $j ] 0 ]
      if { [ expr $min_theta > $theta ] } {
	set min $j
	set min_theta $theta
        }
      }
    if { $min != $i } {
      set p [ lindex $pt_pairs $i ]
      set pt_pairs [ lreplace $pt_pairs $i $i [ lindex $pt_pairs $min ] ]
      set pt_pairs [ lreplace $pt_pairs $min $min $p ]
      }
    }

  return $pt_pairs
  }


proc subtended.angle { pt x_shift y_shift } {

  # Return the angle subtended by the given point and the positive x-axis after
  # the point has been shifted by the given amount.

  return [ expr atan2([ point::get.x $pt ] - $x_shift, [ point::get.y $pt ] - $y_shift) ]
  }


proc transform.point { tform pt } {

  # Transform the given point by the given transformation; return the
  # transformed point.

  set scale [ lindex $tform 0 ]

  return [ list [ expr $scale*[ lindex $pt 0 ] + [ lindex $tform 1 ] ] \
                [ expr $scale*[ lindex $pt 1 ] + [ lindex $tform 2 ] ] ]
  }


if { $argc != 1 } {
  oops "Command format is \"$argv0 file-name\""
  }

set filename [ lindex $argv 0 ]
if { [ catch { open $filename } inp ] } {
  oops "Failure while opening $filename:  $inp"
  }
set pts [ read.points $inp ]
close $inp

set canvasy 500
set canvasx 500
set margin   10

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

bind .canvas q { exit 0 }

focus .canvas

set bbox [ find.bbox $pts ]
set tform [ set.transform $bbox $canvasx $canvasy $margin ]

draw.points $tform $pts
draw.polygons $tform [ read.polygons stdin ]

# $Log: see-polygons.tcl,v $
# Revision 1.2  2004/03/13 22:15:21  rclayton
# Flash polygons when the mouse passes over their edges.
#
# Revision 1.1  2004/03/12 05:36:45  rclayton
# Initial revision
#

# Local Variables:
# mode: tcl
# End: