HJG 2007-07-13 - A dartboard, as specified at http://www.dartswdf.com/aa_darts/playdarts.htm and http://en.wikipedia.org/wiki/Darts
Sorry, no gameplay yet. I think about adding some scoring.
GWM see below for scoring and corrected version.
package require Tk grid [canvas .c -width 290 -height 290] .c config -scrollregion {-145 -145 145 145} set twopi 6.283185 set halfpi 1.570796 set SectSize 0.31415925 ;# 360/20 deg = 18 deg proc int x {expr int($x)} proc deg2rad deg { expr {$deg * atan(1)*8/360} } #: Convert angle from degree to radians proc rect_to_polar { x y } { #: Convert rectangular co-ordinates $x, $y to polar co-ordinates $r, $theta set r [expr { hypot( $x, $y ) }] set theta [expr { atan2( $y, $x ) }] return [list $r $theta] } proc polar_to_rect { r theta } { #: Convert polar co-ordinates $r, $theta to rectangular co-ordinates $x, $y set x [expr { $r * cos($theta) }] set y [expr { $r * sin($theta) }] return [list $x $y] } #########1#########2#########3#########4#########5#########6#########7##### foreach {r1 c1 v1} {144 black Out 106 green Double 100 yellow Single \ 66 red Triple 60 yellow Single 10 green DBull 4 red Bull } { .c create oval -$r1 -$r1 $r1 $r1 -fill $c1 -tag $v1 -outline black } # h --> Sector for { set h 1 } { $h <= 20 } { incr h } { set angle [expr { $halfpi - $SectSize * $h }] set x [expr { 0 + 130 * cos($angle) }] set y [expr { 0 - 130 * sin($angle) }] set Sector [lindex {x 1 18 4 13 6 10 15 2 17 3 18 7 16 8 11 14 9 12 5 20} $h] .c create text $x $y -text $Sector -font {Helvetica -14} -fill white ;# -tag wire } set xm 0 set ym 0 set r 106 for {set d 9} {$d<360} {set d [expr {$d+360./20.}]} { set rad [deg2rad $d] set x [expr {$xm+cos($rad)*$r}] set y [expr {$ym+sin($rad)*$r}] .c create line $xm $ym $x $y -tag "wire" }
gold added pix
[GWM] took above and corrected the position of the 19 ring (original code had 2 18 sectors). Added options to score and reset score. package require Tk # http://en.allexperts.com/q/Darts-2581/2008/4/Dart-boards.htm # or http://www.dartswdf.com/aa_darts/playdarts.htm - link playing rules, Tournament rules # gives diameters for the various rings in mm. # wire dimaeter is 1.5mm (mean); # width of double & triple ring 8.0 mm (inside:inside) # allow 9.5mm to include 1 wire) # bull diameter 12.7 ; outer bull 31.8. array set rings {Out 225.5 Double 170 Single2 160.5 \ Triple 107 Single 97.5 OBull 15.9 Bull 6.35 } set diam [expr {2*$rings(Out)}] ;# size of dartboard canvas grid [canvas .c -width $diam -height $diam] set rad $rings(Out) ;# radius of dartboard .c config -scrollregion [list -$rad -$rad $rad $rad] set halfpi 1.570796 proc deg2rad deg { expr {$deg * atan(1)*8/360} } #: Convert angle from degree to radians set SectSize [deg2rad 18] ;# 360/20 deg = 18 deg foreach {c1 v1} {black Out green Double yellow Single2 \ red Triple yellow Single green OBull red Bull} { set r1 $rings($v1) .c create oval -$r1 -$r1 $r1 $r1 -fill $c1 -tag $v1 -outline black # gwm add bind to get score. .c bind $v1 <ButtonRelease> [list score $v1 %x %y] } # h --> Sector labels for { set h 1 } { $h <= 20 } { incr h } { set angle [expr { $halfpi - $SectSize * $h }] set x [expr { 0 + 200 * cos($angle) }] set y [expr { 0 - 200 * sin($angle) }] set Sector [lindex {x 1 18 4 13 6 10 15 2 17 3 19 7 16 8 11 14 9 12 5 20} $h] .c create text $x $y -text $Sector -font {Helvetica -14} -fill white ;# -tag wire } for {set d 9} {$d<360} {set d [expr {$d+360./20.}]} { set rang [deg2rad $d] set xm [expr {cos($rang)*$rings(OBull)}] set ym [expr {sin($rang)*$rings(OBull)}] set x [expr {$xm+cos($rang)*$rings(Double)}] set y [expr {$ym+sin($rang)*$rings(Double)}] .c create line $xm $ym $x $y -tag "wire" } #########1#########2#########3#########4#########5#########6#########7##### proc score {v1 x y} { # gwm score the hit. # v1 is the circle hit (Out, Single etc.) global rad set x [expr {$x-$rad}] set y [expr {$rad-$y}] ;# y in window is opposite convention to mathematical # sector atan(1)/2.5 = 1/20 circle # add 5.5 would convert to sector in range -5 to 15 # added 25.5 to make sure >0 (atan2 returns -pi,pi angle) # modulo (%) converts to range 0-19. set sec [expr {int(25.5-2.5 * atan2 ( $y, $x ) / atan(1))%20 }] set score [lindex {20 1 18 4 13 6 10 15 2 17 3 19 7 16 8 11 14 9 12 5 20} $sec] switch -- $v1 { Out { set score 0} Single2 - Single { } Double { incr score $score} Triple { set score [expr {3*$score}]} Bull {set score 50} OBull {set score 25} } set cursc [.c.score1 cget -text] incr cursc -$score if {$cursc>1 || ($cursc==0 && $v1 eq "Double")} { # can continue to score but can only end (reach 0) on a double. .c.score1 configure -text $cursc } } # restart score proc restart {{from 301}} { .c.score1 configure -text $from } # add scoring at left. button .c.reset -text "Restart" -command "restart 301" .c create window [expr {30-$rings(Out)}] [expr {$rings(Out)-10}] -window .c.reset label .c.score1 -text "301" .c create window [expr {30-$rings(Out)}] [expr {10-$rings(Out)}] -window .c.score1