#! /bin/env tclsh

package require Tk

proc sec:yesnohelp {w args} {
    array set opts {
        -title "Operation Control" 
        -text "Do you really want to quit?"
    }
    array set opts $args
 
    toplevel $w
    wm title $w $opts(-title)
    pack [canvas $w.c -bg #FDFDFD -width 220 -height 155] -fill both -expand 1
 
    sec:button $w.c 100 15 Help
 
    $w.c create text 5 55 -text $opts(-text) -anchor nw
 
    sec:button $w.c 100 80 NO
    sec:button $w.c 100 120 YES
}
proc sec:button {c x y text} {
    set r 25
    $c create rect [expr $x+$r/2.]  [expr $y+2] \
        [$c cget -width] [expr $y+$r+2] -fill black -tags [list _$text bt]
    $c create oval [expr $x] [expr $y+2] [expr $x+$r+2] [expr $y+$r+2] \
        -fill black -tags [list _$text bt]
    $c create rect [expr $x+$r/2.]  $y \
        [$c cget -width] [expr $y+$r] -fill gray70 -tags [list _$text bt]
    $c create oval $x $y [expr $x+$r] [expr $y+$r] -fill gray70 \
        -tags [list _$text bt]
    $c create rect [expr $x+$r/2.]  [expr $y+1] [expr $x+$r] [expr $y+$r-1] \
        -fill gray70 -outline gray70 -tag [list _$text bt]
    $c create text [expr $x+$r-5] [expr $y+$r/2.] -text $text -anchor w \
        -tags [list _$text bt]
    $c bind _$text <1> [list $c move _$text 2 2]
    $c bind _$text <ButtonRelease-1> [list $c move _$text -2 -2]
}
 
wm withdraw .
sec:yesnohelp .1 -text "Do you really want to quit?"
.1.c bind _YES <ButtonRelease-1> exit