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