A Tk viewer for MJPEG streams

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 its 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
    if {[eof $fd]} {
      puts "stream closed by peer"
      close $fd
      set state ""
      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
 vwait forever

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

Zarutian: added simple eof handling

Zarutian: it now restarts on eof

EG: Here's my not so quick but still dirty version. It tries to implement the list of improvements suggested by rmax in his original version. It also uses coroutines for handling the incoming data in a non-blocking manner. Still missing proxy support.

package require Tcl 8.6 ;# coroutines
package require Tk
catch {package require Img}
package require img::jpeg
package require uri ;# tcllib

# helper procs to ease the creation of callbacks/gui
proc my {cmd args} {
    linsert $args 0 [uplevel 1 [list namespace which $cmd]]
}

proc myvar {varname} {
    uplevel 1 [list namespace which -variable $varname]
}

proc schedule {cmd args} {
    after idle [list after 0 [uplevel 1 [linsert $args 0 my $cmd]]]
}

proc errCondition {msg} {
    schedule tk_messageBox \
        -type ok -icon error \
        -title "Error" -message $msg
}

proc scroll {scroll from to} {
    if {$from == 0 && $to == 1.0} {
        if {[winfo ismapped $scroll]} {
            grid remove $scroll
        }
    } else {
        if {![winfo ismapped $scroll]} {
            grid $scroll
        }
    }
    $scroll set $from $to
}

# rmax's TODO
# * Allow switching between the two servers. DONE
# * Reconnect (after a random backoff time) when the stream breaks down.
#   DONE (well, almost, you can reconnect manually)
# * Save the images (either all or selected ones on a button click). DONE
# * Keep a history of the last N images so that the user can go back. DONE
# * Improve header handling (e.g. reading the boundary string from
#   the header instead of assuming its value). DONE
# * Improve error handling. DONE (kinda)
# * Add proxy support. STILL TODO
# * 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).
#  

namespace eval vfeed {
    variable img [image create photo]
    variable img_work [image create photo]
    variable chunk 4096

    # add some urls for the address bar.
    # non-tcl ones taken from http://www.opentopia.com/hiddencam.php
    variable urls {
        http://us.tclers.tk/video.mjpg
        http://eu.tclers.tk/video.mjpg

        http://sjryc.axiscam.net/axis-cgi/mjpg/video.cgi
        http://66.172.250.133/axis-cgi/mjpg/video.cgi
        http://62.177.139.136:8088/axis-cgi/mjpg/video.cgi?camera=1&resolution=384x288
    }
    variable url [lindex $urls 0]   ;# the value of address combobox
    variable zoom 1                 ;# image zoom
    variable button                 ;# connect/disconnect button
    variable canvas                 ;# image display canvas
    variable dim {0 0}              ;# image dimensions (cached)
    variable tv                     ;# the treeview offline selector
    variable save 0                 ;# to save or not to save ...
    variable home [file join [file normalize ~] videofeed]

    file mkdir $home
}

proc vfeed::getline {fd} {
    while {[chan gets $fd line] < 0} {
        if {[chan eof $fd]} {
            errCondition "Socket closed by peer"
            disconnect $fd
            return -code return
        }
        yield
    }

    return $line
}

proc vfeed::readbytes {fd bytes} {
    variable chunk

    set total {}
    while 1 {
        set n [expr { $bytes > $chunk ? $chunk : $bytes }]
        set data [chan read $fd $n]
        if {[chan eof $fd]} {
            errCondition "Socket closed by peer"
            disconnect $fd
            return -code return
        }
        incr bytes -[string length $data]
        append total $data
        if {$bytes > 0} {
            yield
        } else {
            break
        }
    }

    return $total
}

# handle the status response from the server
proc vfeed::response {fd} {
    yield [info coroutine]
    set resp [getline $fd]
    if {$resp ne "HTTP/1.0 200 OK"} {
        errCondition "Error:\nServer respond:\n$resp"
        disconnect $fd
        return
    }
    chan event $fd readable [coroutine listener headers $fd]
}

# handle headers
proc vfeed::headers {fd} {
    yield [info coroutine]
    set headers {}
    while {[set resp [getline $fd]] ne ""} {
        lassign [split $resp ":"] key value
        dict set headers $key [string trim $value]
    }
    regexp {boundary=([^[:space:]]+)} [dict get $headers "Content-Type"] -> boundary
    chan event $fd readable [coroutine listener handler $fd $boundary]
}

# handle the data stream
proc vfeed::handler {fd boundary} {
    yield [info coroutine]
    variable img
    variable img_work
    variable zoom

    # save the value of channel encoding
    set encoding [chan configure $fd -encoding]
    # clean the junk which may arrive before the boundary line
    while {[set resp [getline $fd]] ne $boundary
        && $resp ne "--$boundary"} {}

    while 1 {
        set headers {}
        while {[set resp [getline $fd]] ne ""} {
            lassign [split $resp ":"] key value
            dict set headers $key [string trim $value]
        }
        # check the content type
        if {[dict get $headers Content-Type] ne "image/jpeg"} {
            errCondition "Error:\nNot a jpeg stream"
            break
        }
        # check the content length
        if {![dict exists $headers Content-Length]} {
            errCondition "Error:\nContent length missing"
            break
        } else {
            set toread [dict get $headers Content-Length]
        }

        # now we are ready to receive the jpeg binary data.
        chan configure $fd -translation binary -encoding binary
        set frame [readbytes $fd $toread]

        # display the new image
        $img_work configure -data $frame
        $img copy $img_work -subsample $zoom -shrink
        newimage

        # ready to start a new cycle
        chan configure $fd -translation crlf -encoding $encoding
        getline $fd

        # let the event loop process idle events (display the image)
        chan event $fd readable {}
        schedule chan event $fd readable [info coroutine]
        yield

        # read the boundary line
        if {[set resp [getline $fd]] ne $boundary && $resp ne "--$boundary"} {
            errCondition "Error:\nexpected \"$boundary\", got \"$resp\""
            break
        }
    }
    disconnect $fd
}

# build the gui
proc vfeed::gui {} {
    variable img
    variable button

    wm state . withdrawn

    # a toolbar frame
    set tb [ttk::frame .toolbar]
    # the address combobox
    set addr [ttk::combobox $tb.address \
        -textvariable [myvar url]]
    $addr configure -postcommand [my onPost $addr]
    # the connect/disconnect button
    set button [ttk::button $tb.switch -text "Connect" \
        -command [linsert [my connect] 0 schedule] ]
    # the save button
    set sb [ttk::checkbutton $tb.save -text Save \
        -variable [myvar save] \
        -onvalue 1 -offvalue 0 \
        -command [my loadfiles]]
    # fill the toolbar
    grid $addr $button $sb -sticky ew -pady 3 -padx 3
    grid columnconfigure $tb $addr -weight 1

    set pw [ttk::panedwindow .pw -orient horizontal]
    set df [imgdisplay $pw $img]
    set ov [imgselector $pw]
    $pw add $df -weight 1
    $pw add $ov -weight 0

    pack $tb -fill x
    pack $pw -expand 1 -fill both

    bind all <Double-Escape> exit

    wm title . "Video feed"
    schedule wm state . normal
}

# creates a widget to display a photo image
proc vfeed::imgdisplay {parent img {width 640} {height 480}} {
    variable canvas

    # the display control
    set df [ttk::frame $parent.df]
    set c  [canvas $df.canvas \
        -bg white -borderwidth 0 \
        -width $width -height $height]
    set sx [ttk::scrollbar $df.sx \
        -orient horizontal -command [list $c xview]]
    set sy [ttk::scrollbar $df.sy \
        -orient vertical   -command [list $c yview]]
    $c configure \
        -xscrollcommand [my scroll $sx] \
        -yscrollcommand [my scroll $sy]
    grid $c $sy -sticky news
    grid $sx    -sticky ew
    grid remove $sx $sy
    grid columnconfigure $df $c -weight 1
    grid rowconfigure $df $c -weight 1
    grid remove $sx $sy

    $c create image {0 0} -image $img -anchor nw
    bind $c <ButtonPress-1>  {%W scan mark %x %y}
    bind $c <Button1-Motion> {%W scan dragto %x %y 2}

    # add a control menu
    set pm [menu $c.theme -tearoff 0]
    # the zoom control
    $pm add radiobutton -label "Zoom 100%" \
        -variable [myvar zoom] \
        -value 1
    $pm add radiobutton -label "Zoom 50%" \
        -variable [myvar zoom] \
        -value 2
    # a theme selector
    $pm add separator
    foreach theme [ttk::themes] {
        $pm add command \
            -label [string totitle $theme] \
            -command [list ttk::setTheme $theme]
    }

    bind $c <Button-3> [list tk_popup $pm %X %Y]
    bind all <Control-Key-1> [list set [myvar zoom] 1]
    bind all <Control-Key-2> [list set [myvar zoom] 2]

    set canvas $c
    trace add execution $img leave [my imagechanged]

    return $df
}

# the offline image selector
proc vfeed::imgselector {parent} {
    variable img
    variable tv

    set t [ttk::frame $parent.viewer]

    set collist  {file size}
    set colnames {Filename Size}
    set colsizes {170 60}

    set tv [ttk::treeview $t.tv \
        -columns $collist \
        -show headings \
        -height 15 \
        -yscrollcommand [my scroll $t.sy]\
        -xscrollcommand [my scroll $t.sx]]
    set sy [ttk::scrollbar $t.sy -orient vertical -command [list $tv yview]]
    set sx [ttk::scrollbar $t.sx -orient horizontal -command [list $tv xview]]

    foreach c $collist n $colnames s $colsizes {
        $tv heading $c -text $n
        $tv column $c -width $s -stretch 0
    }

    grid $tv $sy -sticky news
    grid $sx -sticky ew
    grid rowconfigure $t $tv -weight 1
    grid columnconfigure $t $tv -weight 1
    grid remove $sx $sy
    grid propagate $t 0

    bind $tv <<TreeviewSelect>> [my updateimg]
    bind $tv <Key-Delete> [my deletefile]
    event add <<SelectAll>> <Control-a> <Control-A>
    bind $tv <<SelectAll>> {%W selection set [%W children {}]}

    loadfiles
    return $t
}

# Saves the image. Called when a new image arrives
proc vfeed::newimage {} {
    variable home
    variable img
    variable save
    variable tv

    if {!$save} {
        return
    }

    set base [clock format [clock seconds] \
        -format %Y%m%d_%H%M%S \
        -timezone :GMT]
    set base [file join $home $base]
    while {[file exists [set fname "${base}_[incr i].jpg"]]} {}
    $img write $fname -format jpeg
    $tv insert {} end -values [list [file tail $fname] [file size $fname]]
}

# Select an image to display. Called from the offline selector
proc vfeed::updateimg {} {
    variable img
    variable tv
    variable home

    set item [$tv selection]
    if {[llength $item] != 1} {
        return
    }

    set fname [$tv set $item file]
    try {
        $img read [file join $home $fname] -shrink
    } trap {POSIX ENOENT} {} {
        errCondition "No such file"
        loadfiles
    } trap {NONE} {} {
        errCondition "Image format not recognized"
    }
}

# trace procedure to update the scroll region on the display canvas
proc vfeed::imagechanged {args} {
    variable canvas
    variable img
    variable dim

    lassign $dim w h
    set nw [image width $img]
    set nh [image height $img]
    if {($w != $nw) || ($h != $nh)} {
        $canvas configure -scrollregion [list 0 0 $nw $nh]
        set dim [list $nw $nh]
    }
}

# update the list of urls in the combobox
proc vfeed::onPost {combo} {
    variable urls
    $combo configure -values $urls
}

# connect to the stream and disables the offline mode
proc vfeed::connect {} {
    variable url
    variable urls
    variable button

    set udict [uri::split $url]
    dict with udict {
        if {$port eq ""} {
            set port 80
        }
        if {$query ne ""} {
            append path ? $query
        }
    }

    if {[catch {socket $host $port} fd]} {
        errCondition "Error opening socket\n$fd"
        return
    }

    chan configure $fd -buffering full -translation crlf -blocking 0
    chan puts $fd "GET /$path HTTP/1.0\n"
    chan flush $fd
    chan event $fd readable [coroutine listener response $fd]

    $button configure -text Disconnect -command [my disconnect $fd]
    togglestate

    if {$url ni $urls} {
        lappend urls $url
    }
}

# disconnect the stream and enter offline mode
proc vfeed::disconnect {fd} {
    variable button

    chan close $fd

    # clean leftovers from handlers
    rename [my listener] {}
    foreach afterid [after info] {
        set script [lindex [after info $afterid] 0]
        if {[string match {*chan event*} $script]} {
            after cancel $afterid
        }
    }

    # reconfigure the button
    $button configure -text Connect \
        -command [linsert [my connect] 0 schedule]
    togglestate
}

# load the list of files in the offline selector
proc vfeed::loadfiles {} {
    coroutine loader apply [list {} {
        variable tv
        variable home

        $tv delete [$tv children {}]
        set i 0
        foreach f [lsort [glob -nocomplain -directory $home *jpg]] {
            set ft [file tail $f]
            $tv insert {} end -values [list $ft [file size $f]]
            incr i
            if {($i % 10) == 0} {
                schedule [info coroutine]
                yield
            }
        }
    } [namespace current]]
}

# enable/disable the selection on the offline selector
proc vfeed::togglestate {} {
    variable tv

    if {[$tv cget -selectmode] eq "none"} {
        $tv configure -selectmode extended
        loadfiles
    } else {
        $tv selection remove [$tv selection]
        $tv configure -selectmode none
    }
}

# delete the currently selected file(s)
proc vfeed::deletefile {} {
    variable tv
    variable home

    if {([$tv cget -selectmode] eq "none")
        ||
        ([llength [set items [$tv selection]]] == 0)
    } then {
        return
    }

    foreach item $items {
        set fname [$tv set $item file]
        set fname [file join $home $fname]

        if {[file exists $fname]} {
            file delete $fname
        }
        $tv delete $item
    }
}

# start the app
vfeed::gui

Category JPEG

Category Multimedia