package require Tk
package require poPhotoUtil
package require Img

proc bmpFirst {} {
    return {
    #define first_width 16
    #define first_height 16
    static unsigned char first_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1c, 0x04, 0x1c, 0x06,
        0x1c, 0x07, 0x9c, 0x3f, 0xdc, 0x3f, 0x9c, 0x3f, 0x1c, 0x07, 0x1c, 0x06,
        0x1c, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

proc bmpLast {} {
    return {
    #define last_width 16
    #define last_height 16
    static unsigned char last_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x38, 0x60, 0x38,
        0xe0, 0x38, 0xfc, 0x39, 0xfc, 0x3b, 0xfc, 0x39, 0xe0, 0x38, 0x60, 0x38,
        0x20, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

proc bmpLeft {} {
    return {
    #define left_width 16
    #define left_height 16
    static unsigned char left_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x80, 0x01,
        0xc0, 0x01, 0xe0, 0x0f, 0xf0, 0x0f, 0xe0, 0x0f, 0xc0, 0x01, 0x80, 0x01,
        0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

proc bmpRight {} {
    return {
    #define right_width 16
    #define right_height 16
    static unsigned char right_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x80, 0x01,
        0x80, 0x03, 0xf0, 0x07, 0xf0, 0x0f, 0xf0, 0x07, 0x80, 0x03, 0x80, 0x01,
        0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

proc bmpPlay {} {
    return {
    #define play_width 16
    #define play_height 16
    static unsigned char play_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0xe0, 0x00,
        0xe0, 0x01, 0xe0, 0x03, 0xe0, 0x07, 0xe0, 0x03, 0xe0, 0x01, 0xe0, 0x00,
        0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

proc bmpHalt {} {
    return {
    #define halt_width 16
    #define halt_height 16
    static unsigned char halt_bits[] = {
        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x18, 0x30, 0x0c,
        0x60, 0x06, 0xc0, 0x03, 0x80, 0x01, 0xc0, 0x03, 0x60, 0x06, 0x30, 0x0c,
        0x18, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
} 

proc ui_initToolhelp { w { bgColor yellow } { fgColor black } } {
    global ui_helpWidget

    # Create Toolbar help window with a simple label in it.
    if { [winfo exists $w] } {
        destroy $w
    }
    toplevel $w
    set ui_helpWidget $w
    label $w.l -text "??" -bg $bgColor -fg $fgColor -relief ridge
    pack $w.l
    wm overrideredirect $w true
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $w help none
    }
    wm geometry $w [format "+%d+%d" -100 -100]
}

proc ui_showToolhelp { x y str } {
    global ui_helpWidget

    $ui_helpWidget.l configure -text $str
    raise $ui_helpWidget
    wm geometry $ui_helpWidget [format "+%d+%d" $x [expr $y +10]]
}

proc ui_hideToolhelp {} {
    global ui_helpWidget

    wm geometry $ui_helpWidget [format "+%d+%d" -100 -100]
}

proc ui_button { btnName bmpData cmd helpStr } {
    set imgData [image create bitmap -data $bmpData]
    eval button $btnName -image $imgData -command [list $cmd] -relief flat
    bind $btnName <Enter>  "ui_showToolhelp %X %Y [list $helpStr]"
    bind $btnName <Leave>  { ui_hideToolhelp }
    bind $btnName <Button> { ui_hideToolhelp }
}

proc ui_init {title {winPos "+0+0"} } {
    global ui_curImgNo ui_noImgs ui_top

    catch {wm withdraw .}
    set ui_top .testWindow
    ui_initToolhelp .testToolhelp
    toplevel $ui_top
    wm title $ui_top $title
    wm geometry $ui_top $winPos
    frame $ui_top.imgfr -bg lightgrey
    frame $ui_top.menufr -relief raised -bg lightgrey

    label $ui_top.imgfr.img -bg white
    text $ui_top.imgfr.txt -height 2 -width 60 -state disabled
    pack $ui_top.imgfr.txt -side top -expand 1 -fill x -expand 1 -fill x
    pack $ui_top.imgfr.img -side top

    ui_button $ui_top.menufr.quit [bmpHalt] ui_exit "Quit test (Esc)"
    pack $ui_top.menufr.quit -in $ui_top.menufr -side left
    pack $ui_top.menufr $ui_top.imgfr -side top -pady 2 -anchor w
    bind $ui_top <Key-Escape> ui_exit
    wm protocol $ui_top WM_DELETE_WINDOW ui_exit

    P "Visual: [winfo screenvisual $ui_top]"
    P "Depth:  [winfo depth $ui_top]"
    set ui_curImgNo 0
    set ui_noImgs   0
}

proc ui_addphoto { phImg str } {
    global ui_curImgNo ui_noImgs ui_strings ui_images ui_photos
    global gTime
 
    set ui_strings($ui_curImgNo) "$str ($gTime(end) secs)"
    set ui_images($ui_curImgNo)  "none"
    set ui_photos($ui_curImgNo) $phImg
    showimg $ui_curImgNo
    incr ui_curImgNo
    set ui_noImgs $ui_curImgNo
}

proc showimg { imgNo } {
    global ui_strings ui_top ui_photos

    $ui_top.imgfr.img config -image $ui_photos($imgNo)

    $ui_top.imgfr.txt configure -state normal
    $ui_top.imgfr.txt delete 1.0 end
    $ui_top.imgfr.txt insert end $ui_strings($imgNo)
    $ui_top.imgfr.txt configure -state disabled
    update
}

proc show_first {} {
    global ui_curImgNo ui_noImgs

    set ui_curImgNo 0
    showimg $ui_curImgNo
}

proc show_last {} {
    global ui_curImgNo ui_noImgs

    set ui_curImgNo [expr ($ui_noImgs -1)]
    showimg $ui_curImgNo
}

proc show_play {} {
    global ui_curImgNo ui_noImgs

    while { $ui_curImgNo < [expr ($ui_noImgs -1)] } {
            incr ui_curImgNo
            showimg $ui_curImgNo
    }
}

proc show_prev {} {
    global ui_curImgNo

    if { $ui_curImgNo > 0 } {
        incr ui_curImgNo -1
            showimg $ui_curImgNo
    }
}

proc show_next {} {
    global ui_curImgNo ui_noImgs

    if { $ui_curImgNo < [expr ($ui_noImgs -1)] } {
            incr ui_curImgNo 1
            showimg $ui_curImgNo
    }
}

proc ui_show {} {
    global ui_curImgNo ui_noImgs ui_strings ui_top

    PrintMachineInfo

    set ui_noImgs $ui_curImgNo
    incr ui_curImgNo -1
    if { $ui_noImgs > 0 } {
        set fr $ui_top.menufr
        ui_button $fr.first [bmpFirst] show_first "Show first image"
        ui_button $fr.prev  [bmpLeft]  show_prev  "Show previous image (<-)"
        ui_button $fr.next  [bmpRight] show_next  "Show next image (->)"
        ui_button $fr.last  [bmpLast]  show_last  "Show last image"
        ui_button $fr.play  [bmpPlay]  show_play  "Play image sequence (p)"
        pack $fr.first $fr.prev $fr.next $fr.last \
             -in $fr -side left -padx 0
        pack $fr.play -in $fr -side left -padx 0

        bind $ui_top <Key-Right>  show_next
        bind $ui_top <Key-Left>   show_prev
        bind $ui_top <Key-p>      show_play
    }
}

proc ui_delete {} {
    global ui_noImgs ui_strings ui_images ui_photos ui_top

    for { set i 0 } { $i < $ui_noImgs } { incr i } {
        image delete $ui_photos($i)
        if { [info commands $ui_images($i)] != {} } {
            deleteimg $ui_images($i)
        }
        set ui_strings($i) {}
    }
    destroy $ui_top.imgfr
    destroy $ui_top.menufr
}

proc ui_exit {} {
    ui_delete
    if { [info commands memcheck] != {} } {
        memcheck
    }
    exit
}

proc P { str } {
    catch {puts $str ; flush stdout}
}

proc PH { str } {
    P ""
    P "Test: $str"
    PS
}

proc PS { } {
    P ""
    P "------------------------------------------------------------"
    P ""
}

proc PSec { msg sec } {
    P [format "%s: %.4f seconds" $msg $sec]
}

proc PrintMachineInfo {} {
    global tcl_platform

    P "Machine specific information:"
    P  "platform    : $tcl_platform(platform)"
    P  "os          : $tcl_platform(os)"
    P  "osVersion   : $tcl_platform(osVersion)"
    P  "machine     : $tcl_platform(machine)"
    P  "byteOrder   : $tcl_platform(byteOrder)"
    P  "wordSize    : $tcl_platform(wordSize)"
    P  "user        : $tcl_platform(user)"
    P  "hostname    : [info hostname]"
    P  "Tcl version : [info patchlevel]"
    P  "Visuals     : [winfo visualsavailable .]"
}

proc ClockStart {} {
    global gTime

    set gTime(start) [clock milliseconds]
}

proc ClockLookup {} {
    global gTime

    set gTime(end) [expr ([clock milliseconds] - $gTime(start)) / 1000.0] 
    return $gTime(end)
}

if { $argc == 0 } {
    puts "Usage: $argv0 TestImageFile"
    exit 1
}

PH "Image processing with pure Tk"

set testProc   1
set testBlur   1
set testReduce 1
set testStats  1

ui_init "PhotoUtilTest"

set phImg [image create photo -file [lindex $argv 0]]

set w [image width $phImg]
set h [image height $phImg]
set msg "Original image (Size: $w x $h)"
P $msg

if { $testProc } {
    set msg "Creating white photo image"
    P $msg
    ClockStart
    set phColorWhite [::poPhotoUtil::ColorImg 200 150]
    PSec "Required time" [ClockLookup]
    ui_addphoto $phColorWhite $msg

    set msg "Creating red photo image"
    P $msg
    ClockStart
    set phColorRed [::poPhotoUtil::ColorImg 120 180 255 0 0]
    PSec "Required time" [ClockLookup]
    ui_addphoto $phColorRed $msg

    set msg "Flipping horizontally"
    P $msg
    ClockStart
    set phFlipHori [::poPhotoUtil::FlipHorizontal $phImg]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phFlipHori] $msg

    set msg "Flipping vertically"
    P $msg
    ClockStart
    set phFlipVert [::poPhotoUtil::FlipVertical $phImg]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phFlipVert] $msg

    set msg "Rotating by 90 degrees"
    P $msg
    ClockStart
    set phRot90 [::poPhotoUtil::Rotate $phImg 90]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phRot90] $msg

    set msg "Rotating by 180 degrees"
    P $msg
    ClockStart
    set phRot180 [::poPhotoUtil::Rotate $phImg 180]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phRot180] $msg

    set msg "Rotating by 270 degrees"
    P $msg
    ClockStart
    set phRot270 [::poPhotoUtil::Rotate $phImg 270]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phRot270] $msg

    set msg "Rotating by -90 degrees"
    P $msg
    ClockStart
    set phRotMin90 [::poPhotoUtil::Rotate $phImg -90]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phRotMin90] $msg

    set nw [expr int($w * 0.75)]
    set nh [expr int($h * 0.75)]
    set msg "Resizing image to ($nw x $nh)"
    P $msg
    ClockStart
    set phResizeDown [::poPhotoUtil::Resize $phImg $nw $nh]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phResizeDown] $msg

    set nw [expr int($w * 1.5)]
    set nh [expr int($h * 1.5)]
    set msg "Resizing image to ($nw x $nh)"
    P $msg
    ClockStart
    set phResizeUp [::poPhotoUtil::Resize $phImg $nw $nh]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phResizeUp] $msg

    set msg "Tiling by 3x2"
    P $msg
    ClockStart
    set phTile3x2 [::poPhotoUtil::Tile $phImg 3 2]
    PSec "Required time" [ClockLookup]
    ui_addphoto $phTile3x2 $msg

    set msg "Tiling by 3x2 (Mirroring in x)"
    P $msg
    ClockStart
    set phTile3x2Mirror [::poPhotoUtil::Tile $phImg 3 2 true false]
    PSec "Required time" [ClockLookup]
    ui_addphoto $phTile3x2Mirror $msg
}

if { $testBlur } {
    set msg "Brightening image"
    P $msg
    ClockStart
    set phHSVBright [::poPhotoUtil::HSV $phImg 1.4]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phHSVBright] $msg

    set msg "Darkening image"
    P $msg
    ClockStart
    set phHSVDark [::poPhotoUtil::HSV $phImg 0.6]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phHSVDark] $msg

    set msg "Saturating image"
    P $msg
    ClockStart
    set phHSVSat [::poPhotoUtil::HSV $phImg 1.0 1.7]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phHSVSat] $msg

    set msg "Blurring image"
    P $msg
    ClockStart
    set phBlur [::poPhotoUtil::Blur $phImg 0.8]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phBlur] $msg
}

