Version 0 of Another Shoutcast Player

http://tcl.jtang.org/shoutcast_player/player.png

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.

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 ([email protected])
 #//#

 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 "<stopped>"
 }

 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='<title>';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 ([email protected])
 #//#

 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 Multimedia