Tkchat Multimedia Stream plugin

# Tkchat multimedia stream reader
#
# This is a simple Ogg or MP3 stream player derived from original code by
# David Zolli (Kroc) and Reinhard Max (rmax) (http://wiki.tcl.tk/12619)
# Hacked extensively by Pat Thoyts (patthoyts)

if {[catch {
    package require snack 2.2
    package require snackogg
    package require http
}]} {
    return
}

namespace eval ::tkchat::mms {
    variable streams
    if {![info exists streams]} {
        set streams {
            "Tcl conference (EU server)" "http://eu.tclers.tk/conference.ogg"
            "Tcl conference (US server)" "http://us.tclers.tk/conference.ogg"
            "-"            {}
            "Trance"       "http://scfire-ntc-aa04.stream.aol.com:80/stream/1003"
            "Top 40 Hits"  "http://scfire-nyk-aa01.stream.aol.com:80/stream/1014"
            "Classical"    "http://scfire-dll-aa02.stream.aol.com:80/stream/1006"
        }
    }
}

proc ::tkchat::mms::Play {url} {
    if {[catch {http::geturl $url -handler [namespace origin Stream]} err]} {
        tkchat::addStatus 0 "Unable to open stream at \"$url\": $err" end ERROR
    }
}

proc ::tkchat::mms::Stream {socket tok} {
    fileevent $socket readable {}
    Init
    Status Buffering
    ::snack::sound snd -channel $socket -buffersize 163840
    Wait 3000
    Status Playing
    after idle [list snd play -blocking 0]
    return 0
}

proc ::tkchat::mms::Wait {total {done 0}} {
    ::tkchat::Progress {} $total $done
    while {$done < $total} {
        variable wait 0
        after 100 [list set [namespace which -variable wait] 1]
        tkwait variable [namespace which -variable wait]
        ::tkchat::Progress {} $total [incr done 100]
    }
    return
}

proc ::tkchat::mms::Pause {} {
    snd pause
    if {[.status.mms itemcget pause -image] eq "::tkchat::mms::imgPause"} {
        .status.mms itemconfigure pause -image ::tkchat::mms::imgPlay
    } else {
        .status.mms itemconfigure pause -image ::tkchat::mms::imgPause
    }
}

proc ::tkchat::mms::Stop {} {
    if {[catch {snd stop} err]} {
        Status $err
        ::snack::audio stop
    } else {
        Status Stopped
    }
    after 1000 {destroy .status.mms}
}

proc ::tkchat::mms::Status {message} {
    if {[winfo exists .status.mms]} {
        .status.mms itemconfigure label -text $message
    } else {
        ::tkchat::addStatus 0 $message
    }
}

proc ::tkchat::mms::Init {} {
    if {[lsearch -exact [font names] MMS] == -1} {
        font create MMS -family {Small Fonts} -size 6 -weight normal
    }
    image create bitmap ::tkchat::mms::imgPause -foreground green -data {
        #define pause_width 7
        #define pause_height 6
        static unsigned char pause_bits[] = {
            0x77, 0x77, 0x77, 0x77, 0x77, 0x77};
    }
    image create bitmap ::tkchat::mms::imgPlay -foreground green -data {
        #define play_width 5
        #define play_height 7
        static unsigned char play_bits[] = {
            0x03, 0x07, 0x0f, 0x1f, 0x0f, 0x07, 0x03};
    }
    if {[winfo exists .status] && ![winfo exists .status.mms]} {
        canvas .status.mms -width 96 -height 18 -background black
        .status.mms create image 80 4 -tags pause -anchor nw -image ::tkchat::mms::imgPause
        .status.mms create rectangle 88 3 95 10 -tags stop -fill green
        .status.mms bind pause <Button-1> [list [namespace origin Pause]]
        .status.mms bind stop <Button-1> [list [namespace origin Stop]]
        .status.mms create text 2 2 -tags label -fill green -anchor nw -font MMS
        ::tkchat::StatusbarAddWidget .status .status.mms 1
    }
}

proc ::tkchat::mms::FillMenu {m} {
    variable streams
    $m delete 0 end
    foreach {name url} $streams {
        if {$name eq "-"} {
            $m add separator
        } else {
            $m add command -label $name -command [list [namespace origin Play] $url]
        }
    }
}

# Inject a menu item into the tkchat menu.
if {[winfo exists .mbar.file]} {
    set str "Audio streams"
    if {[catch {.mbar.file index $str}]} {
        if {![catch {set ndx [.mbar.file index "Exit"]}]} {
            .mbar.file insert [incr ndx -1] cascade -label $str \
                -menu [menu .mbar.file.stream -tearoff 0 \
                           -postcommand [list ::tkchat::mms::FillMenu .mbar.file.stream]]
        }
    }
}