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 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] ;# 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 } # chan puts "Gets: *${line}*" 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 } } # chan puts "Read: [string length $total] bytes" 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] while 1 { # read the boundary line if {[set resp [getline $fd]] ne $boundary} { errCondition "Error:\nexpected \"$bounday\", got \"$resp\"" break } # the Content-Type line set expected "Content-Type: image/jpeg" if {[set resp [getline $fd]] ne $expected} { errCondition "Error:\nexpected \"$expected\", got \"$resp\"" break } # read Content-Length and record its value set expected "Content-Length: NNN" set resp [getline $fd] if {[scan $resp {Content-Length: %d} toread] != 1} { errCondition "Error:\nexpected \"$expected\", got \"$resp\"" break } # a blank line getline $fd # 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 } disconnect $fd } # build the gui proc vfeed::gui {} { variable img variable button wm state . withdrawn set p [ttk::panedwindow .pw -orient horizontal] set l [ttk::frame $p.lf] # a toolbar frame set tb [ttk::frame $l.toolbar] # the zoom control set zf [ttk::frame $tb.zf] ttk::radiobutton $zf.z1 -text "100%" \ -variable [myvar zoom] \ -value 1 ttk::radiobutton $zf.z2 -text "50%" \ -variable [myvar zoom] \ -value 2 pack $zf.z1 $zf.z2 -side left # 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 $zf $addr $button $sb -sticky ew -pady 3 -padx 3 grid columnconfigure $tb $addr -weight 1 set df [imgdisplay $l $img] pack $tb -fill x pack $df -fill both -expand 1 $p add $l set ov [imgselector $p] $p add $ov pack $p -expand 1 -fill both bind all <Double-Escape> exit wm title . "Video feed" schedule wm state . normal if {[tk windowingsystem] eq "x11"} { ttk::setTheme clam } } # 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} 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 {200 80} set tv [ttk::treeview $t.tv \ -selectmode browse \ -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] loadfiles return $t } # Saves the image. Called when a new image arrives proc vfeed::newimage {} { variable home variable img variable save 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 } # Select an image to display. Called from the offline selector proc vfeed::updateimg {} { variable img variable tv variable home set fname [lindex [$tv item [$tv select] -values] 0] 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" return } chan configure $fd \ -buffering full \ -translation auto \ -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 {} { variable tv variable home $tv delete [$tv children {}] foreach f [lsort [glob -nocomplain -directory $home *jpg]] { set ft [file tail $f] $tv insert {} end -values [list $ft [file size $f]] } } # 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 configure -selectmode none } } ######################################################################## # start the app vfeed::gui