uniquename 2013aug18For readers who do not have the time/facilities/whatever to setup and run the code below, here is an image that shows how this code draws the rounded corners for a given polygon. And you can see the choices of polygons according to the radiobuttons at the bottom of the GUI.
#----------------------------------------------------------------------
#
# 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
foreach {x0 y0} [lrange $xy end-1 end] break
foreach {x1 y1} $xy break
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]
foreach {x2 y2} [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] break
set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r]
eval lappend knots $z
foreach {x0 y0} [list $x1 $y1] break ;# Current becomes previous
foreach {x1 y1} [list $x2 $y2] break ;# 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