Version 1 of A Tk viewer for MJPEG streams

Updated 2007-09-25 17:48:24 by rmax

rmax 2007-09-25

This is my first Q&D take on a viewer for the MJPEG stream from the conference. 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

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]


 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]

 set state response
 set frame ""

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