home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / local / bin / countdown.tcl < prev    next >
Encoding:
Tcl/Tk script  |  2004-08-01  |  6.4 KB  |  278 lines
  1. #!/usr/bin/wish
  2.  
  3. #apologies to David, I have hacked his Countdown program somewhat...
  4.  
  5. # $Id: countdown.tcl,v 1.2 2003/10/27 16:33:15 davidw Exp $
  6. #package provide countdown 0.1
  7.  
  8. namespace eval ::countdown {
  9.     set seconds 0
  10.     set started 0
  11.     set starttime 0
  12.     set paused 0
  13. }
  14.  
  15. proc ::countdown::start {time} {
  16.     variable started
  17.     variable multiple
  18.     variable starttime
  19.     variable seconds
  20.     variable paused
  21.  
  22.     if { $time == 0 } {
  23.     return
  24.     }
  25.  
  26.     if { $paused } {
  27.     ::countdown::gui::unpause
  28.     set paused 0
  29.     }
  30.  
  31.     if { $started == 0 } {
  32.     set starttime $time
  33.     set seconds $time
  34.     starttimer
  35.     set started 1
  36.     } else {
  37.     starttimer
  38.     }
  39. }
  40.  
  41. proc ::countdown::pause {} {
  42.     variable paused
  43.  
  44.     set paused 1
  45.     stoptimer
  46.     ::countdown::gui::pause
  47. }
  48.  
  49. proc ::countdown::dotimer {} {
  50.     variable seconds
  51.  
  52.     incr seconds -1
  53.     ::countdown::gui::Update $seconds
  54.     if { $seconds <= 0 } {
  55.     ::countdown::gui::timeup
  56.     return
  57.     }
  58.     starttimer
  59. }
  60.  
  61. proc ::countdown::starttimer {} {
  62.     after [expr 1000] ::countdown::dotimer
  63. }
  64.  
  65. proc ::countdown::stoptimer {} {
  66.     foreach Id [after info] {
  67.     after cancel $Id
  68.     }
  69. }
  70.  
  71. proc ::countdown::reset {} {
  72.     variable started
  73.     variable seconds
  74.     variable starttime
  75.  
  76.     set started 0
  77.     set seconds 0
  78.     stoptimer
  79.     ::countdown::gui::reset $starttime
  80.     update
  81. }
  82.  
  83. proc ::countdown::getstart {} {
  84.     variable starttime
  85.     return $starttime
  86. }
  87.  
  88. ################################################
  89.  
  90. # countdowngui.tcl -- Tk Gui interface to cowntdown timer.
  91.  
  92. # $Id: countdowngui.tcl,v 1.3 2003/10/27 16:33:15 davidw Exp $
  93.  
  94. #package provide countdowngui 0.1
  95.  
  96. namespace eval ::countdown::gui {
  97.     if { [tk windowingsystem] == "x11" } {
  98.     option add *borderWidth 1 widgetDefault
  99.     option add *activeBorderWidth 1 widgetDefault
  100.     option add *selectBorderWidth 1 widgetDefault
  101.     option add *font -adobe-helvetica-medium-r-normal-*-12-*-*-*-*-*-*
  102.  
  103.     option add *padX 2
  104.     option add *padY 4
  105.  
  106.     option add *Listbox.background white
  107.     option add *Listbox.selectBorderWidth 0
  108.     option add *Listbox.selectForeground white
  109.     option add *Listbox.selectBackground #4a6984
  110.  
  111.     option add *Entry.background white
  112.     option add *Entry.selectBorderWidth 0
  113.     option add *Entry.selectForeground white
  114.     option add *Entry.selectBackground #4a6984
  115.  
  116.     option add *Text.background white
  117.     option add *Text.selectBorderWidth 0
  118.     option add *Text.selectForeground white
  119.     option add *Text.selectBackground #4a6984
  120.  
  121.     option add *Menu.activeBackground #4a6984
  122.     option add *Menu.activeForeground white
  123.     option add *Menu.activeBorderWidth 0
  124.     option add *Menu.highlightThickness 0
  125.     option add *Menu.borderWidth 2
  126.  
  127.     option add *MenuButton.activeBackground #4a6984
  128.     option add *MenuButton.activeForeground white
  129.     option add *MenuButton.activeBorderWidth 0
  130.     option add *MenuButton.highlightThickness 0
  131.     option add *MenuButton.borderWidth 0
  132.  
  133.     option add *highlightThickness 0
  134.     option add *troughColor #bdb6ad
  135.     }
  136.  
  137.     set bg 0
  138.     set alarm 0
  139.  
  140.     set ch 60
  141.     set cw 60
  142.     set coffset 15
  143.     set ovalx1 [expr 1 + $coffset]
  144.     set ovalx2 [expr 59 + $coffset]
  145.  
  146.     wm title . "Countdown Timer"
  147.     canvas .clock -height 60 -width 90 -bg white
  148.     set oval [.clock create oval $ovalx1 1 $ovalx2 59 -fill black]
  149.     set arc [.clock create arc $ovalx1 1 $ovalx2 59 -start 90 -extent 359 -fill green \
  150.          -disabledstipple gray50]
  151.  
  152.     label .lmin -text "Minutes:" -anchor w
  153.     label .lsec -text "Seconds:" -anchor w
  154.     entry .min -vcmd {string is integer %P} -validate key -width 3
  155.     .min insert 0 0
  156.     entry .sec -vcmd {string is integer %P} -validate key -width 3
  157.     .sec insert 0 0
  158. #    label .min -text "Minutes:"
  159. #    entry .time -textvariable ::countdown::minutes -background green
  160.  
  161.     button .start -text "Start" -command {::countdown::start [::countdown::gui::gettime]}
  162.     button .pause -text "Pause" -command ::countdown::pause
  163.     button .reset -text "Reset" -command ::countdown::reset
  164.     button .exit -text "Exit" -command {exit 0}
  165.  
  166.     set cols 2
  167.     grid .clock -columnspan $cols
  168.     grid .lmin .min -sticky ew
  169.     grid .lsec .sec -sticky ew
  170.     grid .start -sticky ew -columnspan $cols
  171.     grid .pause -sticky ew -columnspan $cols
  172.     grid .reset -sticky ew -columnspan $cols
  173.     grid .exit -sticky ew -columnspan $cols
  174.  
  175.     wm resizable . 0 0
  176. }
  177.  
  178. proc ::countdown::gui::reset {starttime} {
  179.     variable arc
  180.     variable oval
  181.     variable bg
  182.  
  183.     set bg 0
  184.     set min [expr {$starttime / 60}]
  185.     set sec [expr {$starttime % 60}]
  186.  
  187.     .min delete 0 end
  188.     .min insert 0 $min
  189.     .sec delete 0 end
  190.     .sec insert 0 $sec
  191.  
  192.     .clock itemconfigure $arc -extent 359
  193.     .clock itemconfigure $arc -fill green
  194.     .clock itemconfigure $oval -fill black
  195.     .clock configure -bg white
  196. }
  197.  
  198. proc ::countdown::gui::pause {} {
  199.     variable arc
  200.     variable paused
  201.     variable ovalx1
  202.     variable coffset
  203.  
  204.     .clock itemconfigure $arc -state disabled
  205.     set paused [.clock create text [expr {$coffset + 30}] 30 \
  206.             -text "Paused" -fill blue -font {Helvetica -22 bold}]
  207. }
  208.  
  209. proc ::countdown::gui::unpause {} {
  210.     variable paused
  211.     variable arc
  212.  
  213.     .clock itemconfigure $arc -state normal
  214.     catch {.clock delete $paused}
  215. }
  216.  
  217. proc ::countdown::gui::timeup {} {
  218.     variable alarm
  219.  
  220.     set alarm 1
  221.     update
  222.     ::countdown::gui::alarm
  223. }
  224.  
  225. proc ::countdown::gui::Update {seconds} {
  226.     variable arc
  227.     variable paused
  228.  
  229.     set min [expr {$seconds / 60}]
  230.     set sec [expr {$seconds % 60}]
  231.     set pct [expr {double($seconds) / [::countdown::getstart] * 360.0}]
  232.     if {$pct < 120} {
  233.     .clock itemconfigure $arc -fill red
  234.     } elseif {$pct < 240} {
  235.     .clock itemconfigure $arc -fill yellow
  236.     }
  237.     .clock itemconfigure $arc -extent $pct
  238.     .min delete 0 end
  239.     .min insert 0 $min
  240.     .sec delete 0 end
  241.     .sec insert 0 $sec
  242. }
  243.  
  244. proc ::countdown::gui::gettime {} {
  245.     return [expr {[.min get] * 60 + [.sec get]}]
  246. }
  247.  
  248. #if { ![catch { package require snack }] } {
  249. #    snack::sound alarmsound -file \
  250. #    [file join [file dirname [info script]] attention.wav]
  251. #
  252. #    set ::countdown::gui::alarmcmd [list alarmsound play -block 1]
  253. #} else {
  254.     set ::countdown::gui::alarmcmd bell
  255. #}
  256.  
  257. proc ::countdown::gui::alarm {} {
  258.     variable alarm
  259.     variable alarmcmd
  260.     variable bg
  261.     variable oval
  262.  
  263.     if { $bg } {
  264.     .clock configure -bg white
  265.     .clock itemconfigure $oval -fill black
  266.     set bg 0
  267.     } else {
  268.     .clock configure -bg black
  269.     .clock itemconfigure $oval -fill white
  270.     set bg 1
  271.     }
  272.     eval $alarmcmd
  273.     if { $alarm } {
  274.     after idle [list after 100 ::countdown::gui::alarm]
  275.     }
  276. }
  277.  
  278.