** 7GUIs: A Notational Usability Benchmark for GUI Programming **

'''https://github.com/eugenkiss/7guis/wiki%|%7GUIs%|%''' is an interesting project to analyse the usability of different GUI toolkits.  The 7 mini-application examples give focussed examples of important GUI patterns, such that the implementation should serve as a guide to how the language and toolkit under use help or hinder the programmer.  The linked page includes several interesting references and sample implementations.

I hope to see some interesting Tk implementations to appear, perhaps leading to some discussions of where Tk is ''not'' so strong and how it could be improved.
Solutions using Tk wrappers such as [GRIDPLUS2], Dynaforms and [TAO%|%TAO/Tk] are particularly welcome.

Please add your implementations to this page, or critique ones already here.  Adding a single solution (instead of all 7) is welcome, particularly if it highlights a beautiful technique.
While showing off 3rd-party libraries is encouraged, at least one "naive Tk" implementation of each example should exist.
Though for `Cells` I fully endorse the use of [tablelist], purely on the assumption that no Tk programmer should be without it!

** Overview of Implementation(s) **

*** Naïve Tk ***

[aspect]:  These are intended to highlight how to use core Tcl/Tk features without relying on 3rd-party libraries.  The code should be self-contained, though relying on bundled extensions such as [ttk], [sqlite3] is not discouraged and [tcllib] / [tklib] dependencies are not out of the question.

Enough "good practice" should be present to make the examples easy to extend or incorporate into a larger program without butchery.  Thus doing everything inside a [namespace], despite the extra verbosity of [namespace which].

The first 5 examples included below (all but Flight Booker and Crud) were hacked together somewhat hastily on a Sunday afternoon, the same day I saw the original article.  The two remaining I shied away from, as a significant part of their challenge is "Form layout", which I find to be one of Tk's weaknesses.  A solution based on WJD's Dynaforms (link below) makes these much nicer to write, but my version is currently in "over-engineered" state and not yet ready for release.
** Counter **

*** Naïve Tk ***
======
#!/usr/bin/env tclsh

package require Tk

namespace eval app {
    variable c 0
    entry .e -state readonly -textvariable [namespace which -variable c]
    button .b -text Count -command [list incr [namespace which -variable c]]
    pack .e .b -side left
    wm title . Counter
}

wm protocol . WM_DELETE_WINDOW exit
vwait forever
======

** Temperature Converter **

*** Naïve Tk ***

======
#!/usr/bin/env tclsh

package require Tk
package require lambda

namespace eval app {
    variable c 0
    variable f 32

    proc c2f {} {
        puts c2f
        variable c
        variable f
        set f [format %.1f [expr {$c * 9 / 5.0 + 32}]]
    }
    proc f2c {} {
        puts f2c
        variable f
        variable c
        set c [format %.1f [expr {($f - 32) * 5 / 9.0}]]
    }

    entry .c -textvariable [namespace which -variable c]
    entry .f -textvariable [namespace which -variable f]
    label .cl -text "\u00b0 Celcius"
    label .fl -text "\u00b0 Fahrenheit"

    trace add variable c write [lambda@ [namespace current] args c2f]
    trace add variable f write [lambda@ [namespace current] args f2c]

    pack .c .cl .f .fl -side left
}

wm title . "Temperature Converter"
wm protocol . WM_DELETE_WINDOW exit
vwait forever
======

** Flight Booker **

