namespace eval poFtiTest {

    variable ns [namespace current]

    # Procs used for constraints.
    namespace export haveTk86 haveTk90
    namespace export havePkgImg

    # Utility procs.
    namespace export photoSize photosIdent
    namespace export fileRead filesIdent
    namespace export intListsIdent floatListsIdent

    # Debug procs.
    namespace export photoView

    variable sTopCount 1

    proc _versionCompare { version1 version2 } {
        # A wrapper around package vcompare to handle alpha or beta versions
        # containing "a" or "b", ex. 8.7a4.
        set version(1) $version1
        set version(2) $version2
        set versionList(1) [split $version1 "."]
        set versionList(2) [split $version2 "."]
        foreach num { 1 2 } {
            if { [llength $versionList($num)] == 2 } {
                set major [lindex $versionList($num) 0]
                set minor [lindex $versionList($num) 1]
                if { ! [string is integer -strict $minor] } {
                    lassign [split $minor "ab"] minor patch
                    set version($num) [format "%d.%d.%d" $major $minor $patch]
                }
            }
        }
        return [package vcompare $version(1) $version(2)]
    }

    proc haveTk86 {} {
        return [expr [_versionCompare "8.6" $::tk_patchLevel] <= 0]
    }

    proc haveTk90 {} {
        return [expr [_versionCompare "9.0" $::tk_patchLevel] <= 0]
    }

    proc havePkgImg {} {
        set retVal [catch {package require Img}]
        return [expr ! $retVal]
    }

    proc photoSize { phImg } {
        return [list [image width  $phImg] [image height $phImg]]
    }

    proc photosIdentTk86 { phImg1 phImg2 } {
        set w1 [image width  $phImg1]
        set h1 [image height $phImg1]
        set w2 [image width  $phImg2]
        set h2 [image height $phImg2]
        if { $w1 != $w2 && $h1 != $h2 } {
            return false
        }
        for { set y 0 } { $y < $h1 } { incr y } {
            for { set x 0 } { $x < $w1 } { incr x } {
                set left  [$phImg1 get $x $y]
                set right [$phImg2 get $x $y]

                set dr [expr { [lindex $right 0] - [lindex $left 0] }]
                if { $dr != 0 } { return false }

                set dg [expr { [lindex $right 1] - [lindex $left 1] }]
                if { $dg != 0 } { return false }

                set db [expr { [lindex $right 2] - [lindex $left 2] }]
                if { $db != 0 } { return false }
            }
        }
        return true
    }

    proc photosIdentTk90 { phImg1 phImg2 } {
        set w1 [image width  $phImg1]
        set h1 [image height $phImg1]
        set w2 [image width  $phImg2]
        set h2 [image height $phImg2]
        if { $w1 != $w2 && $h1 != $h2 } {
            return false
        }
        for { set y 0 } { $y < $h1 } { incr y } {
            for { set x 0 } { $x < $w1 } { incr x } {
                set left  [$phImg1 get $x $y -withalpha]
                set right [$phImg2 get $x $y -withalpha]

                set dr [expr { [lindex $right 0] - [lindex $left 0] }]
                if { $dr != 0 } { return false }

                set dg [expr { [lindex $right 1] - [lindex $left 1] }]
                if { $dg != 0 } { return false }

                set db [expr { [lindex $right 2] - [lindex $left 2] }]
                if { $db != 0 } { return false }

                set da [expr { [lindex $right 3] - [lindex $left 3] }]
                if { $da != 0 } { return false }
            }
        }
        return true
    }

    proc photosIdent { phImg1 phImg2 } {
        if { [haveTk90] } {
            return [photosIdentTk90 $phImg1 $phImg2]
        } else {
            return [photosIdentTk86 $phImg1 $phImg2]
        }
    }

    proc fileRead { fileName } {
        set fp [open $fileName r]
        fconfigure $fp -translation binary
        set imgData [read -nonewline $fp]
        close $fp
        return $imgData
    }

    proc filesIdent { fileName1 fileName2 } {
        if { [file size $fileName1] != [file size $fileName2] } {
            return false
        }
        set data1 [fileRead $fileName1]
        set data2 [fileRead $fileName2]
        if { [string equal $data1 $data2] } {
            return true
        }
        return false
    }

    proc intListsIdent { expected value { msg "intListsIdent" } } {
        # Check, if two lists with integer values are identical.
        #
        # expected   - Expected list.
        # value      - Test list.
        # msg        - Message for test case.
        #
        # Returns true, if both lists are identical.
        # If the check fails, return false and print message prepended with `"Error:"`.

        if { [llength $expected] != [llength $value] } {
            puts "Error: $msg (List length differ. Expected: [llength $expected] Have: [llength $value])"
            return false
        }
        set index 0
        foreach exp $expected val $value {
            if { $exp != $val } {
                puts "Error: $msg (Values differ at index $index. Expected: $exp Have: $val)"
                return false
            }
            incr index
        }
        return true
    }

    proc _abs { a } {
        if { $a >= 0.0 } {
            return $a
        } else {
            return [expr {-1.0 * $a}]
        }
    }

    proc floatListsIdent { expected value { msg "floatListsIdent" } { delta 1.0E-6 } } {
        # Check, if two lists with floating point values are identical.
        #
        # expected   - Expected list.
        # value      - Test list.
        # msg        - Message for test case.
        # delta      - Precision for floating point comparison.
        #
        # Returns true, if both lists are identical.
        # If the check fails, return false and print message prepended with `"Error:"`.

        if { [llength $expected] != [llength $value] } {
            puts "Error: $msg (List length differ. Expected: [llength $expected] Have: [llength $value])"
            return false
        }
        set index 0
        foreach exp $expected val $value {
            if { [_abs [expr {$exp - $val}]] > $delta } {
                puts "Error: $msg (Values differ at index $index. Expected: $exp Have: $val)"
                return false
            }
            incr index
        }
        return true
    }

    proc photoView { phImg args } {
        variable ns
        variable sTopCount

        set opts [dict create \
            -zoom  1 \
            -title "$phImg" \
        ]

        foreach { key value } $args {
            if { [dict exists $opts $key] } {
                if { $value eq "" } {
                    error "photoView: No value specified for key \"$key\"."
                }
                dict set opts $key $value
            } else {
                error "photoView: Unknown option \"$key\" specified."
            }
        }

        wm withdraw .
        set top .t_$sTopCount
        incr sTopCount
        toplevel $top
        set phZoom [image create photo]
        $phZoom copy $phImg -zoom [dict get $opts "-zoom"]
        label $top.l -image $phZoom -background magenta
        pack $top.l
        wm title $top [dict get $opts "-title"]
        bind $top <Escape> "set ${ns}::sContinue 1 ; destroy $top"
        focus -force $top
        update
        vwait ${ns}::sContinue
    }
}

namespace import -force poFtiTest::*

tcltest::testConstraint HaveTk86 [haveTk86]
tcltest::testConstraint HaveTk90 [haveTk90]

tcltest::testConstraint HavePkgImg [havePkgImg]
