#############################################################################
# CDMS: Interface to CDMS-simulator
#   (c) 1997/2000: Rolf Schrödter, DLR, Institut für Planetenerkundung
#############################################################################
# $Id: BrowseUnpack.tcl,v 1.2 2006-11-17 16:34:45+01 rolf Exp rolf $
#############################################################################
# BrowseUnpack.tcl : Unpack ROLIS raw images (frame types = 51xx/52xx)
#
#   QUICK HACK:
#       - WORKS ONLY FOR 16-BIT DATA (MASK=FFFF)
#       - ONLY ONE SUBIMAGE, NO REGION-OF-INTEREST
#
#############################################################################

package require Decoder

namespace eval up {
    variable UP
    variable Prev
    variable Frame
}

proc up::errorMsg { msg {code 0} } {
    puts "Unpack - $msg"
    if { $code } {
        exit $code
    }
}
proc up::frameMsg { msg } {
    variable UP
    up::errorMsg "frame#$UP(FrameNo) / $msg"
}

proc up::init {} {
    variable UP

    variable Prev
    variable Frame

    set UP(FrameNo)     0       ;# Total frame counter
    set UP(PFrameNo)    0       ;# Number of Packed frames

    set UP(Img.Data)    {}      ;# The unpacked image data
    set UP(Img.SizeY)   0       ;# Number of really transmitted pixels (Y)
    set UP(Img.SizeX)   0       ;# Number of really transmitted pixels (X)
    set UP(Img.Size)    0       ;# Image size in bytes

    set UP(ImgCount)    0       ;# Total image counter
    set UP(ImgFrames)   0       ;# Total frames in image

    set UP(ImgNo)       -1      ;# Rolis image buffer number
    set UP(ImgOBT)      ?       ;# CDMS string onboard time of first frame of this image
    set UP(ImgOBT.Num)  0       ;# CDMS numeric onboard time of first frame of this image

    set Frame(OBT)      ?       ;# CDMS header: Onboard time string
    set Frame(OBT.Num)  0       ;# CDMS header: Numeric onboard time (seconds)

    set Frame(Type)     0       ;# Frame type, should be = 0x58
    set Frame(TFirst)   0       ;# Frame subtype, flag for first frame
    set Frame(TLast)    0       ;# Frame subtype, flag for last fram
    set Frame(TCount)   -1      ;# Type dependent frame counter of frame
                                ;# First data frame only (type=5101/5103/5201/5203)
    set Frame(ImgNo)    -1      ;# Image field
    set Frame(Mask)     0       ;# Mask = FFFF - we can't interpret other frames yet
    set Frame(Y)        0       ;# Upper left corner of subimage
    set Frame(X)        0       ;# Upper left corner of subimage
    set Frame(NY)       0       ;# Size of original subimage
    set Frame(NX)       0       ;# Size of original subimage
    set Frame(Incr)     0       ;# Incr (resolution) of subimage

    set Frame(Data)     0       ;# Frame data

    up::reset
}

proc up::reset {} {
    variable Prev
    variable Frame

    array set Prev [array get Frame]    ;# Prev frame data = Frame
    set Prev(ImgNo) -1
}


#########################################################
# Extract frame parameters Frame(*)
#   TCount  - Global frame counter for all compressed frames, type=51xx/52xx
#
proc up::frameParams { data } {
    variable UP
    variable Frame

    binary scan $data s1s1 x1 x2
    set Frame(Type)     [expr {($x1 >> 8) & 0x00FF}]        ;# Should be = 0x51/52

    if { $Frame(Type) == 0x53 } {       ;# ISB frame found

        # Remember this ISB & search next ISB
        # isb::found needs swapped data, unpack still didn't swap
        #
        set data [browse::rolis::swap $data]
        browse::isb::found $data yes

        if { $UP(ImgFrames) > 0 } {    ;# Flush Image on ISB frame
            puts "ISB found, start new image"
            up::newImage
            return 0
        }
    }
    if { ($Frame(Type) != 0x51) && ($Frame(Type) != 0x52) } {
        return 0
    }
    set subtype         [expr {$x1 & 0x00FF}]               ;# =00/01/02/03
    set Frame(TFirst)   [expr {$subtype & 0x01}]            ;# if this is the first frame
    set Frame(TLast)    [expr {$subtype & 0x02}]            ;# if this is the last frame
    set Frame(TCount)   [expr {($x2+0x10000) & 0xFFFF}]     ;# 0..65535

    if { $Frame(TFirst) } {
        binary scan $data @4s7 params
        foreach {img mask y x ny nx incr} $params {}

        browse::unsigned    mask

        set Frame(ImgNo)    $img
        set Frame(Mask)     $mask
        set Frame(Y)        $y
        set Frame(X)        $x
        set Frame(Y)        $y
        set Frame(NY)       $ny
        set Frame(NX)       $nx
        set Frame(Incr)     $incr

        if { $mask != 0xFFFF } {
#            up::frameMsg "Invalid mask, currently only mask=FFFF can be unpacked"
        }

        set UP(Img.SizeX)   [expr {$nx/$incr}]
        set UP(Img.SizeY)   [expr {$ny/$incr}]
        set UP(Img.Size)    [expr {$UP(Img.SizeX)*$UP(Img.SizeY)*2}]

        binary scan $data @18a* Frame(Data) ;# 238 data bytes
    } else {
        binary scan $data @4a* Frame(Data)  ;# 252 data bytes
    }
    #
    # If the mask is not FFFF then data needs to be
    # unpacked bit-by-bit
    #
    if { $Frame(Mask) != 0xFFFF } {
        set Frame(Data) [::decoder::unpack $Frame(Mask) $Frame(Data)]
    }

    return 1
}

