package require Tk

proc main argv {
    pack [frame .f] -fill x
    button .f.c -text " C " -command {.c delete all}
    button .f.r -text Reg -command {drawReg .c}
    eval pack [winfo children .f] -side left
    pack [canvas .c -bg white] -fill both -expand 1
    bind .c <Motion> {wm title . [%W canvasx %x]|[%W canvasy %y]}
    bind .c <1> {drawPoint %W %x %y}
    bind .c <2> {%W delete current}
}
proc drawPoint {w x y} {
    set x [$w canvasx $x]
    set y [$w canvasy $y]
    $w create rect $x $y [expr $x+2] [expr $y+2] -fill red -tag point
}
proc drawReg w {
    set xys {}
    foreach point [$w find withtag point] {
        lappend xys [center [$w bbox $point]]
    }
    foreach {a b} [linear'regression $xys] break
    set x1 [winfo width $w]
    set y1 [expr {$a + $b*$x1}]
    $w delete line
    $w create line 0 $a $x1 $y1 -fill green -tag line
}
proc center bbox {
    foreach {x0 y0 x1 y1} $bbox break
    list [expr {($x0+$x1)/2.}] [expr {($y0+$y1)/2.}]
}
proc linear'regression xys {
    set xsum 0.0; set ysum 0.0
    foreach xy $xys {
        foreach {x y} $xy break
        set xsum [expr {$xsum + $x}]
        set ysum [expr {$ysum + $y}]
    }
    set xm [expr {$xsum/[llength $xys]}]
    set ym [expr {$ysum/[llength $xys]}]
    set xsum 0.0; set ysum 0.0
    foreach xy $xys {
        foreach {x y} $xy break
        set dx [expr {$x - $xm}]
        set dy [expr {$y - $ym}]
        set xsum [expr {$xsum + $dx * $dy}]
        set ysum [expr {$ysum + $dx * $dx}]
    }
    set b [expr {$xsum / $ysum}]
    set a [expr {$ym - $b * $xm}]
    list $a $b
}
main $argv
#-- Useful little helper: quick restart
bind . <Escape> {exec wish $argv0 &; exit}