#----------------------------------------------------------------------
 #
 # RoundPoly -- Draw a polygon with rounded corners in the canvas, based
 # off of ideas and code from "Drawing rounded rectangles"
 #
 # Parameters:
 #       w - Path name of the canvas
 #       xy - list of coordinates of the vertices of the polygon
 #       radii - list of radius of the bend each each vertex
 #       args - Other args suitable to a 'polygon' item on the canvas
 #
 # Results:
 #       Returns the canvas item number of the rounded polygon.
 #
 # Side effects:
 #       Creates a rounded polygon in the canvas.
 #
 #----------------------------------------------------------------------
 
 proc RoundPoly {w xy radii args} {
    set lenXY [llength $xy]
    set lenR [llength $radii]
    if {$lenXY != 2 * $lenR} {
        error "wrong number of vertices and radii"
    }
 
    # Walk down vertices keeping previous, current and next
    lassign [lrange $xy end-1 end] x0 y0
    lassign $xy x1 y1
    eval lappend xy [lrange $xy 0 1]
    set knots {}                                ;# These are the control points
 
    for {set i 0} {$i < $lenXY} {incr i 2} {
        set radius [lindex $radii [expr {$i/2}]]
        set r [winfo pixels $w $radius]
 
        lassign [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] x2 y2
        set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r]
        eval lappend knots $z
 
        lassign [list $x1 $y1] x0 y0           ;# Current becomes previous
        lassign [list $x2 $y2] x1 y1           ;# Next becomes current
    }
    set n [eval $w create polygon $knots -smooth 1 $args]
    return $n
 }
 proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} {
    set d [expr { 2 * $radius }]
    set maxr 0.75
 
    set v1x [expr {$x0 - $x1}]
    set v1y [expr {$y0 - $y1}]
    set v2x [expr {$x2 - $x1}]
    set v2y [expr {$y2 - $y1}]
 
    set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}]
    set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}]
    if {$d > $maxr * $vlen1} {
        set d [expr {$maxr * $vlen1}]
    }
    if {$d > $maxr * $vlen2} {
        set d [expr {$maxr * $vlen2}]
    }
 
    lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}]
    lappend xy $x1 $y1
    lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}]
 
    return $xy
 }
 ################################################################
 #
 # Demonstration code
 
 # Code from Regular polygons
 proc rp {x0 y0 x1 y1 {n 0}} {
    set xm [expr {($x0+$x1)/2.}]
    set ym [expr {($y0+$y1)/2.}]
    set rx [expr {$xm-$x0}]
    set ry [expr {$ym-$y0}]
    if {$n==0} {
        set n [expr {round(($rx+$ry)*0.5)}]
    }
    set step [expr {atan(1)*8/$n}]
    set res ""
    set th [expr {atan(1)*6}] ;#top
    for {set i 0} {$i<$n} {incr i} {
        lappend res \
            [expr {$xm+$rx*cos($th)}] \
            [expr {$ym+$ry*sin($th)}]
        set th [expr {$th+$step}]
    }
    set res
 }
 
 # Code from Sun, moon, and stars
 proc MakeStar {x y delta} {
    set pi [expr {atan(1) * 4}]
 
    # Compute distance to inner corner
    #set x1 [expr {cos(54 * $pi/180)}]          ;# Unit vector to inner point
    set y1 [expr {sin(54 * $pi/180)}]
    set y2 [expr {$delta * sin(18 * $pi/180)}]  ;# Y value to match
    set delta2 [expr {$y2 / $y1}]
 
    # Now get all coordinates of the 5 outer and 5 inner points
    for {set i 0} {$i < 10} {incr i} {
        set d [expr {($i % 2) == 0 ? $delta : $delta2}]
        set theta [expr {(90 + 36 * $i) * $pi / 180}]
        set x1 [expr {$x + $d * cos($theta)}]
        set y1 [expr {$y - $d * sin($theta)}]
 
        lappend coords $x1 $y1
    }
    return $coords
 }
 proc doit { args } {
    global rad nsides
 
    # Get canvas dimensions shrunk by some
    foreach who {x0 y0 x1 y1} val [.c cget -scrollregion] d {30 30 -30 -30} {
        set $who [expr {$val + $d}]
    }
 
    if {$nsides == -1} {                        ;# Star
        set xy [MakeStar 0 0 [expr {$x1 > $y1 ? $y1 : $x1}]]
    } elseif {$nsides == 4} {                   ;# Want square not diamond
        set xy [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1]
    } elseif {$nsides == -4} {                  ;# Rectangle
        set y0 [expr {$y0 / 2}]
        set y1 [expr {$y1 / 2}]
        set xy [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1]
    } else {                                    ;# Regular polygon
        set xy [rp $x0 $y0 $x1 $y1 $nsides]
    }
    set radii {}
    foreach {x y} $xy {
        lappend radii $rad([expr {[llength $radii] & 1}])
    }
 
    .c delete poly
    .c create poly $xy -fill gray90 -outline black -dash . -tags poly
    RoundPoly .c $xy $radii -fill white -outline black -tags poly
    .c create poly $xy -fill {} -outline black -dash . -tags poly
 }
 proc Recenter {W h w} {
    set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
    $W config -scrollregion [list -$w -$h $w $h]
    doit
 }
 
 
 canvas .c -width 500 -height 500 -bd 2 -relief raised
 frame .shapes -bd 2 -relief ridge
 scale .rad1 -orient horizontal -label "Odd Vertex Radius" -variable rad(0) \
    -from 0 -to 200 -command doit -relief ridge
 scale .rad2 -orient horizontal -label "Even Vertex Radius" -variable rad(1) \
    -from 0 -to 200 -command doit -relief ridge
 image create photo ::img::blank -width 1 -height 1
 button .about -image ::img::blank -highlightthickness 0 -command \
    {tk_messageBox -message "Rounded Polygon\nby Keith Vetter, March 2003"}
 place .about -in .shapes -relx 1 -rely 1 -anchor se
 
 set row [set col 0]
 foreach {name sides} {Triangle 3 Square 4 Rectangle -4 Pentagon 5 Hexagon 6
    Heptagon 7 Octagon 8 Enneagon 9 Decagon 10 Star -1} {
    radiobutton .shapes.p$name -text $name -variable nsides \
        -command doit -value $sides -anchor w
    grid .shapes.p$name -row $row -column $col -sticky ew
    if {[incr col] == 5} {incr row ; set col 0}
 }
 grid .c - -row 0 -sticky news
 grid .shapes - -sticky ew
 grid .rad1 .rad2 -sticky ew
 grid rowconfigure . 0 -weight 1
 grid columnconfigure . {0 1} -weight 1
 grid columnconfigure .shapes 100 -weight 1
 bind .c <Configure> {Recenter %W %h %w}
 
 set nsides 4
 set rad(0) 150
 set rad(1) 50