Version 6 of A Tk viewer for MJPEG streams

Updated 2007-09-25 18:04:16 by rmax

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:

  • Allow switching between the two servers.
  • Reconnect (after a random backoff time) when the stream breaks down.
  • Save the images (either all or selected ones on a button click).
  • Keep a history of the last N images so that the user can go back.
  • Improve header handling (e.g. reading the boundary string from the header instead of assuming it's value)
  • Improve error handling.
  • Add proxy support.
  • Use the tcl http package instead of talking to the raw socket (not sure if that is possible with the multipart/x-mixed-replace content).

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
    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
            puts -nonewline stderr "."
            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
            }
        }
    }
 }

 set state response
 set frame ""

 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]

RZ changed order of statements because of runtime error (proc READ not found)


Category Multimedia