Updated 2015-10-12 02:29:51 by RLE

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 with 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