Posted to tcl by patthoyts at Tue Sep 25 07:58:18 GMT 2007view raw
- # 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]]
- }
- }
- }