# Module:         poImgUtil
# Copyright:      Paul Obermeier 2013-2024 / paul@poSoft.de
# First Version:  2013 / 03 / 01
#
# Distributed under BSD license.
#
# Module with utility procedures for the poImg package.

namespace eval poImgUtil {
    variable ns [namespace current]

    namespace ensemble create

    namespace export NewSwatch DeleteSwatch
    namespace export CopyImg
    namespace export SetTransparentColor ReplaceTransparency
    namespace export Histogram ScaleHistogram
    namespace export GetImgStats
    namespace export DrawReticle
    namespace export DifferenceImage
    namespace export DeleteImg ScaleImg ScalePhoto
    namespace export ReadImg ReadImgScaled
    namespace export GetRGB GetRGBA
    namespace export SetDrawColorChan SetDrawColorRGB SetDrawColorRGBA
    namespace export SetDrawMaskChan SetDrawMaskRGB SetDrawMaskRGBA
    namespace export SetDrawModeChan SetDrawModeRGB SetDrawModeRGBA
    namespace export SetCompressionChan SetCompressionRGB SetCompressionRGBA
    namespace export SetFormatChan SetFormatRGB SetFormatRGBA
    namespace export PushState PopState
    namespace export PrintBoolean PrintInteger PrintFloat
    namespace export PrintCompression PrintFormat PrintDrawmode PrintDrawmask PrintDrawcolor PrintChans
    namespace export PrintImgSize PrintImgFmt PrintImgDesc PrintColorCorrection

    proc _Max { a b } {
        if { $a > $b } {
            return $a
        } else {
            return $b
        }
    }

    proc NewSwatch {} {
        set swatch [poSwatch new]
        $swatch reset
        $swatch run
        return $swatch
    }

    proc DeleteSwatch { sw } {
        rename $sw {}
    }

    proc CopyImg { img } {
        $img GetImgInfo w h a g
        set newImg [poImage NewImage $w $h $a $g]
        $newImg CopyImage $img
        return $newImg
    }

    proc SetTransparentColor { img red green blue { threshold 0 } } {
        PushState
        $img GetImgInfo w h a g

        # Create an image and fill it with the transparent color.
        set colorImg [poImage NewImage $w $h $a $g]
        SetDrawColorRGB $red $green $blue
        $colorImg DrawRect 0 0 $w $h true

        # Calculate the difference image between original and color image.
        set diffImg [DifferenceImage $img $colorImg]

        # Clear color image and set non-zero pixels in the difference image
        # with white color in the color image.
        $colorImg Blank
        SetDrawColorRGB 1.0 1.0 1.0
        $colorImg MarkNonZeroPixels $diffImg $threshold numMarked

        # Difference image not needed anymore.
        DeleteImg $diffImg

        # Copy the red channel of the color image
        # to the original image as alpha (matte) channel.
        $img CopyChannel $colorImg $::RED $::MATTE 

        # Color image not needed anymore.
        DeleteImg $colorImg

        PopState
    }

    proc ReplaceTransparency { img red green blue { threshold 0 } } {
        PushState
        $img GetImgInfo w h a g

        # Create a 3-channel image and fill it with the replacement color.
        SetFormatRGBA $::UBYTE $::UBYTE $::UBYTE $::OFF
        set colorImg [poImage NewImage $w $h $a $g]
        SetDrawColorRGB $red $green $blue
        $colorImg DrawRect 0 0 $w $h true

        SetFormatRGBA $::UBYTE $::UBYTE $::UBYTE $::UBYTE
        set matteImg [poImage NewImage $w $h $a $g]
        $matteImg CopyChannel $img $::MATTE $::MATTE
        $matteImg ChangeGamma $::MATTE 1.0 -1.0 1.0

        $colorImg CompositeAlpha $colorImg $img 1 1 1  1 1 1  $::ON $matteImg

        # Matte image not needed anymore.
        DeleteImg $matteImg

        PopState
        return $colorImg
    }

