# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: bgchoose.tcl,v 1.13 2006/01/28 19:16:59 jfontain Exp $


class backgroundChooser {

    set (positions) [list [mc center] [mc {upper left}]]
    set (positionCodes) [list {} nw]                                                                           ;# as in grid command

    proc backgroundChooser {this parentPath args} composite {[new frame $parentPath] $args} {
        set path $widget::($this,path)
        set ($this,imageButton) [checkbutton $path.imageButton\
            -text [mc {Image file:}] -variable backgroundChooser::($this,useImage)\
            -command "composite::configure $this -useimage \$backgroundChooser::($this,useImage)"\
        ]
        grid $($this,imageButton) -row 0 -column 0 -padx 2 -sticky e
        set ($this,imageEntry) [entry $path.imageFile -textvariable backgroundChooser::($this,imageFile)]
        grid $($this,imageEntry) -row 0 -column 1 -columnspan 2 -padx 2 -sticky ew
        set ($this,imageChoose) [button $path.imageChoose -text [mc Choose]... -command "backgroundChooser::inquireImageFile $this"]
        grid $($this,imageChoose) -row 0 -column 3 -padx 2 -sticky w
        set ($this,positionsLabel) [label $path.positionsLabel -text [mc {Image position:}]]
        grid $($this,positionsLabel) -row 1 -column 0 -padx 2 -sticky e
        set entry [new comboEntry $path -editable 0 -command "backgroundChooser::setImagePosition $this" -list $(positions)]
        composite::configure $entry entry -textvariable backgroundChooser::($this,position)
        composite::configure $entry button -listheight [llength $(positions)]
        composite::configure $entry button scroll -selectmode single
        set ($this,imagePositions) $entry
        grid $widget::($($this,imagePositions),path) -row 1 -column 1 -padx 2 -sticky w
        set ($this,window) [new window $path]
        grid $widget::($($this,window),path) -row 1 -column 2 -rowspan 2 -columnspan 2 -padx 5 -pady 5 -sticky e
        set ($this,colorButton) [button $path.colorButton -text [mc Color]... -command "backgroundChooser::inquireColor $this"]
        grid $($this,colorButton) -row 2 -column 1 -padx 2
        grid columnconfigure $path 2 -weight 1
        set ($this,image) {}
        composite::complete $this
    }

    proc ~backgroundChooser {this} {
        if {$($this,image) ne ""} {image delete $($this,image)}
        delete $($this,window)
    }

    proc options {this} {
        set list [list [list [mc {image files}] .gif]]
        return [list\
            [list -color white]\
            [list -font $widget::option(label,font)]\
            [list -imagefile {}]\
            [list -imagefiletypes $list $list]\
            [list -position {}]\
            [list -targetsize {0 0} {0 0}]\
            [list -useimage 0]\
        ]
    }

    proc set-color {this value} {
        $($this,colorButton) configure -background $value -foreground [visibleForeground $value]
        composite::configure $($this,window) -background $value
    }

    proc set-font {this value} {
        foreach path [list $($this,positionsLabel) $($this,imageButton) $($this,imageEntry)] {
            $path configure -font $value
        }
        composite::configure $($this,imagePositions) -font $value
    }

    proc set-imagefile {this value} {
        set ($this,imageFile) $value
        if {$($this,image) ne ""} {
            image delete $($this,image)
            set ($this,image) {}
        }
        if {$value ne ""} {
            set ($this,image) [image create photo -file $value]
        }
        if {$composite::($this,-useimage)} {
            composite::configure $($this,window) -image $($this,image)
        } else {
            composite::configure $($this,window) -image {}
        }
    }

    proc set-position {this value} {
        set index [lsearch -exact $(positionCodes) $value]; if {$index < 0} {set index 0}
        set ($this,position) [lindex $(positions) $index]
        composite::configure $($this,window) -position $value
    }

    proc set-targetsize {this value} {
        composite::configure $($this,window) -size $value
    }

    proc set-useimage {this value} {
        set ($this,useImage) $value
        if {$value} {
            $($this,imageEntry) configure -state normal
            $($this,imageChoose) configure -state normal
            composite::configure $($this,imagePositions) -state normal
            composite::configure $($this,window) -image $($this,image)
        } else {
            $($this,imageEntry) configure -state disabled
            $($this,imageChoose) configure -state disabled
            composite::configure $($this,imagePositions) -state disabled
            composite::configure $($this,window) -image {}
        }
    }

    proc inquireImageFile {this} {
        set name $composite::($this,-imagefile)
        if {$name eq ""} {
            set directory .
        } else {
            set directory [file dirname $name]; set name [file tail $name]
        }
        set file [tk_getOpenFile\
            -title [mc {moodss: Image File}] -parent $widget::($this,path) -initialdir $directory -initialfile $name\
            -filetypes $composite::($this,-imagefiletypes)\
        ]                                                                              ;# note: returns the full pathname or nothing
        if {$file ne ""} {                                                                                           ;# not canceled
            composite::configure $this -imagefile $file
        }
    }

    proc inquireColor {this} {
        set color [tk_chooseColor\
            -title [mc {Choose background color:}] -parent $widget::($this,path) -initialcolor $composite::($this,-color)\
        ]
        if {$color ne ""} {
            composite::configure $this -color $color
        }
    }

    proc setImagePosition {this position} {
        set index [lsearch -exact $(positions) $position]; if {$index < 0} {set index 0}
        composite::configure $this -position [lindex $(positionCodes) $index]
    }

    proc applyFileEntry {this} {                       ;# public procedure: synchronize file entry in case of manual input from user
        composite::configure $this -imagefile $($this,imageFile)
    }

}


class backgroundChooser {

    class window {

        proc window {this parentPath args} composite {[new frame $parentPath -background black] $args} {
            set ($this,frame) [frame $widget::($this,path).frame]
            set ($this,label) [label $($this,frame).label -borderwidth 0]
            pack $($this,frame) -fill both -padx 1 -pady 1
            composite::complete $this
        }

        proc ~window {this} {
            if {[info exists ($this,image)]} {image delete $($this,image)}
        }

        proc options {this} {
            return [list\
                [list -background white]\
                [list -image {} {}]\
                [list -position {} {}]\
                [list -size [list [winfo screenwidth .] [winfo screenheight .]]]\
            ]
        }

        proc set-background {this value} {
            $($this,frame) configure -background $value
            $($this,label) configure -background $value
        }

        proc set-size {this value} {                                                               ;# target window width and height
            update $this
        }

        proc set-image {this value} {
            update $this
        }

        proc set-position {this value} {
            update $this
        }

        proc update {this} {                                                              ;# possibly update image size and position
            set scale 10.0                                                                                       ;# must be a double
            foreach {width height} $composite::($this,-size) {}
            $($this,frame) configure -width [expr {round($width / $scale)}] -height [expr {round($height / $scale)}]
            if {[info exists ($this,image)]} {
                image delete $($this,image)
                unset ($this,image)
            }
            set image $composite::($this,-image)
            if {$image eq ""} {
                place forget $($this,label)
                return
            }
            set ($this,image) [image create photo]
            $($this,image) copy $image -subsample [expr {round($scale)}]\
                -to 0 0 [expr {round([image width $image] / $scale)}] [expr {round([image height $image] / $scale)}]
            $($this,label) configure -image $($this,image)
            switch $composite::($this,-position) {
                nw {                                                                                            ;# upper left corner
                    place $($this,label) -anchor nw -relx 0 -rely 0
                }
                default {                                                                                                ;# centered
                    place $($this,label) -anchor center -relx 0.5 -rely 0.5
                }
            }
        }

    }

}
