'''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.

I expect some interesting Tk implementations to appear, perhaps leading to some discussions of where Tk is ''not'' so strong and how it could be improved.

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!

**Naive Tk Implementations**

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].

***Counter***

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

package require Tk
package require lambda

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

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

***Temperature Converter***

======
#!/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***

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***

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 (!)three 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.

======
#!/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

======


***Cells***

There are examples like [A little spreadsheet] and [tiny spreadsheet] all over the wiki, which could probably do with modernisation ... this is a good example for [Tablelist] or [Tktable] to shine.

**Your Implementation**

----
<<categories>>GUI | Example