While experimenting with Tom Wilkason's [snackAmp] player I discovered that it did not support obtaining song information from the ShoutCast stream. I found [DZ]'s [basic snack stream player 2 - shoutcast] but it had some bugs (such as stopping/starting streams). I took DZ's code and fixed a bunch of things to produce yet another Shoutcast player. [http://tcl.jtang.org/shoutcast_player/player.png] This program requires both [snack] and [memchan], both of which are supplied in the ActiveTcl distribution. It has been tested under Tcl 8.4.9 for Linux/x86; it ought to work for other platforms. The default URL goes to http://www.club977.com, a free 80's pop music station. The program is far from perfect; I get weird "popping" sounds every now and then. I suspect this is caused when snack finishes decoding all of its audio data, but the main program is still busy parsing the song information. I am sure that I can optimize it further. Furthermore I would like to add a ''bookmarks'' feature so that I don't have to look up each station's URL. Convenient downloadable tarball here: http://tcl.jtang.org/shoutcast_player/shoutcast_player.tar.gz Alternatively copy the two code snippets below to '''player-cmd.tcl''' and '''player-gui.tcl'''. Run '''player-gui.tcl''' to bathe in music goodness. '''player-cmd.tcl''' below: ---- #//# # Shoutcast stream player. Based on Daniel Zlobec's basic snack # stream player (http://mini.net/tcl/13305) # # @author Jason Tang (tang@jtang.org) #//# package require Memchan package require snack namespace eval shoutcast { namespace export * set doDebug 0 set title "No data" set total 0 set s {} } proc shoutcast::connect {server port path} { variable sock shoutcast::init shoutcast::openChannel shoutcast::initSnack variable title "Connecting to $server..." update set sock [socket $server $port] fconfigure $sock -blocking 0 -buffering full -buffersize 100000 \ -translation {binary auto} append buff "GET $path HTTP/1.0\n" append buff "Host: $server\n" append buff "Icy-MetaData:1\n" append buff "Accept: */*\n" append buff "User-Agent: Tcl/8.4.9\n" append buff "\n" puts $sock $buff flush $sock set title "Connected to $server." fileevent $sock readable [list shoutcast::readHeader $sock] } proc shoutcast::init {} { package forget snack package require snack variable header array unset header set header(icy-metaint) 0 variable total 0 variable s {} variable sock {} variable fd {} } proc shoutcast::openChannel {} { variable fd set fd [fifo] fconfigure $fd -translation {binary binary} -encoding binary \ -buffering none -buffersize 100000 } proc shoutcast::closeChannel {} { variable fd catch {close $fd} } proc shoutcast::initSnack {} { variable s set s [snack::sound s] } proc shoutcast::disconnect {} { variable sock catch {close $sock} shoutcast::closeChannel } proc shoutcast::play {} { variable s variable fd $s configure -channel $fd -buffersize 100000 -debug 0 after 3000 [list $s play] } proc shoutcast::stop {} { variable s $s stop shoutcast::disconnect $s destroy variable title "" } proc shoutcast::readHeader {sock} { variable header variable fd set count [gets $sock line] if {$count == -1 && [eof $sock] == 1} { stop } set h [split $line ":"] if {[llength $h] == 2} { foreach {key value} $h { set header($key) [string trim $value] } } # reached end of meta tags; music data henceforth if {$count == 1 && $line == "\r"} { parray header if {[info exist header(icy-name)]} { variable title $header(icy-name) } if {[info exist header(icy-metaint)] && $header(icy-metaint) >= 0} { variable metaint $header(icy-metaint) variable readSize $metaint fileevent $sock readable [list shoutcast::readStreamMetaInt $sock] } else { fileevent $sock readable [list shoutcast::readStream $sock] } } } proc shoutcast::readStream {sock} { variable readSize variable total variable fd # stream has just music data, no music information fcopy $sock $fd -size 4096 } proc shoutcast::readStreamMetaInt {sock} { variable readSize variable total variable fd variable metaint set data [read $sock $readSize] incr total [string length $data] puts -nonewline $fd $data if {$total != $metaint} { set readSize [expr {$metaint - $total}] } else { set readSize $metaint set total 0 fileevent $sock readable [list shoutcast::readTitleLength $sock] } } proc shoutcast::readTitleLength {sock} { set c 0 set titleSize [read $sock 1] scan $titleSize %c c set titleSize [expr {$c * 16}] if {$c == 0} { fileevent $sock readable [list shoutcast::readStreamMetaInt $sock] } else { fileevent $sock readable [list shoutcast::readTitle $sock $titleSize] } } proc shoutcast::readTitle {sock size} { #Shoutcast song information looks like this: # StreamTitle='';StreamUrl='<url>'; set t "" while {$size > 0} { set data [read $sock $size] append t $data set size [expr {$size - [string length $data]}] } set t [string trim $t] if {[regexp -nocase -- {streamtitle='(.*?)';} $t foo _title] && $_title != ""} { variable title $_title } if {[regexp -nocase -- {streamurl='(.*?)';} $t foo url]} { # ignore the URL for now } fileevent $sock readable [list shoutcast::readStreamMetaInt $sock] } '''player-gui.tcl''' below: #//# # Shoutcast player interface. Based on Daniel Zlobec's basic snack # stream player (http://mini.net/tcl/13305). # # @author Jason Tang (tang@jtang.org) #//# package require Tk source player-cmd.tcl # change this whith other addresses of radio stations #set host 206.98.167.99 #set port 8712 namespace eval player { namespace export * set status stop } proc player::createGui {} { variable url "http://64.236.34.67:80/stream/1040" label .title -textvariable shoutcast::title -width 50 pack .title -fill both -expand 1 button .play -text Play -command player::cmdPlay button .stop -text Stop -command player::cmdStop button .quit -text Quit -command player::cmdQuit pack .quit .stop .play -side right label .l -text "URL: " entry .entry -textvariable player::url -width 32 pack .l .entry -side left } proc player::cmdQuit {} { variable status if {$status == "play"} { shoutcast::stop set status stop } exit } proc player::cmdPlay {} { variable status variable url if {$status == "play"} { return } if {[regexp {(\Ahttp:\/\/)?([^:/]+)(:(\d+))?(.*)} $url foo foo2 server foo3 port path]} { if {$port == ""} { set port 80 } if {$path == ""} { set path "/" } puts "server = $server; port = $port; path = $path" shoutcast::connect $server $port $path set status play shoutcast::play } else { set shoutcast::title "<could not parse url>" } } proc player::cmdStop {} { variable status if {$status == "play"} { shoutcast::stop set status stop } } player::createGui ---- Go back to [Jason Tang] ---- [Category Application] | [Category Multimedia] | [Category Internet] | [Category Music] | [Category File]