set scriptDir [file normalize [file join [file dirname [info script]] ".."]]
set auto_path [linsert $auto_path 0 $scriptDir]

package require Tk
package require poTcllib
package require poTklib
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_photos
    global gTime
 
    set ui_strings($ui_curImgNo) "$str ($gTime(end) secs)"
    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
    poWin  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_photos ui_top

    for { set i 0 } { $i < $ui_noImgs } { incr i } {
        image delete $ui_photos($i)
        set ui_strings($i) {}
    }
    destroy $ui_top.imgfr
    destroy $ui_top.menufr
}

proc ui_exit {} {
    ui_delete
    exit 0
}

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  "Tk version  : $::tk_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 < 1 } {
    puts "Usage: $argv0 TestImageFile \[mode\]"
    exit 1
}

PH "Image processing with pure Tk"

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

if { ! [file isdirectory "testOut"] } {
    file mkdir "testOut"
}
set outTmpl "testOut/poPhotoUtil_%s.png"
set outFmt  "PNG"

ui_init "poTklib_PhotoUtil"

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]
    $phColorWhite write [format $outTmpl "ColorWhite"] -format $outFmt
    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]
    $phColorRed write [format $outTmpl "ColorRed"] -format $outFmt
    ui_addphoto $phColorRed $msg

    set msg "Flipping horizontally"
    P $msg
    ClockStart
    set phFlipHori [poPhotoUtil FlipHorizontal $phImg]
    PSec "Required time" [ClockLookup]
    $phFlipHori write [format $outTmpl "FlipHori"] -format $outFmt
    ui_addphoto [poPhotoUtil Compose 2 $phImg $phFlipHori] $msg

    set msg "Flipping vertically"
    P $msg
    ClockStart
    set phFlipVert [poPhotoUtil FlipVertical $phImg]
    PSec "Required time" [ClockLookup]
    $phFlipVert write [format $outTmpl "FlipVert"] -format $outFmt
    ui_addphoto [poPhotoUtil Compose 2 $phImg $phFlipVert] $msg

    set msg "Rotating by 90 degrees"
    P $msg
    ClockStart
    set phRot90 [poPhotoUtil Rotate90 $phImg 90]
    PSec "Required time" [ClockLookup]
    $phRot90 write [format $outTmpl "Rot90"] -format $outFmt
    ui_addphoto [poPhotoUtil Compose 2 $phImg $phRot90] $msg

    set msg "Rotating by 180 degrees"
    P $msg
    ClockStart
    set phRot180 [poPhotoUtil Rotate90 $phImg 180]
    PSec "Required time" [ClockLookup]
    $phRot180 write [format $outTmpl "Rot180"] -format $outFmt
    ui_addphoto [poPhotoUtil Compose 2 $phImg $phRot180] $msg

    set msg "Rotating by 270 degrees"
    P $msg
    ClockStart
    set phRot270 [poPhotoUtil Rotate90 $phImg 270]
    PSec "Required time" [ClockLookup]
    $phRot270 write [format $outTmpl "Rot270"] -format $outFmt
    ui_addphoto [poPhotoUtil Compose 2 $phImg $phRot270] $msg

    set msg "Rotating by -90 degrees"
    P $msg
    ClockStart
    set phRotMin90 [poPhotoUtil Rotate90 $phImg -90]
    PSec "Required time" [ClockLookup]
    $phRotMin90 write [format $outTmpl "RotMin90"] -format $outFmt
    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]
    $phResizeDown write [format $outTmpl "ResizeDown"] -format $outFmt
    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]
    $phResizeUp write [format $outTmpl "ResizeUp"] -format $outFmt
    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]
    $phTile3x2 write [format $outTmpl "Tile3x2"] -format $outFmt
    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]
    $phTile3x2Mirror write [format $outTmpl "Tile3x2Mirror"] -format $outFmt
    ui_addphoto $phTile3x2Mirror $msg

    set red    19
    set green  92
    set blue  192
    set msg "Set transparent color to $red, $green, $blue"
    P $msg
    ClockStart
    set phAlpha [poPhotoUtil CopyImg $phImg]
    poPhotoUtil SetTransparentColor $phAlpha $red $green $blue
    PSec "Required time" [ClockLookup]
    $phAlpha write [format $outTmpl "Alpha"] -format $outFmt
    ui_addphoto $phAlpha $msg
}

if { $testBlur } {
    set msg "Brightening image"
    P $msg
    ClockStart
    set phHSVBright [poPhotoUtil HSV $phImg 1.4]
    PSec "Required time" [ClockLookup]
    $phHSVBright write [format $outTmpl "HSVBright"] -format $outFmt
    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]
    $phHSVDark write [format $outTmpl "HSVDark"] -format $outFmt
    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]
    $phHSVSat write [format $outTmpl "HSVSat"] -format $outFmt
    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]
    $phBlur write [format $outTmpl "Blur"] -format $outFmt
    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]
    $phReduce8 write [format $outTmpl "Reduce8"] -format $outFmt
    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]
    $phReduce6 write [format $outTmpl "Reduce6"] -format $outFmt
    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]
    $phReduce4 write [format $outTmpl "Reduce4"] -format $outFmt
    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]
    $phDiff write [format $outTmpl "Diff"] -format $outFmt
    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 } {
    P "Histogram of [dict get $histoDict description]:"
    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 GetHistogram $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 "log"]
    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]
    $phHistoLogImg write [format $outTmpl "HistoLogImg"] -format $outFmt
    ui_addphoto $phHistoLogImg $msg

    set msg "Putting linear histogram into image"
    P $msg
    ClockStart
    set linDict [poPhotoUtil ScaleHistogram $histoDict $histoHeight "lin"]
    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]
    $phHistoLinImg write [format $outTmpl "HistoLinImg"] -format $outFmt
    ui_addphoto $phHistoLinImg $msg

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

    set msg "Calculating image characteristics (part of image)"
    P $msg
    ClockStart
    set statDict [poPhotoUtil GetImageStats $phImg 30 250  70 290 true]
    PSec "Required time" [ClockLookup]
    PrintImgStats $statDict
}

PS
P "End of test"

ui_show

if { $argc > 1 && [lindex $argv 1] eq "auto" } {
    ui_exit
    exit 0
}