    # Return the histogram of image "img" as a dictionary.
    # The dictionary has the following keys:
    # "red", "green" and "blue", each containing a list of 256 values
    # representing the number of pixels with that color value.
    # "width" and "height" containing the width andthe height of the
    # supplied image.
    # The key "description" can be specified as optional parameter.
    # If "description" is not specified or an empty string,
    # the identifier of "img" is used as the description.
    proc Histogram { img { description "" } } {
        set colorChanList [list $::RED $::GREEN $::BLUE]
        foreach color { red green blue } colorChan $colorChanList {
            $img Histogram $colorChan histoList
            dict set histoDict $color $histoList
        }
        $img GetImgInfo w h a g
        dict set histoDict "width"  $w
        dict set histoDict "height" $h
        if { $description eq "" } {
            dict set histoDict "description" $img
        } else {
            dict set histoDict "description" $description
        }
        return $histoDict
    }

    proc ScaleHistogram { histoDict height { histoType "log" } } {
        # Return a scaled histogram dictionary based on the given histogram
        # dictionary "histoDict. The values of the given histogram are scaled
        # either logarithmically or linearly, depending on the value of "histoType".
        # Possible "histoType" values are: log or lin.
        # The returned dictionary has 3 keys "red", "green" and "blue",
        # each containing a list of 256 values, so that the maximum value
        # is equal to "height".
        # Use this procedure to scale histogram values to fit into an image or
        # canvas of size 256xheight. 
        # See DrawHistogram.

        set useLogScale false
        if { $histoType eq "log" } {
            set useLogScale true
        }
        foreach color { red green blue } {
            set max 0
            for { set i 0 } { $i < 256 } { incr i } {
                set max [_Max [lindex [dict get $histoDict $color] $i] $max]
            }
            set scaledList [list]
            if { $useLogScale } {
                set denom [expr {$height / log10($max)}]
            } else {
                set denom [expr {$height / double($max)}]
            }
            for { set i 0 } { $i < 256 } { incr i } {
                set histoVal [lindex [dict get $histoDict $color] $i]
                set val 0
                if { $histoVal != 0 } {
                    if { $useLogScale } {
                        set val [expr {int(log10($histoVal) * $denom)}]
                    } else {
                        set val [expr {int($histoVal * $denom)}]
                    }
                    # The scale value might be clipped to zero, but the
                    # histogram value is greater than zero. Set the scaled
                    # value to at least 1, so that there is at least 1 pixel
                    # in a visual representation.
                    set val [_Max $val 1]
                }
                lappend scaledList $val
            }
            dict set scaledDict $color $scaledList
        }
        return $scaledDict
    }

    # TODO: Use rectangle x1, y1,  x2, y2
    proc GetImgStats { poImg { calcStdDev false } \
                       { x1 0 } { y1 0 } { x2 100000 } { y2 100000 } } {
        $poImg GetChanStats $::RED   mean(red)   std(red)   numPix $::OFF
        $poImg GetChanStats $::GREEN mean(green) std(green) numPix $::OFF
        $poImg GetChanStats $::BLUE  mean(blue)  std(blue)  numPix $::OFF
        $poImg GetChanRange $::RED   min(red)   max(red)
        $poImg GetChanRange $::GREEN min(green) max(green)
        $poImg GetChanRange $::BLUE  min(blue)  max(blue)
        foreach color [list red green blue] {
            dict set statDict "min"  $color $min($color)
            dict set statDict "max"  $color $max($color)
            dict set statDict "mean" $color $mean($color)
            dict set statDict "std"  $color $std($color)
        }
        dict set statDict "num" $numPix
        return $statDict
    }

