if 0 {[Richard Suchenwirth] 2003-07-01 - "Rulers" are popular mini-applications on [PocketPC]s. Here's my take on the [iPaq] - for other displays, you might have to fine-tune the ppmm (pixels per millimeter) variable. Besides cm (resolution 1/10, i.e. mm) and inch (resolution 1/16) scales, it allows pixel-precise measurements of small objects like coins, by placing them on screen, aligned to the red bar, and adjusting the black bar until it fits to about 1/100 in.

[http://mini.net/files/iRule.jpg]
}
 wm title . "Tcl/Tk rules!"
 set ppmm 4.191
 pack [canvas .c -width 235 -height 300 -borderwidth 0]
 button .x -text X -command exit
 .c create window 228 14 -window .x
 set y0 288
 .c create text 25 8 -text "cm"
 .c create line 5 0 5 $y0
 for {set mm 0} {$mm<70} {incr mm} {
    set y [expr {$y0-$mm* $ppmm }]
    if {$mm%10==0} {
      set x1 15
      .c create text 25 $y -text [expr $mm/10]
    } elseif {$mm%10==5} {
       set x1 15
    } else {
      set x1 10
    }
    .c create line 5 $y $x1 $y
 }
 .c create text 75 8 -text "inch"
 .c create line 50 0 50 $y0
 set ppi16 [expr $ppmm*25.4/16]
 for {set i16 0} {$i16<48} {incr i16} {
    set y [expr {$y0-$i16* $ppi16 }]
    if {$i16%16==0} {
       set x 63
       .c create text 70 $y -text [expr $i16/16]
    } elseif {$i16%8==0} {
        set x 63
    } elseif {$i16%4==0} {
        set x 60
    } elseif {$i16%2==0} {
        set x 57
    } else {set x 54}
    .c create line 50 $y $x $y
 }
#-------- Custom measure
 .c create text 160 35 -text "
   Custom measurements:
   Place object on screen.
   Align with red bar.
   Tap for approximate top.
   Fine-tune with <Up>/<Down>." -fill blue
 proc redraw {} {
    global toy ppmm ppi16 y0
    .c delete to
    .c create line 80 $toy 200 $toy -tag to
    set dy [expr $y0-$toy]
    set cm [format %.2f [expr $dy/$ppmm/10.]]
    set in [format %.2f [expr $dy/$ppi16/16.]]
    .c create text 130 80 -text "$cm cm/$in in." -tag to
 }
 .c create line 80 $y0 200 $y0 -fill red
 set toy 120; redraw
 bind .c <1> {set toy %y; redraw}
 bind . <Up> {incr toy -1; redraw}
 bind . <Down> {incr toy 1; redraw}

 bind . <Return> {exec wish $argv0 &; exit}
 wm geometry . +0+0