[RLE] (2014-03-21): On the page [tkAdsAdder - to enter TV ad start and end times, and grand total] [uniquename] presented a tool he had designed to allow him to time the amount of commercial (break) time during television shows that he watches.
At the bottom of the page, I suggested an alternate [GUI] for the tool. [uniquename] responded that the suggestion was a "Nice idea." and further suggested I code up an example and post it to the Wiki. Well, here is the alternate GUI.
There are a couple shifts from what I had initially outlined on the
[tkAdsAdder - to enter TV ad start and end times, and grand total] page.
1. Instead of a [text] widget, I decided to use a [ttk::treeview] widget as a simple table.
1. Instead of storing start and stop [clock seconds] values as a global list of lists, I decided to simply use two hidden columns of the [ttk::treeview] as the "state storage" for the example. I made this change because it eliminated the global list variable for state storage, and simplified handling the "edit an entry" GUI.
1. Instead of writing out the raw [clock seconds] values to a save file, I decided to make the save file a list of lines containing two [http://en.wikipedia.org/wiki/ISO-8601%|%ISO-8601] "combined date and time" values. I made this change because ISO-8601 combined date and time values are human readable (Unix seconds from 1970 values are not so much). This means that editing of saved interval value files requires only a basic text editor.
As I was finding time here and there to build out the script, [uniquename] added a further edit regarding the potential need to edit already created records as one is timing a sequence of break intervals. Since I had not posted anything yet, I went ahead and also included edit, insert, and delete functions for the interval values present in the [ttk::treeview] table. The edit, insert, and delete functions are non-modal, they do not block an existing interval timer that might be running when a user decides to edit, insert, or delete a record.
I also included a running stop-watch like view when the script is timing an interval. I had not suggested that feature on [uniquename]'s page.
Note that because this code uses [clock seconds] for gathering times, that while raw intervals and interval totals will be accurate, the physical date and time values will only be as accurate as the system clock that [Tcl] uses to aquire [clock seconds] values.
A picture of the main GUI:
[Ad Break Timer Screen Shot 1]
A picture of the edit/insert GUI (this shows an edit example):
[Ad Break Timer Screen Shot 2]
======
#!/usr/bin/env wish
# Copyright 2014 - Richard Ellis
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
# You should have received a copy of the GNU General Public License along
# with this program. If not, see .
# =========================================================================== #
# Note - the code below assumes that the system clock and local timezone are
# set accurately
# =========================================================================== #
# start-timer is fired from the main control button at the start of a timing
# segment - state is maintained by reconfiguring the -command attached to
# the button
proc start-timer { button } {
set start_seconds [ clock seconds ]
$button configure -text "Stop (0s elapsed)" \
-command [ list stop-timer $button $start_seconds ]
# also setup a ticking stop-watch effect on the button
after 500 [ list stop-watch $button $start_seconds ]
}
# =========================================================================== #
# stop-timer is fired from the main contorl button at the end of a timing
# segment - it stores the interval in the global log, resets the state of
# the button, and turns off the stop-watch timer
proc stop-timer { button start_seconds } {
after cancel [ list stop-watch $button $start_seconds ]
set stop_seconds [ clock seconds ]
$button configure -text Start \
-command [ list start-timer $button ]
# skip adding the interval to the log if the elapsed amount is zero
if { ($stop_seconds - $start_seconds) < 1 } { return }
add-entry-to-log $start_seconds $stop_seconds
}
# =========================================================================== #
# stop-watch is called from an [after] event to create a stop-watch count up
# timer effect in the main button label
proc stop-watch { button start_seconds } {
$button configure -text "Stop ([ hms [ expr { [ clock seconds ] - $start_seconds } ] ] elapsed)"
after 1000 [ list stop-watch $button $start_seconds ]
}
# =========================================================================== #
# add-entry-to-log adds an interval to the ttk::treeview widget and updates
# the total interval label
proc add-entry-to-log { start_seconds stop_seconds } {
set elapsed [ expr { $stop_seconds - $start_seconds } ]
.log insert {} end \
-values [ list [ clock format $start_seconds -format %H:%M:%S ] \
[ hms $elapsed ] \
$start_seconds \
$stop_seconds ]
.log see [ lindex [ .log children {} ] end ]
update-total .log
}
# =========================================================================== #
# update total encapsulates the command details necessary to update the
# total label
proc update-total { log } {
.total configure -text "Total break time is [ hms [ compute-total $log ] ]"
}
# =========================================================================== #
# hms converts an integer number of seconds into a human readable string
# listing the total hours, minutes, seconds contained in the integer - used
# for display and reporting purposes
proc hms { seconds } {
set hrs [ expr { $seconds / 3600 } ]
set min [ expr { ($seconds - ($hrs * 3600)) / 60 } ]
set sec [ expr { $seconds % 60 } ]
return [ expr { $hrs > 0 ? "${hrs}h " : "" } ][ expr { $min > 0 ? "${min}m " : "" } ]${sec}s
}
# =========================================================================== #
# compute-total calculates the total time contained in all intervals in the
# data parameter
proc compute-total { log } {
set total 0
foreach item [ $log children {} ] {
set temp [ $log set $item ]
dict with temp {
incr total [ expr { $stop_seconds - $start_seconds } ]
}
}
return $total
}
# =========================================================================== #
# save-data prompts for a filename and saves the contents of the global list
# into the given file
# the save format is human lines of readable ISO8601 format date-times, two
# date-times per line
proc save-data {} {
set filename [ tk_getSaveFile -parent . ]
if { $filename eq "" } { return }
if { [ catch {set fp [ open $filename {WRONLY CREAT TRUNC} ]} e1 e2 ] } {
tk_dialog .error "Error" "Error Saving Data\n$e1\n$e2" error 0 Dismiss
return
}
set fmt %Y-%m-%dT%H:%M:%S%z
foreach item [ .log children {} ] {
set temp [ .log set $item ]
dict with temp {
puts $fp [ list [ clock format $start_seconds -format $fmt ] \
[ clock format $stop_seconds -format $fmt ] ]
}
}
close $fp
}
# load-data loads the contents of a file into the global variable - then
# attempts to update the total and text widgets based upon the contents - if
# the contents generate an error an error dialog is presented
proc load-data {} {
set filename [ tk_getOpenFile -parent . -multiple false ]
if { $filename eq "" } { return }
if { [ catch {set fp [ open $filename {RDONLY} ]} e1 e2 ] } {
tk_dialog .error "Error" "Error Opening File\n$e1\n$e2" error 0 Dismiss
return
}
.log delete [ .log children {} ]
event generate .log <> ; # bug in treeview - deleting selected item does not fire <> event
set temp [ list ]
set fmt %Y-%m-%dT%H:%M:%S%z
if { [ catch {
foreach item [ split [ read -nonewline $fp ] \n ] {
lassign $item start_seconds stop_seconds
set start_seconds [ clock scan $start_seconds -format $fmt ]
set stop_seconds [ clock scan $stop_seconds -format $fmt ]
add-entry-to-log $start_seconds $stop_seconds
}
} e1 e2 ] } {
tk_dialog .error "Error" "Error Loading Data\n$e1\n$e2" error 0 Dismiss
return
}
close $fp
}
# =========================================================================== #
proc unique-toplevel {} {
set i 0
while { [ catch {set top [ toplevel .report[ incr i] ]} ] } {}
return $top
}
# =========================================================================== #
# show-report pops up a new window containing a text widget that displays a
# formatted report of the set of intervals contained in the treeview widget
proc show-report {} {
set top [ unique-toplevel ]
# build the report window
set text [ text $top.text ]
set vsb [ scrollbar $top.vsb -orient vertical -command [ list $text yview ] ]
$text configure -yscrollcommand [ list $vsb set ]
grid $text $vsb -sticky news
grid rowconfigure $top 0 -weight 1
grid columnconfigure $top 0 -weight 1
# test for any data available - do the right thing if no data
set items [ .log children {} ]
if { 0 == [ llength $items ] } {
wm title $top "No Data - No Report"
$text insert end "No data available - no report generated."
return
}
# build the report
$text insert end [ set temp "Ad-Time Report for [ clock format [ dict get [ .log set [ lindex $items 0 ] ] start_seconds ] -format "%B %d, %Y" ]" ]\n\n
wm title $top $temp
$text insert end "Ad\nSegment\n"
$text insert end "Number Start-time End-time Length\n"
$text insert end "------- ---------- ---------- ----------\n"
set fmt "%H:%M:%S"
set idx 0
foreach item $items {
incr idx
set temp [ .log set $item ]
dict with temp {
$text insert end [ format "%7d %-10s %-10s %10s\n" \
$idx \
[ clock format $start_seconds -format $fmt ] \
[ clock format $stop_seconds -format $fmt ] \
[ hms [ expr { $stop_seconds - $start_seconds } ] ] ]
}
}
$text insert end "\n\nTotal Ad Time: [ hms [ compute-total .log ] ]"
}
# =========================================================================== #
proc edit-entry {} {
foreach item [ .log selection ] {
edit-insert-window [ .log set $item ] $item
}
}
# =========================================================================== #
proc insert-entry {} {
edit-insert-window
}
# =========================================================================== #
proc edit-insert-window { {data {}} {treeid {}} } {
set top [ unique-toplevel ]
set state [ expr { 0 == [ dict size $data ] ? "Insert" : "Edit" } ]
wm title $top "$state Entry"
set fmt "%Y-%m-%d %H:%M:%S"
# show the original data from the selected entry
if { $state eq "Edit" } {
dict with data {
label $top.l1 -text "Old Data:" -anchor w
label $top.l2 -text "Start: " -anchor e
label $top.l3 -text [ clock format $start_seconds -format $fmt ] -anchor w
label $top.l4 -text "Stop: " -anchor e
label $top.l5 -text [ clock format $stop_seconds -format $fmt ] -anchor w
grid $top.l1 - -sticky news
grid $top.l2 $top.l3 -sticky news
grid $top.l4 $top.l5 -sticky news
}
}
# An instructional label
label $top.info -text "Date/time format: YYYY-MM-DD HH:MM:SS\n(24 hour clock)" \
-justify left -anchor w
grid $top.info - -sticky news
# edit entries
set temp [ expr { $state eq "Insert" ? "New Data: " : "Replace With: " } ]
label $top.edit -text $temp -anchor w
label $top.e1 -text "Start: " -anchor e
entry $top.start -justify left
label $top.e2 -text "Stop: " -anchor e
entry $top.stop -justify left
grid $top.edit - -sticky news
grid $top.e1 $top.start -sticky news
grid $top.e2 $top.stop -sticky news
if { $state eq "Edit" } {
dict with data {
$top.start insert end [ clock format $start_seconds -format $fmt ]
$top.stop insert end [ clock format $stop_seconds -format $fmt ]
}
}
# control button frame
set f [ frame $top.buttons ]
button $f.cancel -text Cancel -command [ list destroy $top ]
button $f.save -text Save -command [ list validate-edit $treeid $top ]
pack $f.save $f.cancel -side right
pack $f.cancel -side right -padx {5m 5m}
grid $f - -sticky news -pady {2m 0}
}
# =========================================================================== #
proc validate-edit { treeid top } {
# test that the entry values are in the proper format - change background
# color if not
set fmt "%Y-%m-%d %H:%M:%S"
set error false
foreach item {start stop} {
if { [ catch {
set ${item}_seconds [ clock scan [ $top.$item get ] -format $fmt ]
} ] } {
set error true
$top.$item configure -background yellow
}
}
if { $error } { return }
if { $stop_seconds < $start_seconds } {
# stop timestamp should never be smaller than start timestamp
$top.start configure -background yellow
$top.stop configure -background yellow
return
}
# Because the edit dialogs are mode-less, it is possible to edit an
# entry and while the edit window is open, delete that same entry. If
# that happens, just convert save into an insert new operation instead.
if { ($treeid ne "") && [ .log exists $treeid ] } {
.log set $treeid time_value [ clock format $start_seconds -format %H:%M:%S ]
.log set $treeid duration [ hms [ expr { $stop_seconds - $start_seconds } ] ]
.log set $treeid start_seconds $start_seconds
.log set $treeid stop_seconds $stop_seconds
update-total .log
} else {
add-entry-to-log $start_seconds $stop_seconds
}
# sort the .log entries into increasing order
# this is adapted from the code at http://wiki.tcl.tk/20930
set data {}
foreach row [ .log children {} ] {
lappend data [ list [ .log set $row start_seconds ] $row ]
}
set r -1
# Now reshuffle the rows into the sorted order
foreach info [ lsort -index 0 $data ] {
.log move [ lindex $info 1 ] {} [ incr r ]
}
destroy $top
}
# =========================================================================== #
# now initialize the GUI
# points sized fonts instead of pixel sized fonts
foreach font [ font names ] {
font configure $font -size [ expr { abs([ font configure $font -size ]) } ]
}
# a large size font for the main control button
font create LargeFont {*}[ font actual TkDefaultFont ]
font configure LargeFont -size 26
# the main control button
button .timer -text Start -command [ list start-timer .timer ] \
-font LargeFont -height 3
# a label to display the total of all captured intervals
label .total
# The ttk::treeview is used as a simple table to display each interval
# The start_seconds and stop_seconds columns are used to store the original
# [clock seconds] values - i.e., these two columns are the state storage for
# this app.
ttk::treeview .log -columns {time_value duration start_seconds stop_seconds} \
-displaycolumns {time_value duration} -show headings -yscrollcommand [ list .vsb set ]
.log heading time_value -text "Start Time"
.log heading duration -text "Duration"
.log column duration -anchor e
scrollbar .vsb -orient vertical -command [ list .log yview ]
grid .timer - -sticky news
grid .total - -sticky news
grid .log .vsb -sticky news
grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 1
# a menubar for the extra controls
menu .menubar
.menubar add cascade -label File -menu .menubar.file
.menubar add cascade -label Edit -menu .menubar.edit
# File ... menu
menu .menubar.file
.menubar.file add command -label "Report" -command [ list show-report ]
.menubar.file add command -label "Load Data ..." -command [ list load-data ]
.menubar.file add command -label "Save Data ..." -command [ list save-data ]
.menubar.file add separator
.menubar.file add command -label "Clear" -command {
.log delete [ .log children {} ] ; .total configure -text ""
event generate .log <>
}
.menubar.file add separator
.menubar.file add command -label "Exit" -command exit
# Edit ... menu
menu .menubar.edit
.menubar.edit add command -label "Edit ..." -state disabled -command edit-entry
.menubar.edit add command -label "Insert New ..." -command insert-entry
.menubar.edit add separator
.menubar.edit add command -label "Delete" -state disabled -command {
.log delete [ .log selection ]
event generate .log <>
update-total .log
}
. configure -menu .menubar
# set up a binding to automatically enable/disable the edit menu based upon
# what is selected in the treeview widget
bind .log <> { ::apply { {log} {
set mode [ expr { 0 == [ llength [ $log selection ] ] ? "disabled" : "normal" } ]
foreach item {Edit* Delete*} {
.menubar.edit entryconfigure $item -state $mode
}
} } %W }
wm title . "Ad Break Timer"
======
<> GUI | Example