[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 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 [coroutine]s 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 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 {%W scan mark %x %y} bind $c {%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 <> [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 ====== [[ [Category Multimedia] ]]