    # Draw a reticle into image "img".
    # A reticle is made up of 2 horizontal and 2 vertical lines.
    # Additional circles can be drawn, too.
    proc DrawReticle { img holeSize numCircles circleRadius circleIncr } {
        $img GetImgInfo w h
        set xhalf [expr {$w / 2}]
        set yhalf [expr {$h / 2}]
        set hole2 [expr {$holeSize / 2}]

        $img DrawLine 0 $yhalf [expr {$xhalf - $hole2}] $yhalf
        $img DrawLine [expr {$xhalf + $hole2}] $yhalf $w $yhalf

        $img DrawLine $xhalf 0 $xhalf [expr {$yhalf - $hole2}]
        $img DrawLine $xhalf [expr {$yhalf + $hole2}] $xhalf $h

        for { set i 0 } { $i < $numCircles } { incr i } {
            $img DrawCircle $xhalf $yhalf \
                             [expr {$i * $circleIncr + $circleRadius}] false
        }
    }

    # Generate a difference image of the two images "img1" and "img2".
    # The difference image is returned and must be freed by the user.
    # The difference image is computed for the RED, GREEN, BLUE and MATTE channels.
    proc DifferenceImage { img1 img2 } {
        $img1 GetImgInfo w1 h1
        $img2 GetImgInfo w2 h2

        set w [_Max $w1 $w2]
        set h [_Max $h1 $h2]

        set diffImg [poImage NewImage $w $h]
        $diffImg DifferenceImage $img1 $img2
        return $diffImg
    }

    proc DeleteImg { img } {
        if { [info commands $img] eq $img } {
            rename $img {}
        } else {
            puts "Trying to delete non-existing image $img"
        }
    }

    proc ReadImg { imgName } {
        set found 1
        set retVal [catch {poImage NewImageFromFile $imgName} img]
        if { $retVal != 0 } {
            set retVal [catch {image create photo tmpPhoto -file $imgName} errCode]
            if { $retVal != 0 } {
                ::poLog::Warning "Can't read image $imgName ($errCode)"
                set found 0
            } else {
                set img [poImage NewImageFromPhoto tmpPhoto]
                image delete tmpPhoto
            }
        }
        if { $found == 1 } {
            return $img
        } else {
            return {}
        }
    }

    proc ScaleImg { srcImg newWidth newHeight } {
        PushState
        $srcImg GetImgFormat fmtList
        poImageMode SetFormat $fmtList
        set dstImg [poImage NewImage $newWidth $newHeight]

        $srcImg GetImgInfo sw sh a g
        $dstImg ScaleRect $srcImg 0 0 $sw $sh 0 0 $newWidth $newHeight true
        PopState
        return $dstImg
    }

    proc ScalePhoto { srcPhoto newWidth newHeight } {
        set srcImg [poImage NewImageFromPhoto $srcPhoto]
        set dstImg [ScaleImg $srcImg $newWidth $newHeight]
        set dstPhoto [image create photo -width $newWidth -height $newHeight]
        $dstImg AsPhoto $dstPhoto
        DeleteImg $srcImg
        DeleteImg $dstImg
        return $dstPhoto
    }

    proc ReadImgScaled { imgName newWidth newHeight } {
        set srcImg [ReadImg $imgName]
        set dstImg [ScaleImg $srcImg $newWidth $newHeight]
        DeleteImg $srcImg
        return $dstImg
    }

    proc GetRGB { } {
        global RED GREEN BLUE
        return [list $RED $GREEN $BLUE]
    }

    proc GetRGBA { } {
        global RED GREEN BLUE MATTE
        return [list $RED $GREEN $BLUE $MATTE]
    }

    proc SetDrawColorChan { chan val } {
        poImageMode GetDrawColor tmpcolor
        set newcolor [lreplace $tmpcolor $chan $chan $val]
        poImageMode SetDrawColor $newcolor
    }

    proc SetDrawColorRGB { r g b } {
        global RED BLUE
        poImageMode GetDrawColor tmpcolor
        set newcolor [lreplace $tmpcolor $RED $BLUE $r $g $b]
        poImageMode SetDrawColor $newcolor
    }