This is an example of dependent widgets (whose readonly status is a function of other widgets' values), which is fun with an approach like [WJD]'s http://www.tcl.tk/community/tcl2013/abstract.html#wd2%|%dynaforms%|% (paper http://www.tclcommunityassociation.org/wub/proceedings/Proceedings-2013.html%|%here%|%), but a little cumbersome in ordinary Tk (imo).
Example Coming Soon.

** Timer **

*** Naïve Tk ***

Naïve solutions #1 and #2 above are already beginning to show that namespace management easily become distracting.  [TclOO] helps a lot:

======
#!/usr/bin/env tclsh

package require Tk
package require lambda

oo::class create Timer {
    variable percent 0
    variable started [clock milliseconds]
    variable seconds 0s
    variable duration 10.0

    constructor {} {
        set duration 10.0

        label .pl -text "Elapsed Time:"
        ttk::progressbar .p -variable [my varname percent] -orient h

        label .l -textvariable [my varname seconds]
        label .sl -text "Duration:"

        scale .s -variable [my varname duration] -orient h -from 0.0 -to 15.0 -resolution 0.1

        button .r -text "Reset" -command [namespace code {my reset}]

        grid .pl .p -sticky nsew
        grid .l - -sticky nsew
        grid .sl .s -sticky nsew
        grid .r - -sticky nsew
        grid columnconfigure . 1 -weight 1

        wm title . Timer

        my reset
        after idle [namespace code {my tick}]
    }

    method reset {} {
        set started [clock milliseconds]
    }

    method tick {} {
        set now [clock milliseconds]
        set elapsed [expr {($now - $started) / 100 / 10.0}]
        set percent [expr {$elapsed * 100 / $duration}]
        if {$percent <= 100} {
            set seconds [format %.1fs $elapsed]
        } else {
            set started [expr {$now - int($duration * 1000)}]
        }
        after idle [namespace code {my tick}]
    }
}

Timer create t
wm protocol . WM_DELETE_WINDOW exit
vwait forever
======

** Crud **

Pretty sure we've all written more than plenty of these, but a concise, readable example using modern features will be fun.

** Circle Drawer **

*** Naïve Tk ***

This is a nice little demo of [canvas], but also calls for some helper code.  The most interesting part is an [http://wiki.tcl.tk/16681%|%undo] facility.

The code below is very rough, but it demonstrates some patterns that really ought to be factored out for reuse .. unless anyone has something better pre-rolled? ;-)

   BUG:   undo doesn't work, as it expects canvas id's to be reused in some magical way.  The fix for this use tags, with some further helper code.
   NOTE:   behaviour is slightly different to the spec, in that selection is by hover and the right-click menu is skipped.  Interesting to note that properties of the task as specified seem to make assumptions about the toolkit used .. I count four (!!) gestures to begin resizing a circle, vs two here.

The verbosity of this implementation suggests that it's showing some gaps where Tk could help some more.  Still, 200 lines isn't terrible.

<<discussion>>
======
#!/usr/bin/env tclsh

package require Tk
package require lambda

# wraps a script in a lambda that ignores all its arguments
# useful for making traces
proc ignoreargs {script} {
    lambda@ [uplevel 1 {self namespace}] args $script
}

# list-based stack
interp alias {} lpush {} lappend
proc lpop {_ls varName args} {
    upvar 1 $_ls ls
    set vals [lrange $ls end-[llength $args] end]
    set ls [lreplace $ls end-[llength $args] end]
    tailcall ::foreach [list $varName {*}$args] $vals {}
}

# [incr] that doesn't choke on floats
proc incf {varName {expr 1}} {
    set varName [list $varName]
    tailcall if "\[info exists $varName\]" "
                    set $varName \[expr {\${$varName} + $expr}\]
    " "else" "
                    set $varName \[expr {$expr}\]
    "
}

# dialog box which handles resizing
oo::class create Resizer {
    variable w
    variable radius
    variable id
    variable obj
    variable undo
    constructor {W Obj Id} {
        set w $W
        set obj $Obj
        set id $Id
        lassign [$obj get_center $id] x y
        set radius [$obj get_radius $id]
        set undo [list resize_circle $id $radius]
        label $w.l -text "Adjust diameter of circle at ($x, $y)"
        scale $w.s -variable [my varname radius] -orient h -from 10.0 -to 500.0 -resolution 1.0
        button $w.b -text "Done" -command [namespace code {my Done}]
        button $w.c -text "Cancel" -command [namespace code {my Cancel}]
        grid $w.l - -sticky nsew
        grid $w.s - -sticky nsew
        grid $w.b $w.c -sticky nsew
        trace add variable [my varname radius] write [ignoreargs {my Changed}]
    }
    method Changed {} {
        puts "Resizing $id to $radius"
        $obj resize_circle $id $radius
    }
    method Cancel {} {
        $obj {*}$undo
        destroy $w
        after idle [list [self] destroy]
    }
    method Done {} {
        $obj push_undo $undo
        destroy $w
        after idle [list [self] destroy]
    }
}

proc resize_circle {obj id} {
    set w .resize_${id}
    if {[winfo exists $w]} {
        raise $w
        focus $w
        return
    }
    toplevel $w
    Resizer new $w $obj $id
}

oo::class create Circles {
    constructor {} {
        canvas .c -width 480 -height 320 -background white
        button .u -text "Undo" -command [namespace code {my undo}]
        button .r -text "Redo" -command [namespace code {my redo}]
        grid .c - -sticky nsew
        grid .u .r -sticky nsew
        grid columnconfigure . 0 -weight 1
        grid columnconfigure . 1 -weight 1
        grid rowconfigure . 0 -weight 1
        bind .c <Configure> [namespace code {my canvas.configure %w %h}]
        bind .c <Button-1> [namespace code {my canvas.b1 %x %y}]
        bind .c <Button-3> [namespace code {my canvas.b3 %x %y}]
        oo::objdefine [self] forward canvas .c
    }

    # event handlers
    method canvas.configure {w h} {
        # .c scale all 0 0 [expr {1.0/$w}] [expr {1.0/$h}]
    }
    method canvas.b1 {x y} {
        set item [.c find withtag current]
        if {$item ne ""} {
            # do nothing
        } else {
            my do add_circle $x $y
        }
    }
    method canvas.b3 args {
        set item [.c find withtag current]
        if {$item ne ""} {
            resize_circle [self] $item
        }
    }

    # undo helpers
    variable undo_stack
    variable redo_stack
    method do {cmd args} {
        lpush undo_stack [my $cmd {*}$args]
    }
    method push_undo {cmd args} {
        lpush undo_stack $cmd {*}$args
    }
    method undo {} {
        if {$undo_stack eq ""} {return}
        lpop undo_stack cmd
        puts "undo: $cmd"
        lpush redo_stack [my {*}$cmd]
    }
    method redo {} {
        if {$redo_stack eq ""} {return}
        lpop redo_stack cmd
        puts "redo: $cmd"
        lpush undo_stack [my {*}$cmd]
    }

    # circle geometry helpers
    method get_center {item} {
        foreach {x0 y0} [.c coords $item] {
            incf x $x0
            incf y $y0
            incr n
        }
        set x [expr {$x / $n}]
        set y [expr {$y / $n}]
        list $x $y
    }
    method get_radius {item} {
        lassign [.c coords $item] x0 y0 x1 y1
        expr {( ($x1 - $x0) + ($y1 - $y0) ) / 4}
    }

    # actions: each of these returns an undo action
    method add_circle {x y {r 50} args} {
        set x0 [expr {$x-$r}]
        set x1 [expr {$x+$r}]
        set y0 [expr {$y-$r}]
        set y1 [expr {$y+$r}]
        set id [.c create oval $x0 $y0 $x1 $y1 -fill white {*}$args -activefill grey]
        return [list delete_circle $id]
    }

    method delete_circle {id} {
        foreach {x y} [my get_center $id] {}
        set r [my get_radius $id]
        set cfg [lmap ci [.c itemconfigure $id] {
            if {[lindex $ci 4] eq [lindex $ci 3]} {
                # catches defaults and synonyms
                continue
            }
            list [lindex $ci 0] [lindex $ci 4]
        }]
        .c delete $id
        return [concat add_circle $x $y $r {*}$cfg]
    }

    method resize_circle {id radius} {
        foreach {x y} [my get_center $id] {}
        set oldr [my get_radius $id]
        set x0 [expr {$x - $radius}]
        set x1 [expr {$x + $radius}]
        set y0 [expr {$y - $radius}]
        set y1 [expr {$y + $radius}]
        .c coords $id $x0 $y0 $x1 $y1
        return "resize_circle $id $oldr"
    }

}

Circles create c
wm protocol . WM_DELETE_WINDOW exit

======
<<discussion>>


** Cells **

*** Naïve Tablelist ***

This one uses the brilliant [tablelist] widget to simulate a spreadsheet UI.  In a slight deviation from the normal spec, cell references are prefixed with `$`:  more specifically, formulas are of the form '''=''expr''''', where '''''expr''''' is a Tcl [expr]ession, where `$A2`, `$B6`, `$Z99` refer to other cells' values.

It features a clever `unbound` command, which [colin] once shared with the chat.

Keyboard bindings and the size of the edit window could be improved.

Other examples like this exist on the wiki .. see [A bigger spreadsheet] for one.

<<discussion>>
======
#!/usr/bin/env tclsh
#
package require Tk
package require tablelist

# REQUIRES:
#   [lremove]
    proc lremove {_ls args} {
        upvar 1 $_ls ls
        foreach a $args {
            set ls [lsearch -exact -not -all -inline $ls $a]
        }
    }
#   [unbound]   -- originally from colin
    proc unbound {__text} {
        set __unbound {}
        while {$__text ne ""} {
            try {
                dict with __unbound {
                    subst -nocommands -nobackslashes $__text
                }
            } trap {TCL LOOKUP VARNAME} {__e __eo} {
                dict set __unbound [lindex [dict get $__eo -errorcode] end] \$[lindex [dict get $__eo -errorcode] end]
            } on error {e eo} {
                puts stderr "$e ($eo)"
                return -options $eo $e  ;# improvement due to dgp
            } on ok {} {
                return [dict keys $__unbound]
            }
        }
    } 


variable Alphabet " ABCDEFGHIJKLMNOPQRSTUVWXYZ"

oo::class create Sheet {
    variable W
    variable Values     ;# list of lists of values, bound to display
    variable Formulas   ;# array(CellId) -> "=$expr"
    variable Depends    ;# array(CellId) -> {dependent cellids ..}

    constructor {{w .}} {
        if {$w eq "."} {set w ""}
        set W $w

    # create widgets
        tablelist::tablelist ${W}.tl -selecttype cell
        ttk::sizegrip ${W}.z -takefocus 0

        scrollbar ${W}.sy -orient v -command [list ${W}.tl yview]
        scrollbar ${W}.sx -orient h -command [list ${W}.tl xview]
        ${W}.tl configure -xscrollcommand [list ${W}.sx set]
        ${W}.tl configure -yscrollcommand [list ${W}.sy set]

    # set up tablelist
        $W.tl configure -columntitles [split $::Alphabet ""]
        $W.tl configure -editstartcommand [namespace code {my EditStart}]
        $W.tl configure -editendcommand [namespace code {my EditEnd}]
        for {set i 1} {$i < 27} {incr i} {
            $W.tl columnconfigure $i -editable 1
        }
    # columns don't support -relief or -border .. FIXME!
        foreach opt {background foreground font } {
            $W.tl columnconfigure 0 -${opt} [$W.tl cget -label${opt}]
        }

    # set up Values
        set 26 [lrepeat 26 {}]
        for {set i 0} {$i < 99} {incr i} {
            lappend Values [list $i {*}$26]
        }
        $W.tl configure -listvariable [my varname Values]

    # lay out:
        grid ${W}.tl ${W}.sy -sticky nsew
        grid ${W}.sx ${W}.z -sticky nsew
        set w .[string trimleft $W .]
        grid columnconfigure $w 0 -weight 1
        grid rowconfigure $w 0 -weight 1
    }

    method Eval {script} {  ;# debugging helper
        try $script
    }
    
    method CellId {x y} {
        return [string index $::Alphabet $x]$y
    }
    method CellRef {id} {
        regexp {([A-Z]+)([0-9]+)} $id -> x y
        set x [string first $x $::Alphabet]
        list $x $y
    }

    method EditStart {tl y x dispvalue} {
        set cellid [my CellId $x $y]
        if {[info exists Formulas($cellid)]} {
            set f $Formulas($cellid)
            unset Formulas($cellid)
            foreach ub [unbound $f] {
                lremove Depends($ub) $cellid
            }
            return $f
        }
        return $dispvalue
    }
    method EditEnd {tl y x newvalue} {
        set cellid [my CellId $x $y]
        after idle [namespace code [list my Recalculate $cellid]]
        if {[string match =* $newvalue]} {
            set Formulas($cellid) $newvalue
            foreach ub [unbound $newvalue] {
                if {![info exists Depends($ub)] || $cellid ni $Depends($ub)} {
                    lappend Depends($ub) $cellid
                }
            }
            return -1
        }
        # $tl rejectinput
        return $newvalue
    }

    method Evaluate {expr} {
        set expr [string trimleft $expr =]
        set env [lmap name [unbound $expr] {
            lassign [my CellRef $name] x y
            list $name [lindex $Values $y $x]
        }]
        try {
            apply [list $env [list expr $expr]]
        } on error {e o} {
            return "#!ERROR"
        }
    }
    method Recalculate {cellid} {
        lassign [my CellRef $cellid] x y
        if {[info exists Formulas($cellid)]} {
            set expr $Formulas($cellid)
            set val [my Evaluate $expr]
            lset Values $y $x $val
        }
        if {[info exists Depends($cellid)]} {
           foreach dep $Depends($cellid) {
               after idle [namespace code [list my Recalculate $dep]]
           }
        }
    }
}

Sheet create s
wm protocol . WM_DELETE_WINDOW exit
======
<<discussion>>

**Your Implementation**

<<categories>>GUI | Example