rmax -- 2007-09-25
This is my first Q&D take on a viewer for the MJPEG stream from the Tcl conference. Of course it can be used to view any MJPEG stream that comes via HTTP as Content-Type multipart/x-mixed-replace.
It doesn't do any more than receiving the stream and displaying the images. Ideas for improvement are:
Feel free to overwrite the code with improved versions, but please add a short log entry to this page that says what you changed.
package require Tk package require img::jpeg image create photo foo -width 800 -height 600 pack [label .l -image foo] proc READ {fd} { global state toread frame if {[eof $fd]} { puts "stream closed by peer" close $fd after 9000 start } switch -- $state { response { gets $fd line puts "RESPONSE: $line" if {$line ne "HTTP/1.0 200 OK"} exit set state header } header { gets $fd line puts "HEADER: $line" if {$line eq ""} { set state boundary } } boundary { gets $fd line if {$line eq "--myboundary"} { set state mime } } mime { gets $fd line puts "MIME: $line" regexp {Content-Length: ([[:digit:]]+)} $line -> toread if {$line eq ""} { fconfigure $fd -translation binary set state data } } data { set n [expr { $toread > 1000 ? 1000 : $toread }] set data [read $fd $n] incr toread -[string length $data] append frame $data if {$toread == 0} { foo configure -data $frame set frame "" set state boundary fconfigure $fd -translation crlf } } } } proc start {} { puts "opening stream" global state frame toread set toread 1000 set state response set frame "" set fd [socket eu.tclers.tk 80] # set fd [socket us.tclers.tk 80] fconfigure $fd -buffering full -translation crlf puts $fd "GET /video.mjpg HTTP/1.0" puts $fd "" flush $fd fileevent $fd readable [list READ $fd] } start
RZ changed order of statements because of runtime error (proc READ not found)
Zarutian: added simple eof handling
Zarutian: it now restarts on eof