A (detailed) sliderule (lines drawn on a canvas widget)
FROM: http://en.wikibooks.org/wiki/Tcl_Programming/Tk_examples
(imaged on 2009 mar 19)

This project recreates a slide rule (roughly an Aristo-Rietz Nr. 89
with 7 scales - high-notch ones had up to 24) with a white "body"
and a beige "slide" which you can move left or right with
mouse button 1 clicked, or in pixel increment with the
<Shift-Left>/<Shift-Right> cursor keys.

The blue line represents the "mark" (how is that correctly called?
"runner"? "slider"?) which you can move with the mouse over the whole
thing to read a value. Fine movements with <Left>/<Right>.

Due to rounding errors (integer pixels), this plaything is even less
precise than a physical slide rule was, but maybe you still enjoy
the memories... 

Recall that the basic principle is that multiplication is done by adding
logarithms, hence most of the scales are logarithmic, with uneven increments.

SAMPLE CODE:
------------


proc ui {} {
   set width 620
   pack [canvas .c -width $width -height 170 -bg white]
   pack [label .l -textvariable info -fg blue] -fill x
   .c create rect 0 50 $width 120 -fill grey90
   .c create rect 0 50 $width 120 -fill beige -outline beige \
       -tag {slide slidebase}
   .c create line 0 0 0 120 -tag mark -fill blue
   drawScale .c K  x3    10 5    5 log10 1 1000 186.6666667
   drawScale .c A  x2    10 50  -5 log10 1 100 280
   drawScale .c B  x2    10 50   5 log10 1 100 280 slide
   drawScale .c CI 1/x   10 90 -5 -log10 1 10  560 slide
   drawScale .c C  x     10 120 -5 log10 1 10  560 slide
   drawScale .c D  x     10 120  5 log10 1 10  560
   drawScale .c L "lg x" 10 160 -5 by100  0 10   5600
   bind .c <Motion> {.c coords mark %x 0 %x 170; set info [values .c]}
   bind .c <1> {set x %x}
   bind .c <B1-Motion> {%W move slide [expr {%x-$x}] 0; set x %x}
   bind . <Shift-Left>  {.c move slide -1 0; set info [values .c]}
   bind . <Shift-Right> {.c move slide  1 0; set info [values .c]}
   bind . <Left>  {.c move mark -1 0; set info [values .c]}
   bind . <Right> {.c move mark  1 0; set info [values .c]}
}

proc drawScale {w name label x y dy f from to fac {tag {}}} {
   set color [expr {[string match -* $f]? "red": "black"}]
   $w create text $x [expr $y+2*$dy] -text $name -tag $tag -fill $color
   $w create text 600 [expr $y+2*$dy] -text $label -tag $tag -fill $color
   set x [expr {[string match -* $f]? 580: $x+10}]
   set mod 5
   set lastlabel ""
   set lastx 0
   for {set i [expr {$from*10}]} {$i<=$to*10} {incr i} {
       if {$i>100} {
           if {$i%10} continue ;# coarser increments
           set mod 50
       }
       if {$i>1000} {
           if {$i%100} continue ;# coarser increments
           set mod 500
       }
       set x0 [expr $x+[$f [expr {$i/10.}]]*$fac]
       set y1 [expr {$i%(2*$mod)==0? $y+2.*$dy: $i%$mod==0? $y+1.7*$dy: $y+$dy}]
       set firstdigit [string index $i 0]
       if {$y1==$y+$dy && abs($x0-$lastx)<2} continue
       set lastx $x0
       if {$i%($mod*2)==0 && $firstdigit != $lastlabel} {
           $w create text $x0 [expr $y+3*$dy] -text $firstdigit \
              -tag $tag -font {Helvetica 7} -fill $color
           set lastlabel $firstdigit
       }
       $w create line $x0 $y $x0 $y1 -tag $tag -fill $color
   }
}

proc values w {
   set x0 [lindex [$w coords slidebase] 0]
   set x1 [lindex [$w coords mark] 0]
   set lgx [expr {($x1-20)/560.}]
   set x [expr {pow(10,$lgx)}]
   set lgxs [expr {($x1-$x0-20)/560.}]
   set xs [expr {pow(10,$lgxs)}]
   set res     K:[format %.2f [expr {pow($x,3)}]]
   append res "  A:[format %.2f [expr {pow($x,2)}]]"
   append res "  B:[format %.2f [expr {pow($xs,2)}]]"
   append res "  CI:[format %.2f [expr {pow(10,-$lgxs)*10}]]"
   append res "  C:[format %.2f $xs]"
   append res "  D:[format %.2f $x]"
   append res "  L:[format %.2f $lgx]"
}

proc pow10 x {expr {pow(10,$x)}}
proc log10 x {expr {log10($x)}}
proc -log10 x {expr {-log10($x)}}
proc by100  x {expr {$x/100.}}

#--------------------------------
ui
bind . <Escape> {exec wish $argv0 &; exit}