if { $testReduce } {
    set msg "Reducing color depth to 8-bit"
    P $msg
    ClockStart
    set phReduce8 [::poPhotoUtil::Reduce $phImg 8]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phReduce8] $msg

    set msg "Reducing color depth to 6-bit"
    P $msg
    ClockStart
    set phReduce6 [::poPhotoUtil::Reduce $phImg 6]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phReduce6] $msg

    set msg "Reducing color depth to 4-bit"
    P $msg
    ClockStart
    set phReduce4 [::poPhotoUtil::Reduce $phImg 4]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 2 $phImg $phReduce4] $msg

    set msg "Difference image (original vs. 4-bit)"
    P $msg
    ClockStart
    set phDiff [::poPhotoUtil::Difference $phImg $phReduce4]
    PSec "Required time" [ClockLookup]
    ui_addphoto [::poPhotoUtil::Compose 3 $phImg $phReduce4 $phDiff] $msg
}

proc PrintImgStats { statDict } {
    set minStr [format "(%d, %d, %d)" \
               [dict get $statDict min red  ] \
               [dict get $statDict min green] \
               [dict get $statDict min blue ]]
    set maxStr [format "(%d, %d, %d)" \
               [dict get $statDict max red  ] \
               [dict get $statDict max green] \
               [dict get $statDict max blue ]]
    set medStr [format "(%.3f, %.3f, %.3f)" \
               [dict get $statDict mean red  ] \
               [dict get $statDict mean green] \
               [dict get $statDict mean blue ]]
    set stdStr [format "(%.3f, %.3f, %.3f)" \
               [dict get $statDict std red  ] \
               [dict get $statDict std green] \
               [dict get $statDict std blue ]]
    P "Num pixels    : [dict get $statDict num]"
    P "Minimum values: $minStr"
    P "Maximum values: $maxStr"
    P "Mean    values: $medStr"
    P "StdDev  values: $stdStr"
}

