Posted to tcl by egavilan at Wed Oct 22 17:37:02 GMT 2008view raw
- package require Tk
- catch {package require Img}
- package require img::jpeg
- image create photo foo -width 800 -height 600
- image create photo bar -width 400 -height 300
- radiobutton .x1 -text 1X -command SetNormal \
- -variable VideoSize -value N
- radiobutton .x2 -text 1/2X -command SetSmall \
- -variable VideoSize -value S
- grid .x1 .x2 -sticky news
- grid [label .l1 -image foo] - -sticky news
- grid [label .l2 -image bar] - -sticky news
- grid remove .l1
- set VideoSize S
- proc SetSmall {} {
- grid remove .l1
- grid .l2
- }
- proc SetNormal {} {
- grid remove .l2
- grid .l1
- }
- 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"} {
- close $fd
- after 10000 start
- return
- }
- 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
- bar copy foo -subsample 2 2
- 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 us.tclers.tk 81]
- # 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]
- }
- bind .l1 <Destroy> exit
- start
- vwait forever