    proc SetDrawColorRGBA { r g b a } {
        global RED MATTE
        poImageMode GetDrawColor tmpcolor
        set newcolor [lreplace $tmpcolor $RED $MATTE $r $g $b $a]
        poImageMode SetDrawColor $newcolor
    }

    proc SetDrawMaskChan { chan val } {
        poImageMode GetDrawMask tmpmask
        set newmask [lreplace $tmpmask $chan $chan $val]
        poImageMode SetDrawMask $newmask
    }

    proc SetDrawMaskRGB { r g b } {
        global RED BLUE
        poImageMode GetDrawMask tmpmask
        set newmask [lreplace $tmpmask $RED $BLUE $r $g $b]
        poImageMode SetDrawMask $newmask
    }

    proc SetDrawMaskRGBA { r g b a } {
        global RED MATTE
        poImageMode GetDrawMask tmpmask
        set newmask [lreplace $tmpmask $RED $MATTE $r $g $b $a]
        poImageMode SetDrawMask $newmask
    }

    proc SetDrawModeChan { chan val } {
        poImageMode GetDrawMode tmpmode
        set newmode [lreplace $tmpmode $chan $chan $val]
        poImageMode SetDrawMode $newmode
    }

    proc SetDrawModeRGB { r g b } {
        global RED BLUE
        poImageMode GetDrawMode tmpmode
        set newmode [lreplace $tmpmode $RED $BLUE $r $g $b]
        poImageMode SetDrawMode $newmode
    }

    proc SetDrawModeRGBA { r g b a } {
        global RED MATTE
        poImageMode GetDrawMode tmpmode
        set newmode [lreplace $tmpmode $RED $MATTE $r $g $b $a]
        poImageMode SetDrawMode $newmode
    }

    proc SetCompressionChan { chan val } {
        poImageMode GetCompression tmpcompr
        set newcompr [lreplace $tmpcompr $chan $chan $val]
        poImageMode SetCompression $newcompr
    }

    proc SetCompressionRGB { r g b } {
        global RED BLUE
        poImageMode GetCompression tmpcompr
        set newcompr [lreplace $tmpcompr $RED $BLUE $r $g $b]
        poImageMode SetCompression $newcompr
    }

    proc SetCompressionRGBA { r g b a } {
        global RED MATTE
        poImageMode GetCompression tmpcompr
        set newcompr [lreplace $tmpcompr $RED $MATTE $r $g $b $a]
        poImageMode SetCompression $newcompr
    }

    proc SetFormatChan { chan val } {
        poImageMode GetFormat tmpfmt
        set newfmt [lreplace $tmpfmt $chan $chan $val]
        poImageMode SetFormat $newfmt
    }

    proc SetFormatRGB { r g b } {
        global RED BLUE
        poImageMode GetFormat tmpfmt
        set newfmt [lreplace $tmpfmt $RED $BLUE $r $g $b]
        poImageMode SetFormat $newfmt
    }

    proc SetFormatRGBA { r g b a } {
        global RED MATTE
        poImageMode GetFormat tmpfmt
        set newfmt [lreplace $tmpfmt $RED $MATTE $r $g $b $a]
        poImageMode SetFormat $newfmt
    }

    proc PushState {} {
        variable sStateStack

        poImageMode GetDrawColor   sStateStack(DrawColor)
        poImageMode GetDrawMask    sStateStack(DrawMask)
        poImageMode GetDrawMode    sStateStack(DrawMode)
        poImageMode GetCompression sStateStack(Compression)
        poImageMode GetFormat      sStateStack(Format)
    }

    proc PopState {} {
        variable sStateStack

        poImageMode SetDrawColor   $sStateStack(DrawColor)
        poImageMode SetDrawMask    $sStateStack(DrawMask)
        poImageMode SetDrawMode    $sStateStack(DrawMode)
        poImageMode SetCompression $sStateStack(Compression)
        poImageMode SetFormat      $sStateStack(Format)
    }

