################################################################################
 #
 # Basic Snack stream player
 #
 # Copyright © 2004 - Kroc, rmax and AK
 #
 # Shared under NOL licence : https://wiki.tcl-lang.org/nol
 #
 # Version 1.1 - October 2004
 #
 ################################################################################
 
 package require snack 2.2
 package require snackogg
 package require http
 
 proc quit {} {
    ::snack::audio stop
    s stop
    exit
 }

 proc playstream { socket token } {
   package require Tk
   wm title    . "Basic Snack stream player"
   wm protocol . WM_DELETE_WINDOW {quit}

   fileevent $socket readable ""
   set ::status "Buffering..."
   grid [label .l1 -text "Playing [lindex $::argv 0]"] -sticky ew
   grid [label .l2 -textvariable ::status -justify left] -sticky w
   grid [button .b -text Quit -command quit] -sticky ew
   update
   list http::cleanup $token
   ::snack::sound s -channel $socket
   for {set i 0} {$i < 30} {incr i} {
       after 100
       append ::status .
       update
   }
   set ::status "stream type is [s info]"
   update
   s play -blocking 0
   return 0
 }
 
 proc savestream {outfile socket token} {
    fileevent $socket readable ""
    #http::cleanup $token

    set chan [open $outfile w]

    # Ogg is binary, 2 MB buffer, write to OS only if buffer is full.
    # This also writes on exit of application.

    fconfigure $chan -translation binary -buffering full -buffersize 2097152

    # I am using fileevent and explicit copying to ensure that I am
    # told about eof. fcopy will not do that.

    fileevent  $socket readable [list copy $socket $chan]
    fconfigure $socket -blocking 0
    return
 }
 
 proc copy {in out} {
    # Stop recording if the connection is lost.
    if {[eof $in]} exit

    # Read, ignore empty reads.
    set data [read $in]
    if {![string length $data]} return

    # Record to file
    puts -nonewline $out $data
    return
 }
 
 if { $argc == 2 } {
   set url [lindex $argv 0]
   set out [lindex $argv 1]

   http::geturl $url -handler [list savestream $out]

 } elseif { $argc != 1 } {
   puts stdout "\n$::argv0 a basic mp3 & ogg stream player\n\n\
             Usage: \n\t$::argv0 URL\n\
             Examples:\n\t$::argv0 http://ogg.smgradio.com:80/vc32.ogg\n\
                      \t$::argv0 http://slaptech.net:8000/cmrn.mp3"
   ::snack::audio stop
   exit
 } else {
   set url [lindex $argv 0]
   http::geturl $url -handler playstream
 }

 ################################################################################
 #
 # Basic Snack stream player (command line)
 #
 # Copyright © 2004 - Kroc & rmax
 #
 # Shared under NOL licence : https://wiki.tcl-lang.org/nol
 #
 # Version 1.1 - October 2004
 #
 ################################################################################
 
 package require snack 2.2
 package require snackogg
 package require http
 
 # this is to enter event loop
 update
 
 proc quit {} {
     ::snack::audio stop
     catch "s stop" snckerr
     exit
 }
 
 proc cdline {} {
     gets stdin data
     if {$data eq "Q" || $data eq "q"} {
         quit
     }
     return
 }
 
 fileevent stdin readable cdline
 
 proc playstream { socket token } {
     fileevent $socket readable ""
     puts -nonewline stdout "Buffering..."
     flush stdout
     list http::cleanup $token
     ::snack::sound s -channel $socket
     for {set i 0} {$i < 30} {incr i} {
         after 100
         puts -nonewline stdout .
         flush stdout
     }
     puts stdout "\nPlaying... (q + Return to stop player and exit)"
     flush stdout
     s play -blocking 0
     return 0
 }
 
 proc help {} {
     puts stdout "\n$::argv0 a command line mp3 & ogg stream player\n\n\
             Usage: \n\t$::argv0 URL\n\
             Examples:\n\t$::argv0 http://ogg.smgradio.com:80/vc32.ogg\n\
                      \t$::argv0 http://slaptech.net:8000/cmrn.mp3\n\n\
             Q (or q) + Return to stop player and exit.\n"
     quit
 }
 
 if { $argc != 1 } {
     help
 } elseif {[lindex $argv 0] eq "-h" || [lindex $argv 0] eq "--help"} {
     help
 } else {
     set url [lindex $argv 0]
     if {[file extension $url] ne ".mp3" && [file extension $url] ne ".ogg"} {
         puts stdout "Wrong URL target: it must be an .mp3 or .ogg stream file."
         exit
     }
     if {![catch "http::geturl $url -handler playstream" weberr]} {
         vwait forever
     } else  {
         puts stdout $weberr
         quit
     }
 }