# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package provide image 1.0
package require Tk
package require libibisa
package require map

namespace eval ::image {
    ::map::array:variable image:cache
    ::map::array:variable image:to:file
    variable empty:image [::libibisa::Image_RGBA -args 64 64]
}

proc ::image::compute:size {mkImg} {
    # Assuming 16 bits, RGBA channels.
    return [expr [$mkImg width] * [$mkImg height] * 2 * 4]
}

proc ::image::ratio {iwidth iheight width height} {
    set wratio [expr double($width - 0.5) / $iwidth]
    set hratio [expr double($height - 0.5) / $iheight]
    set ratio [expr min($wratio, $hratio)]
    return $ratio
}

proc ::image::can:load {file} {
    return [::libibisa::can_load $file]
}

proc ::image::properties {file} {
    set dict [dict create]
    foreach {name value} [::libibisa::properties $file] {
        dict set dict $name $value
    }
    return $dict
}

proc ::image::load {file {tkImg ""}} {
    if {[image:to:file:get $tkImg] == $file} {
        return $tkImg
    }

    set ibImg [cache:get $file]

    if {$tkImg == ""} {
        # Create a new image.
        variable counter
        incr counter
        set tkImg ::image::image$counter
        image create photo $tkImg

    } elseif {[lsearch [image names] $tkImg] == -1} {
        image create photo $tkImg
    }

    image:to:file:unset $tkImg
    set width [$ibImg cget -width]
    set height [$ibImg cget -height]
    $tkImg configure -width $width -height $height
    ::libibisa::imageToTk $ibImg $tkImg
    image:to:file:set $tkImg $file

    cache:release $file
    return $tkImg
}

proc ::image::signature {file} {
    return [::libibisa::signature_file $file]
}

# Returns an ibisa image corresponding to the given file.  Maintains a
# cache of the mapping with a simple reference counter.  Increments
# the reference counter for the returned image.
proc ::image::cache:get {file} {
    set info [image:cache:get $file]

    if {$info == ""} {
        set ibImg [::libibisa::load $file]
        if {$ibImg == "NULL"} {
            error "Couldn't load file: $file."
            variable empty:image
            return ${empty:image}
        }
        $ibImg -acquire
        set info [list 0 $ibImg]
    }

    lassign $info count ibImg
    lset info 0 [expr $count + 1]
    image:cache:set $file $info

    return $ibImg
}

# Decrements the reference counter for the ibisa image associated to
# the given file.
proc ::image::cache:release {file} {
    #puts "::image::cache:release $file"
    set info [image:cache:get $file]
    if {$info == ""} return
    lassign $info count ibImg
    #puts "::image::cache:release $info"

    if {$count <= 1} {
        image:cache:unset $file
        #puts [$ibImg cget -thisown]
        $ibImg -delete
    } else {
        lset info 0 [expr $count - 1]
        image:cache:set $file $info
    }
}

proc ::image::get:view:transform {src view {iquality 0}} {
    set ibImg [cache:get $src]
    set width [$ibImg cget -width]
    set height [$ibImg cget -height]
    cache:release $src

    lassign $view w h dx dy angle zoom opacity
    set ratio [::image::ratio $width $height $w $h]
    set zoom [expr $zoom * $ratio]

    set transform [::libibisa::TRS_RGBA -args $dx $dy $angle $zoom $opacity]
    $transform configure -dstWidth [expr int($w)]
    $transform configure -dstHeight [expr int($h)]
    $transform configure -iquality $iquality
    #$transform configure -irange_min 1
    #$transform configure -irange_max 0

    return $transform
}

proc ::image::view {src view {iquality 0}} {
    set ibImg [cache:get $src]
    set transform [get:view:transform $src $view $iquality]
    set ibImg_ [$transform process $ibImg]
    cache:release $src
    $ibImg_ -acquire
    return $ibImg_
}

proc ::image::put:view {src view tkImg {iquality 0}} {
    ::chrono::trigger

    set ibImg [view $src $view $iquality]
    #puts "put:view A [::chrono::trigger]"

    if {[lsearch [image names] $tkImg] == -1} {
        image create photo $tkImg
    }

    set width [$ibImg cget -width]
    set height [$ibImg cget -height]
    $tkImg configure -width $width -height $height
    image:to:file:unset $tkImg
    ::libibisa::imageToTk $ibImg $tkImg
    $ibImg -delete
    #puts "put:view B [::chrono::trigger]"

    return $tkImg
}

proc ::image::save:view {src dst view {iquality 1}} {
    #::chrono::trigger
    set ibImg [view $src $view $iquality]
    ::libibisa::save $ibImg $dst
    $ibImg -delete
    #puts "save:view $src $view [::chrono::trigger]"
}

proc ::image::get:src:center:offset {src view x y} {
    set ibImg [cache:get $src]
    set width [$ibImg cget -width]
    set height [$ibImg cget -height]

    set transform [get:view:transform $src $view]
    $transform setSource $ibImg

    set point [$transform getSrcPoint $x $y]
    set dx [expr [$point getX] - $width * 0.5]
    set dy [expr [$point getY] - $height * 0.5]

    cache:release $src
    return [list $dx $dy]
}

proc ::image::coords:X:to:Y {src view coords op} {
    set ibImg [cache:get $src]
    set transform [get:view:transform $src $view]
    $transform setSource $ibImg

    set coords_ {}
    foreach {x y} $coords {
        set point [$transform $op $x $y]
        lappend coords_ [$point getX] [$point getY]
    }

    cache:release $src
    return $coords_
}

proc ::image::coords:dst:to:src {src view coords} {
    coords:X:to:Y $src $view $coords getSrcPoint
}

proc ::image::coords:src:to:dst {src view coords} {
    coords:X:to:Y $src $view $coords getDstPoint
}

proc ::image::save:mask {src dst polygons angle} {
    set ibImg [cache:get $src]

    set mask [::libibisa::Mask_RGBA]
    foreach polygon $polygons {
        $mask addRegion
        foreach {x y} $polygon {
            $mask addPoint $x $y
        }
    }

    set ibImg_ [$mask process $ibImg]

    set rotation [::libibisa::TRS_RGBA -args 0 0 $angle 1]
    $ibImg_ processInPlace $rotation

    ::libibisa::save $ibImg_ $dst
    $ibImg_ -acquire
    $ibImg_ -delete

    cache:release $src
}

proc ::image::intercorrelation {file1 view1 file2 view2} {
    set img1 [view $file1 $view1]
    set img2 [view $file2 $view2]
    set icorr [::libibisa::intercorrelation $img1 $img2]
    $img1 -delete
    $img2 -delete
    return $icorr
}

