HJG 2007-07-13 - A dartboard, as specified at
http://www.dartswdf.com/aa_darts/playdarts.htm
and
http://en.wikipedia.org/wiki/DartsSorry, 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"
}
Screenshots Section
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
