Updated 2013-03-05 02:05:33 by pooryorick

## 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

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.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```