ALM

Alexander Mueller, Homepage: http://virtuelle.gefil.de/~dondy

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 [namespace code [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

Unix Terminal Extension

Telnet

An analog clock in Tk