Description edit
Richard Suchenwirth 2003-07-01: Yet another educational Tcltoy to play with triangles. Corners and sides are named, and the length of each side and angle at each corner is displayed.
set about "triangle.tcl
R. Suchenwirth 2003
Powered by Tcl/Tk!
Draw a rectangle by clicking on three points.
Click on a corner to see its x/y coordinates.
Move selected corner with the cursor keys.
Click Clear to start a new triangle."
if 0 { Challenge: construct rectangular (one angle 90°), isosceles (two angles equal), equilateral (all angles 60°) triangles - the last I haven't managed yet, because of integer pixel resolution. Stronger challenge: fix ''assignNames'' so it always maintains counter-clock sense for A, B and C.
proc main {} {
frame .f
label .f.i -width 28 -textvar info -bg white
button .f.a -text About -command {tk_messageBox -message $about}
button .f.c -text Clear -command {clear .c}
button .f.x -text X -command exit
eval pack [winfo children .f] -side left
pack .f [canvas .c -width 230]
.c config -scrollregion {-10 -200 200 10}
.c create line -10 0 200 0
.c create line 0 10 0 -200
bind .c <1> {tap %W %x %y}
bind .c <Up> {movePt %W 0 -1}
bind .c <Down> {movePt %W 0 1}
bind .c <Left> {movePt %W -1 0}
bind .c <Right> {movePt %W 1 0}
focus .c
clear .c
}
proc clear w {
$w delete my
set ::info "Select corners of triangle"
set ::points {}
set ::g(point) ""
}
proc tap {w x y} {
global points
set x [= round([$w canvasx $x])]
set y [= round([$w canvasy $y])]
if {[llength $points]<6} {
lappend points $x $y
$w create rect [= $x-1] [= $y-1] [= $x+1] [= $y+1] -tags "my point"
if {[llength $points]==6} {
set ::info "Click on a corner to move it"
assignNames $w
redraw $w
}
}
}
interp alias {} = {} expr
proc assignNames w {
global points g
foreach {x y} $points {
lappend t [list $x $y [= abs($x*$y)]]
}
set t [lsort -int -index 2 $t]
foreach p {A B C} xy $t {
foreach "g($p,x) g($p,y)" $xy break
}
}
proc redraw w {
global g
$w delete my
foreach p {A B C} {
set x($p) $g($p,x)
set y($p) $g($p,y)
}
foreach p {A B C} {
$w create text $x($p) $y($p) \
-text $p -tag "my point $p"
}
foreach p {A B C} {
foreach {x0 y0} [$w coords $p] break
$w itemconfig $p -text $p\n[angle $w $x0 $y0] -just center
}
$w bind point <1> {markPt %W}
drawLine $w a $x(C) $y(C) $x(B) $y(B)
drawLine $w b $x(A) $y(A) $x(C) $y(C)
drawLine $w c $x(A) $y(A) $x(B) $y(B)
}
proc drawLine {w name x y X Y} {
$w create line $x $y $X $Y -fill blue -tag my
set len [format %.2f [expr {hypot($x-$X,$y-$Y)}]]
$w create text [expr {($x+$X)/2}] [expr {($y+$Y)/2}] \
-text "$name: $len" -tag my
}
proc markPt w {
set id [$w find withtag current]
$w itemconfig point -fill black
set name [$w itemcget $id -text]
set ::g(point) [string index $name 0]
showPt $w $::g(point)
}
proc showPt {w name} {
$w itemconfig $name -fill red
foreach {x y} [$w coords $name] break
set ::info "$name x:$x y:[= {-$y}]"
}
proc angle {w x y} {
set angles {}
foreach id [$w find withtag point] {
foreach {x0 y0} [$w coords $id] break
if {$x==$x0 && $y==$y0} continue
lappend angles [expr {atan2($y-$y0,$x-$x0)}]
}
foreach {a1 a2} $angles break
set a [expr {abs($a1-$a2)*180/acos(-1.)}]
if {$a>180} {set a [expr {360-$a}]}
format %.2f $a
}
proc movePt {w dx dy} {
global g
set p $g(point)
if {$p==""} return
incr g($p,x) $dx
incr g($p,y) $dy
redraw $w
showPt $w $p
}
main
wm geometry . 235x280+0+0
