video feed viewer with scaling

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