[DZ] - 10 Jan 2005: This is a simple shoutcast stream player. It supports stream titles, future versions should support saving stream to disk. The host address and port are currently hardcoded. You can find more radio stations on www.winamp.com - music - radio. There is a problem, however. When I stop playing and then start again the sound is not smooth. Has somebody any idea what is wrong? [jt] (2005-04-21): An improved version of this program is at [Another Shoutcast Player]. ###### player-cmd.tcl ###################################################### # # Shoutcast stream player # # Copyright 2005 - DZ # # Shared under NOL licence : http://wiki.tcl.tk/nol # # Version 0.1 - January 2005 # ############################################################################ # # This is a simple shoutcast stream player. It supports titles. Future # versions will support saving the stream to disk. # # # # connect # readHeader # / \ # readStream readStreamMetaInt # readTitleLength # readTitle # package require http package require Memchan package require snack set doDebug 0 proc debug {text} { if {$::doDebug == 1} { puts $text } } namespace eval shoutcast { namespace export * set header(icy-metaint) 0 set doDebug 0 set title "No data" set readSize 8192 set total 0 set s {} } proc shoutcast::init {} { package forget snack package require snack array unset header set header(icy-metaint) 0 set title "No data" set readSize 8192 set total 0 set s {} set sock {} set fd {} } proc shoutcast::openChannel {} { variable fd # save stream in file # set fd [open 1.mp3 w] # fconfigure $fd -translation binary set fd [fifo] fconfigure $fd -translation binary -encoding binary \ -buffering full -buffersize 200000 ;# -blocking true } proc shoutcast::closeChannel {} { variable fd catch {close $fd} } proc shoutcast::initSnack {} { variable s set s [snack::sound s] # if {$s == {}} { # set s [snack::sound s] # } } proc shoutcast::connect {url port} { global sock shoutcast::init shoutcast::openChannel shoutcast::initSnack set sock [socket $url $port] fconfigure $sock -blocking 0 -buffering full -buffersize 100000 \ -translation {binary auto} # fconfigure $fd -translation binary -encoding binary \ # -buffering full -buffersize 200000 ;# -blocking true append buff "GET / HTTP/1.0\n" append buff "Host: $url\n" append buff "Accept: */*\n" append buff "User-Agent: xmms/1.2.7\n" append buff "Icy-MetaData:1\n" #append buff "x-audiocast-udpport: $::udp_port\n" append buff "\n" puts $sock $buff flush $sock # after 2000 fileevent $sock readable { shoutcast::readHeader $sock } } proc shoutcast::disconnect {} { global sock catch {close $sock} shoutcast::closeChannel } proc shoutcast::play {} { variable s variable fd $s configure -channel $fd -buffersize 100000 -debug 0 $s play ;#-command shoutcast::disconnect } proc shoutcast::stop {} { variable s $s stop shoutcast::disconnect $s destroy } proc shoutcast::readHeader {sock} { variable header variable fd set count [gets $sock line] if {$count == -1} { return } set h [split $line ":"] if {[llength $h] == 2} { foreach {key value} $h { set header($key) $value } } if {$count == 1 && $line == "\r"} { if {$header(icy-metaint) != 0} { fileevent $sock readable { shoutcast::readStreamMetaInt $sock } } else { fileevent $sock readable { shoutcast::readStream $sock } } } } proc shoutcast::readStream {sock} { variable readSize variable total variable fd set data [read $sock 4096] puts -nonewline $fd $data } proc shoutcast::readStreamMetaInt {sock} { variable readSize variable total variable fd set data [read $sock $readSize] set count [string length $data] set total [incr total $count] puts -nonewline $fd $data if {$total != 8192} { set readSize [expr {$readSize - $count}] debug "-count: $count, total: $total, readSize: $readSize" } else { debug "+count: $count, total: $total, readSize: $readSize" set readSize 8192 set total 0 fileevent $sock readable { shoutcast::readTitleLength $sock } } } proc shoutcast::readTitleLength {sock} { set c 0 set titleSize [read $sock 1] scan $titleSize %c c debug "c: $c" set titleSize [expr {$c * 16}] fileevent $sock readable [list shoutcast::readTitle $sock $titleSize] } proc shoutcast::readTitle {sock size} { variable title #StreamTitle='';StreamUrl=''; if {$size != 0} { set t [read $sock $size] set t [string trim $t] set rx [regexp -- {StreamTitle='(.*)';StreamUrl='(.*)';} $t - _title url] if {$rx} { set title $_title } } fileevent $sock readable { shoutcast::readStreamMetaInt $sock } } This is the GUI: ###### player-gui.tcl ###################################################### # # Shoutcast stream player # # Copyright 2005 - DZ # # Shared under NOL licence : http://wiki.tcl.tk/nol # # Version 0.1 - January 2005 # ############################################################################ # source player-cmd.tcl #set host 127.0.0.1 #set port 5002 # 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 {} { label .title -textvariable shoutcast::title pack .title -fill both -expand 1 button .play -text Play -command player::cmdPlay button .stop -text Stop -command player::cmdStop button .record -text Rec button .quit -text Quit -command player::cmdQuit pack .play .stop .record .quit -side left } proc player::cmdQuit {} { variable status if {$status == "play"} { shoutcast::stop set status stop } exit } proc player::cmdPlay {} { variable status if {$status == "play"} { # shoutcast::stop # set status stop return } shoutcast::connect $::host $::port set status play after 3000 shoutcast::play } proc player::cmdStop {} { variable status if {$status == "play"} { shoutcast::stop set status stop } } if {0} { proc showInfo {} { puts [$shoutcast::s info] after 3000 showInfo } after 3000 showInfo } player::createGui