    proc PrintBoolean { bool } {
	global OFF ON
	switch $bool                \
	    $OFF { puts "OFF" }     \
	    $ON  { puts "ON" }      \
	    default { puts "Unknown boolean value format $bool" }
    }

    proc PrintInteger { num } {
	puts [format "%d" $num]
    }

    proc PrintFloat { num } {
	puts [format "%6.3f" $num]
    }

    proc PrintCompression { compr } {
        global OFF RLE
        switch $compr 		\
            $OFF  { puts "OFF" }	\
            $RLE  { puts "RLE" }	\
            default	{ puts "Unknown compression method $compr" }
    }

    proc PrintFormat { fmt } {
        global OFF UBYTE FLOAT
        switch $fmt 			\
            $OFF    { puts "OFF" }		\
            $UBYTE  { puts "UBYTE" }	\
            $FLOAT  { puts "FLOAT" }	\
            default	{ puts "Unknown pixel format $fmt" }
    }

    proc PrintDrawmode { mode } {
        global REPLACE ADD SUB XOR
        switch $mode 			\
            $REPLACE { puts "REPLACE" }	\
            $ADD     { puts "ADD" }		\
            $SUB     { puts "SUB" }		\
            $XOR     { puts "XOR" }		\
            default	{ puts "Unknown drawmode $mode" }
    }

    proc PrintDrawmask { bool } {
        PrintBoolean $bool
    }

    proc PrintDrawcolor { float } {
        PrintFloat $float
    }

    proc PrintChans { chnlist type } {
        global BRIGHTNESS RED GREEN BLUE MATTE
        global REDMATTE GREENMATTE BLUEMATTE
        global HNORMAL VNORMAL DEPTH TEMPERATURE RADIANCE
        global NUMCHAN

        puts -nonewline "BRIGHTNESS : " ; Print$type [lindex $chnlist $BRIGHTNESS]
        puts -nonewline "RED        : " ; Print$type [lindex $chnlist $RED]
        puts -nonewline "GREEN      : " ; Print$type [lindex $chnlist $GREEN]
        puts -nonewline "BLUE       : " ; Print$type [lindex $chnlist $BLUE]
        puts -nonewline "MATTE      : " ; Print$type [lindex $chnlist $MATTE]
        puts -nonewline "REDMATTE   : " ; Print$type [lindex $chnlist $REDMATTE]
        puts -nonewline "GREENMATTE : " ; Print$type [lindex $chnlist $GREENMATTE]
        puts -nonewline "BLUEMATTE  : " ; Print$type [lindex $chnlist $BLUEMATTE]
        puts -nonewline "HNORMAL    : " ; Print$type [lindex $chnlist $HNORMAL]
        puts -nonewline "VNORMAL    : " ; Print$type [lindex $chnlist $VNORMAL]
        puts -nonewline "DEPTH      : " ; Print$type [lindex $chnlist $DEPTH]
        puts -nonewline "TEMPERATURE: " ; Print$type [lindex $chnlist $TEMPERATURE]
        puts -nonewline "RADIANCE   : " ; Print$type [lindex $chnlist $RADIANCE]
        puts -nonewline "NUMCHAN    : " ; puts $NUMCHAN
    }

    proc PrintImgSize { w h a } {
        puts "Width : $w"
        puts "Height: $h"
        puts "Aspect: $a"
    }

    proc PrintImgFmt { chans } {
        PrintChans $chans Format
    }

    proc PrintImgDesc { w h a g } {
        PrintImgSize $w $h $a
        puts "Gamma    : $g"
    }

    proc PrintColorCorrection { g rx ry gx gy bx by wx wy } {
        puts "Gamma    : $g"
        puts "CIE Red  : $rx $ry"
        puts "CIE Green: $gx $gy"
        puts "CIE Blue : $bx $by"
        puts "CIE White: $wx $wy"
    }
}
