Posted to tcl by patthoyts at Tue Sep 25 07:58:18 GMT 2007view raw

  1. # Tkchat multimedia stream reader
  2. #
  3. # This is a simple Ogg or MP3 stream player derived from original code by
  4. # David Zolli (Kroc) and Reinhard Max (rmax) (http://wiki.tcl.tk/12619)
  5. # Hacked extensively by Pat Thoyts (patthoyts)
  6.  
  7. if {[catch {
  8. package require snack 2.2
  9. package require snackogg
  10. package require http
  11. }]} {
  12. return
  13. }
  14.  
  15. namespace eval ::tkchat::mms {
  16. variable streams
  17. if {![info exists streams]} {
  18. set streams {
  19. "Tcl conference (EU server)" "http://eu.tclers.tk/conference.ogg"
  20. "Tcl conference (US server)" "http://us.tclers.tk/conference.ogg"
  21. "-" {}
  22. "Trance" "http://scfire-ntc-aa04.stream.aol.com:80/stream/1003"
  23. "Top 40 Hits" "http://scfire-nyk-aa01.stream.aol.com:80/stream/1014"
  24. "Classical" "http://scfire-dll-aa02.stream.aol.com:80/stream/1006"
  25. }
  26. }
  27. }
  28.  
  29. proc ::tkchat::mms::Play {url} {
  30. if {[catch {http::geturl $url -handler [namespace origin Stream]} err]} {
  31. tkchat::addStatus 0 "Unable to open stream at \"$url\": $err" end ERROR
  32. }
  33. }
  34.  
  35. proc ::tkchat::mms::Stream {socket tok} {
  36. fileevent $socket readable {}
  37. Init
  38. Status Buffering
  39. ::snack::sound snd -channel $socket -buffersize 163840
  40. Wait 3000
  41. Status Playing
  42. after idle [list snd play -blocking 0]
  43. return 0
  44. }
  45.  
  46. proc ::tkchat::mms::Wait {total {done 0}} {
  47. ::tkchat::Progress {} $total $done
  48. while {$done < $total} {
  49. variable wait 0
  50. after 100 [list set [namespace which -variable wait] 1]
  51. tkwait variable [namespace which -variable wait]
  52. ::tkchat::Progress {} $total [incr done 100]
  53. }
  54. return
  55. }
  56.  
  57. proc ::tkchat::mms::Pause {} {
  58. snd pause
  59. if {[.status.mms itemcget pause -image] eq "::tkchat::mms::imgPause"} {
  60. .status.mms itemconfigure pause -image ::tkchat::mms::imgPlay
  61. } else {
  62. .status.mms itemconfigure pause -image ::tkchat::mms::imgPause
  63. }
  64. }
  65.  
  66. proc ::tkchat::mms::Stop {} {
  67. if {[catch {snd stop} err]} {
  68. Status $err
  69. ::snack::audio stop
  70. } else {
  71. Status Stopped
  72. }
  73. after 1000 {destroy .status.mms}
  74. }
  75.  
  76. proc ::tkchat::mms::Status {message} {
  77. if {[winfo exists .status.mms]} {
  78. .status.mms itemconfigure label -text $message
  79. } else {
  80. ::tkchat::addStatus 0 $message
  81. }
  82. }
  83.  
  84. proc ::tkchat::mms::Init {} {
  85. if {[lsearch -exact [font names] MMS] == -1} {
  86. font create MMS -family {Small Fonts} -size 6 -weight normal
  87. }
  88. image create bitmap ::tkchat::mms::imgPause -foreground green -data {
  89. #define pause_width 7
  90. #define pause_height 6
  91. static unsigned char pause_bits[] = {
  92. 0x77, 0x77, 0x77, 0x77, 0x77, 0x77};
  93. }
  94. image create bitmap ::tkchat::mms::imgPlay -foreground green -data {
  95. #define play_width 5
  96. #define play_height 7
  97. static unsigned char play_bits[] = {
  98. 0x03, 0x07, 0x0f, 0x1f, 0x0f, 0x07, 0x03};
  99. }
  100. if {[winfo exists .status] && ![winfo exists .status.mms]} {
  101. canvas .status.mms -width 96 -height 18 -background black
  102. .status.mms create image 80 4 -tags pause -anchor nw -image ::tkchat::mms::imgPause
  103. .status.mms create rectangle 88 3 95 10 -tags stop -fill green
  104. .status.mms bind pause <Button-1> [list [namespace origin Pause]]
  105. .status.mms bind stop <Button-1> [list [namespace origin Stop]]
  106. .status.mms create text 2 2 -tags label -fill green -anchor nw -font MMS
  107. ::tkchat::StatusbarAddWidget .status .status.mms 1
  108. }
  109. }
  110.  
  111. proc ::tkchat::mms::FillMenu {m} {
  112. variable streams
  113. $m delete 0 end
  114. foreach {name url} $streams {
  115. if {$name eq "-"} {
  116. $m add separator
  117. } else {
  118. $m add command -label $name -command [list [namespace origin Play] $url]
  119. }
  120. }
  121. }
  122.  
  123. # Inject a menu item into the tkchat menu.
  124. if {[winfo exists .mbar.file]} {
  125. set str "Audio streams"
  126. if {[catch {.mbar.file index $str}]} {
  127. if {![catch {set ndx [.mbar.file index "Exit"]}]} {
  128. .mbar.file insert [incr ndx -1] cascade -label $str \
  129. -menu [menu .mbar.file.stream -tearoff 0 \
  130. -postcommand [list ::tkchat::mms::FillMenu .mbar.file.stream]]
  131. }
  132. }
  133. }