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