# 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/>.
#----------------------------------------------------------------------

proc TODO: {{text ""}} {
    set dict [info frame -1]
    append message "\[[dict get $dict file]"
    append message " line [dict get $dict line]"
    append message " [dict get $dict proc]\] TODO: "
    append message $text
    puts $message
}

proc getHomeDirectory {} {
    global env
    set error 0
    set homeDir [lindex [array get env HOME] 1]
    if {$homeDir == ""} {
        error "no HOME variable in the environment"
    }
    if ![file exists $homeDir] {
        error "home directory $homeDir does not exist"
    }
    if ![file isdirectory $homeDir] {
        error "home directory $homeDir is not a directory!"
    }
    return $homeDir
}

# By default, places the toplevel of the given widget at the center of
# the screen, or at the center of the given reference widget if it
# exists.
proc centerToplevel {widget {ref ""}} {
    set top [winfo toplevel $widget]
    set centerx [expr [winfo screenwidth $top] / 2]
    set centery [expr [winfo screenheight $top]  / 2]

    if {$ref != "" && [winfo exists $ref]} {
        set centerx [expr [winfo rootx $ref] + [winfo width $ref] / 2]
        set centery [expr [winfo rooty $ref] + [winfo height $ref] / 2]
    }

    wm withdraw $top
    update idletasks

    set width [winfo reqwidth $top]
    set height [winfo reqheight $top]
    set rootx [expr $centerx - $width / 2]
    set rooty [expr $centery - $height / 2]
    set geometry ${width}x${height}+${rootx}+${rooty}
    setGeometry $top $geometry
    fixGeometry $top $centerx $centery

    wm deiconify $top
    raise $top
    update idletasks
}

proc initGeometry {top geometry} {
    wm withdraw $top
    update idletasks
    setGeometry $top $geometry
    fixGeometry $top
    wm deiconify $top
    raise $top
}

proc setGeometry {top geometry} {
    wm geometry $top $geometry
    update idletasks
}

proc getGeometry {top} {
    return [wm geometry $top]
}

proc fixGeometry {top {centerx ""} {centery ""}} {
    set geometry [getGeometry $top]
    scan $geometry "%dx%d+%d+%d" width height x y
    set screenwidth [winfo screenwidth $top]
    set screenheight [winfo screenheight $top]

    foreach {var dim center} {x width centerx y height centery} {
        set vvar [subst \$$var]
        set vdim [subst \$$dim]
        set vsdim [subst \$screen$dim]
        if {$vvar < 0 || $vvar + $vdim > $vsdim} {
            if {$vdim > $vsdim} {
                set $var 0
                set $dim $vsdim
            } else {
                set vcenter [subst \$$center]
                if {$vcenter != ""} continue
                set $center [expr $vsdim / 2]
            }
        }
    }

    foreach {var dim center} {x width centerx y height centery} {
        set vcenter [subst \$$center]
        if {$vcenter == ""} continue
        set vdim [subst \$$dim]
        # Because of frame decoration, there can be a difference
        # between wm geometry and winfo rootx rooty.  Consider it.
        set diff [expr [winfo root$var $top] + ($vdim / 2) - $vcenter]
        set vvar [subst \$$var]
        set $var [expr $vvar - $diff]
    }

    set geometry "${width}x${height}+$x+$y"
    setGeometry $top $geometry
}

proc createFont {name args} {
    if {[lsearch [font names] $name] != -1} return
    eval font create $name $args
}

proc debug {args} {
    uplevel {
        set dict [info frame -3]
        puts "*debug* [dict get $dict cmd]"
    }
    if {[llength $args] > 0} {
        puts "*debug*     $args"
    }
}