#########################################################
# Check whether prev frame matches this one
# Output of various messages.
# Returns:
#   TRUE    - Frame continues prev. frame
#   FALSE   - Error, missing frame ?
#
proc up::checkPrev {} {
    variable UP
    variable Prev
    variable Frame

    set continued 1     ;# flag, whether frame continues block in prev. frame

    set countDiff  [expr {($Frame(TCount) - $Prev(TCount)) & 0xFFFF}]
    if { $countDiff != 1 } {
        up::frameMsg "Missing frame TCount=$Prev(TCount) -> $Frame(TCount)"
        if { $countDiff < 10 } {
            set numBytes [expr {252*($countDiff-1)}]
            append UP(Img.Data) [binary format x$numBytes]
            set continued 1
        } else {
            set continued 0
        }
    }
    if { $Frame(TFirst) } {
        set continued 0
    }
    return $continued
}

###############################################
# Process next data frame
# Returns:
#   TRUE    - end of subimage block
#   FALSE   - continuing
#
proc up::nextFrame { data } {
    variable UP
    variable Prev
    variable Frame

    if { ! [up::frameParams $data] } {  ;# ignore other than Raw image frames
        return 0
    }
    #
    # Start of a new image, if
    # (A) The image number changes
    # (B) If we have no current image, e.g. after ISB found
    #
    if { ($Frame(ImgNo) != $Prev(ImgNo)) || ($UP(ImgNo) < 0) } {  ;
        up::newImage
    }

    if { ! $UP(ImgFrames) } {           ;# still waiting for first frame
        set continued 1
        if { $Frame(TFirst) } {
            set UP(Img.Data) $Frame(Data)   ;# init data
        }
    } else {                    ;# Should be a continued frame
        set continued [up::checkPrev]
        if { $continued } {     ;# normal case, no missing frames
            append UP(Img.Data) $Frame(Data)
        }
    }
    array set Prev [array get Frame]    ;# copy Prev=Frame
    incr UP(PFrameNo)
    incr UP(ImgFrames)

    if { $Frame(TLast) || ! $continued } {
        return 1
    } else {
        return 0
    }
}

#######################################################
proc up::write_file { filename format {isb {}} } {
    variable UP

    if { [string length $UP(Img.Data)] == 0 } {
        return
    }
    if { $UP(Img.Size) } {      ;# truncate img data to real size
        set last [expr {$UP(Img.Size) - 1}]
        set UP(Img.Data) [string range $UP(Img.Data) 0 $last]
    }
    set data $UP(Img.Data)
    switch -- [string tolower $format] {
        raw {   ;# Raw data, w/o header
            set ext raw
            puts "$filename.$ext   $UP(Img.SizeX) x $UP(Img.SizeY)"
            uc::write_bin $filename.$ext $data
        }
        astro {
            set ext afl
            puts "$filename.$ext   $UP(Img.SizeX) x $UP(Img.SizeY)"
            set hdr [::uc::astro_header format $UP(Img.SizeX) $UP(Img.SizeY)]
            uc::write_bin $filename.$ext $hdr$data
        }
        pgm {
            set ext pgm
            puts "$filename.$ext   $UP(Img.SizeX) x $UP(Img.SizeY)\nISB=$isb"
            set hdr [uc::pgm_header format $UP(Img.SizeX) $UP(Img.SizeY) 16383 $filename.$ext -1 $isb]
            set ascii [uc::pgm_data format $data]
            uc::write_bin $filename.$ext $hdr$ascii
        }
        fits {
            set ext fits
            puts "$filename.$ext   $UP(Img.SizeX) x $UP(Img.SizeY)\nISB=$isb"
            set hdr [uc::fits_header format $UP(Img.SizeX) $UP(Img.SizeY) -1 $isb]
            if {[string compare $::tcl_platform(byteOrder) "littleEndian"] == 0} {
                set data [uc::swap $data]
            }
            uc::write_bin $filename.$ext $hdr$data
        }
        default { up::errorMsg "Invalid -format specified: format" 1 }

    }
}