proc PrintImgHisto { histoDict } {
    for { set i 0 } { $i < 256 } { incr i } {
        P [format "%3d: %3d %3d %3d" $i \
           [lindex [dict get $histoDict red] $i] \
           [lindex [dict get $histoDict green] $i] \
           [lindex [dict get $histoDict blue] $i]]
    }
}

if { $testStats } {
    set msg "Calculating image histogram"
    P $msg
    ClockStart
    set histoDict [::poPhotoUtil::Histogram $phImg]
    PSec "Required time" [ClockLookup]
    PrintImgHisto $histoDict

    set histoHeight 150
    set msg "Putting logarithmic histogram into image"
    P $msg
    ClockStart
    set logDict [::poPhotoUtil::ScaleHistogram $histoDict $histoHeight true]
    set phHistoLogRed   [::poPhotoUtil::DrawHistogram $logDict $histoHeight "red"  ]
    set phHistoLogGreen [::poPhotoUtil::DrawHistogram $logDict $histoHeight "green"]
    set phHistoLogBlue  [::poPhotoUtil::DrawHistogram $logDict $histoHeight "blue" ]
    PSec "Required time" [ClockLookup]
    set phHistoLogImg [::poPhotoUtil::Compose 4 $phImg \
                      $phHistoLogRed $phHistoLogGreen $phHistoLogBlue]
    ui_addphoto $phHistoLogImg $msg

    set msg "Putting linear histogram into image"
    P $msg
    ClockStart
    set linDict [::poPhotoUtil::ScaleHistogram $histoDict $histoHeight false]
    set phHistoLinRed   [::poPhotoUtil::DrawHistogram $linDict $histoHeight "red"  ]
    set phHistoLinGreen [::poPhotoUtil::DrawHistogram $linDict $histoHeight "green"]
    set phHistoLinBlue  [::poPhotoUtil::DrawHistogram $linDict $histoHeight "blue" ]
    PSec "Required time" [ClockLookup]
    set phHistoLinImg [::poPhotoUtil::Compose 4 $phImg \
                      $phHistoLinRed $phHistoLinGreen $phHistoLinBlue]
    ui_addphoto $phHistoLinImg $msg

    set msg "Calculating image characteristics (whole image)"
    P $msg
    ClockStart
    set statDict [::poPhotoUtil::GetImgStats $phImg true]
    PrintImgStats $statDict
    PSec "Required time" [ClockLookup]

    set msg "Calculating image characteristics (part of image)"
    P $msg
    ClockStart
    set statDict [::poPhotoUtil::GetImgStats $phImg true \
                  50 70  50 80]
    PrintImgStats $statDict
    PSec "Required time" [ClockLookup]
}

PS
P "End of test"

ui_show