some improvements to the BClock :)
- new mail notification
- starting a programm on button press
set radius 10
set maildir [expr {([catch {file exists $env(MAIL)}] == "0")? \
"$env(MAIL)" : "/var/spool/mail/$env(USER)"}]
wm title . "BClock, initializing..."
wm aspect . 6 4 6000 4000
wm geometry . [expr $radius * 6 + 1]x[expr $radius * 4 + 1]
proc create_resize_ovals {value radius} {
foreach col {0 1 2 3 4 5} {
foreach row {0 1 2 3} {
set x1 [expr $col * $radius]
set y1 [expr $radius * 3 - $row * $radius]
set x2 [expr $x1 + $radius]
set y2 [expr $y1 + $radius]
if { $value == 0 } {
.b create oval $x1 $y1 $x2 $y2 -tag $col,$row
} elseif { $value == 1 } {
.b coords $col,$row $x1 $y1 $x2 $y2
} else {
exit 1
}
}
}
}
proc resize_canvas_ovals {width height} {
global radius
set radius [expr ($width / 6 + $height / 4) / 2]
.b configure -width [expr $radius * 6] -height [expr $radius * 4]
create_resize_ovals 1 $radius
}
proc every {ms body} {
eval $body
after $ms [info level 0]
}
. configure -bd 0 -highlightthickness 0
pack [canvas .b -background Black -highlightthickness 0 -bd 0]
create_resize_ovals 0 $radius
bind . <Configure> { resize_canvas_ovals %w %h }
# just for some extra functionality :D
bind . <ButtonPress-1> { exec -- xterm -fg white -bg black -e mutt & }
bind . <ButtonPress-2> { exec -- xterm -fg white -bg black & }
bind . <ButtonPress-3> { exec -- xterm -fg white -bg black -e vim & }
every 1000 {
global maildir
set mtime [file mtime $maildir]
set atime [file atime $maildir]
# if we have mail...
if { $mtime > $atime } {
# first approach to show the user we have mail
.b configure -background LimeGreen
. configure -bg LimeGreen
set led0 "DarkBlue"
set led1 "LightBlue"
# have audible notofication too :)
bell
} else {
.b configure -background Black
. configure -bg Black
set led0 "DarkRed"
set led1 "IndianRed1"
}
set time [ clock format [ clock sec ] -format "%T" ]
regexp {([0-2])([0-9]):([0-5])([0-9]):([0-5])([0-9])} \
$time -> h1 h2 m1 m2 s1 s2
wm title . "BClock, $time"
set values [list $h1 $h2 $m1 $m2 $s1 $s2]
foreach col {0 1 2 3 4 5} value $values {
foreach bit {0 1 2 3} {
set color [expr {$value & (1 << $bit)? "$led1" : "$led0" }]
.b itemconfigure $col,$bit -fill $color
}
}
}- telnet.tcl, my version of the telnet client found at Telnet
proc quit {fd_sock} {
close $fd_sock
set ::closed($fd_sock) 1
}
proc input {fd_sock} {
set data x
while {[string length $data]} {
set data [read $fd_sock 4096]
if {[eof $fd_sock]} {
quit $fd_sock
} else {
puts -nonewline stdout $data
}
}
}
proc output {fd_sock} {
if {[gets stdin data] >= 0} {
puts $fd_sock $data
} else {
quit $fd_sock
}
}
set fd_sock [socket 130.149.19.20 7680]
fconfigure $fd_sock -buffering none -blocking 0
fconfigure stdout -buffering none
fileevent $fd_sock readable [list input $fd_sock]
fileevent stdin readable [list output $fd_sock]
vwait closed($fd_sock)
exit- links
