#!/usr/bin/env tclkit8.6
#

# Utilities
#
 proc K { x y } { set x }
 proc map { args } {
    set body [lindex $args end]
    set reply {}
    foreach {*}[lrange $args 0 end-1] { lappend reply [eval $body] }

    set reply
 }
 proc cat { file } { K [read [set fp [open $file rb]]] [close $fp] }
 proc bytes { data } {
    binary scan $data c* X
    set X
 }


proc tcl::mathfunc::clip { v min max } {
    if { $v < $min } { return $min }
    if { $v > $max } { return $max }

    return $v
}

# Conversion
#
# http://web.archive.org/web/20030819175903/http://mav-magazine.com/Dec1998/code411/code411.htm
#
proc yuvtorgb { Y U V } {
    set R [expr int(clip($Y                    + 1.402 * ($V-128), 0, 255))]
    set G [expr int(clip($Y - 0.344 * ($U-128) - 0.714 * ($V-128), 0, 255))]
    set B [expr int(clip($Y + 1.772 * ($U-128)               , 0, 255))]

    list $R $G $B
}

proc 411toppm { file } {
    set 411 [map x [bytes [cat $file]] { expr $x&0xFF }]
    set rgb [join [map { 1 2 3 4 U V } $411 {
        list {*}[yuvtorgb $1 $U $V]     \
             {*}[yuvtorgb $2 $U $V]     \
             {*}[yuvtorgb $3 $U $V] \
             {*}[yuvtorgb $4 $U $V] }]]

    join [list P6 {64 48} 255 [binary format c* $rgb]] \n
}



# Test
#
set PPM [411toppm MVC-526X.411]

package require Tk

image create photo img -data $PPM

canvas .c -bg blue
.c create image 3 3 -anchor nw  -image img
grid .c