#############################################################################
# Write image to file
#
proc up::saveImage {} {
    variable ARG
    variable UP

    if { ! $UP(ImgFrames) } {
        return
    }
    #
    # Find the best matching ISB and save it globally
    # This variable is read by the pgm/fits header functions
    #
    if {($UP(ImgNo) >= 0) && ($UP(ImgNo) <= 7) } {
        set isb [browse::isb::getBestISB $UP(ImgNo) $UP(ImgOBT.Num)]
    } else {
        set isb {}
    }

    if { [string length $ARG(Out)] != 0 } {
        set fname $ARG(Out)_$UP(ImgCount)
        puts [string repeat "-" 80]
        foreach fmt [split $ARG(Format) ","] {
            up::write_file $fname $fmt $isb
            puts [string repeat "-" 80]
        }
    } else {
        up::errorMsg "No output file specified, dumping data"
        puts [::uc::dump $UP(Img.Data) 64]
    }
    incr UP(ImgCount)
    set UP(ImgFrames) 0
    up::reset
}

#############################################################################
# Start new image
#
proc up::newImage {} {
    variable UP
    variable Frame

    up::saveImage
#    puts "# Found raw image=$Frame(ImgNo)"
    puts "# Found raw image=$Frame(ImgNo) OBT=$Frame(OBT) ($Frame(OBT.Num))"

    set UP(ImgNo)      $Frame(ImgNo)
    set UP(ImgOBT)     $Frame(OBT)
    set UP(ImgOBT.Num) $Frame(OBT.Num)
}

#############################################################################
# Unpack procedure
#############################################################################

proc up::unpack { args } {
    variable ARG
    variable UP
    variable Frame

    if { [llength $args] == 0 } {
        ::browse::errorMsg "Unpack: Valid options are:
    -file filename  - filename to extract
    -from num       - extract from record number (def=0)
    -to num         - extract to record number (def=end)
    -out filename   - name of output file (def=stdout)
    -format format  - output file format = raw|astro|pgm|fits (def=raw)"
        return
    }

    # default parameters
    set ARG(From)       0
    set ARG(To)         [expr {0x7FFFFFFF}]
    set ARG(File)       {}
    set ARG(Out)        {}
    set ARG(Format)     raw

    # parse command parameters
    foreach {opt val} $args {
        set opt [string tolower $opt]
        switch -glob -- $opt {
            -from       { set ARG(From)     $val }
            -to         { set ARG(To)       $val }
            -file       { set ARG(File)     $val }
            -out        { set ARG(Out)      $val }
            -format     { set ARG(Format)   $val }
            default     { errorMsg "Extract: invalid option $opt" }
        }
    }
    if { [string length $ARG(File)] } {
        set fin [browse::open_infile $ARG(File)]
    } else {
        up::errorMsg "no data file specified (-file filename)" 1
    }

    # Detect CDMS frame size & notify ISB module
    #
    set FrameSize [browse::detect_frame_size $fin]
    browse::isb::init $fin $FrameSize

    up::init

    seek $fin [expr {$ARG(From)*$FrameSize}]
    set UP(FrameNo) $ARG(From)

    while { 1 } {
        set frame [read $fin $FrameSize]
        if { [string length $frame] != $FrameSize } {
            break
        }
        if { [catch {browse::cdms_frame $frame X} err ] } {
            puts stderr [format "*** %s ***" $err]
        }
        set Frame(OBT)     $X(Hdr.OBT)
        set Frame(OBT.Num) $X(Hdr.OBT.Num)

        set end [up::nextFrame $X(Data)]
        if { $end } {
            up::saveImage
        }
        incr UP(FrameNo)
        if { $UP(FrameNo) > $ARG(To) } {
            break
        }
    }
    up::saveImage

    if { $UP(PFrameNo) == 0 } { ;# no data
        up::errorMsg "No raw image data in file $ARG(File)" 1
    }
    close $fin
}
