# Module:         poSoftLogo
# Copyright:      Paul Obermeier 2000-2018 / paul@poSoft.de
# First Version:  2000 / 02 / 20
#
# Distributed under BSD license.
#
# Module for displaying a poSoft and Tcl logo window.

namespace eval poSoftLogo {
    variable ns [namespace current]

    namespace ensemble create

    namespace export ShowLogo DestroyLogo
    namespace export ShowTclLogo DestroyTclLogo

    proc ShrinkWindow { tw dir } {
        set width  [winfo width $tw]
        set height [winfo height $tw]
        set x      [winfo x $tw]
        set y      [winfo y $tw]
        set inc -1

        if { $dir eq "x" } {
            for { set w $width } { $w >= 20 } { incr w $inc } {
                if { [winfo exists $tw] } {
                    wm geometry $tw [format "%dx%d+%d+%d" $w $height $x $y]
                    update idletasks
                }
                incr inc -1
            }
        } else {
            for { set h $height } { $h >= 20 } { incr h $inc } {
                if { [winfo exists $tw] } {
                    wm geometry $tw [format "%dx%d+%d+%d" $width $h $x $y]
                    update idletasks
                }
                incr inc -1
            }
        }
    }

    proc DestroyLogo {} {
        variable wackel
        variable logoWinId
        variable withdrawnWinId

        if { [info exists logoWinId] && [winfo exists $logoWinId] } {
            ShrinkWindow $logoWinId x
            set wackel(onoff) 0
            catch {image delete $wackel(0)}
            catch {image delete $wackel(1)}
            destroy $logoWinId
            if { [winfo exists $withdrawnWinId] } {
                wm deiconify $withdrawnWinId
            }
        }
    }

    proc ShowLogo { version buildInfo copyright {withdrawWin ""} } {
        variable ns
        variable wackel
        variable logoWinId
        variable withdrawnWinId

        set t ".poShowLogo"
        set logoWinId $t
        set withdrawnWinId $withdrawWin
        if { [winfo exists $t] } {
            poWin Raise $t
            return
        }

        set wackel(0) [::poImgData::poLogo]
        set wackel(1) [poPhotoUtil FlipHorizontal $wackel(0)]
        set wackel(onoff)  0
        set wackel(curImg) 0
        set wackel(wackelSpeed) 500

        toplevel $t
        ttk::frame $t.f
        pack $t.f
        wm resizable $t false false
        if { $withdrawWin eq "" } {
            wm title $t "poSoft Information"
        } else {
            if { $withdrawWin ne "." } {
                wm withdraw .
            }
            if { [winfo exists $withdrawWin] } {
                wm withdraw $withdrawWin
                set withdrawnWinId $withdrawWin
            }
            wm overrideredirect $t 1
            set xmax [winfo screenwidth $t]
            set ymax [winfo screenheight $t]
            set x0 [expr {($xmax - [image width  $wackel(0)])/2}]
            set y0 [expr {($ymax - [image height $wackel(0)])/2}]
            wm geometry $t "+$x0+$y0"
            $t.f configure -borderwidth 10
            raise $t
            update idletasks
        }

        ttk::label $t.f.l1 -anchor center -text "Paul Obermeier's Portable Software"
        pack $t.f.l1 -fill x
        ttk::button $t.f.l2 -image $wackel(0)
        poToolhelp AddBinding $t.f.l2 "http://www.poSoft.de"
        bind $t.f.l2 <Motion>         "${ns}::SetWackelDelay %x %y"
        bind $t.f.l2 <Shift-Button-1> "${ns}::StartWackel $t.f.l2"
        bind $t.f.l2 <Button-1>       "${ns}::SwitchLogo $t.f.l2"
        pack $t.f.l2
        ttk::label $t.f.l3 -anchor center -text $version
        pack $t.f.l3 -fill x
        ttk::label $t.f.l4 -anchor center -text $buildInfo
        pack $t.f.l4 -fill x
        ttk::label $t.f.l5 -anchor center -text $copyright
        pack $t.f.l5 -fill x
        if { $withdrawWin eq "" } {
            bind $t <KeyPress-Escape> "${ns}::DestroyLogo"
            bind $t <KeyPress-Return> "${ns}::DestroyLogo"
            wm protocol $t WM_DELETE_WINDOW "${ns}::DestroyLogo"
            focus $t
            update idletasks
        } else {
            focus $t
            update idletasks
            after 500
            SwitchLogo $t.f.l2
            update idletasks
            after 300
        }
    }

    proc SetWackelDelay { mouseX mouseY } {
        variable wackel

        set wackel(wackelSpeed) [expr $mouseX + $mouseY]
    }

    proc SwitchLogo { b } {
        variable wackel

        if { $wackel(onoff) == 1 } {
            set wackel(onoff) 0
        }
        set wackel(curImg) [expr 1 - $wackel(curImg)]
        $b configure -image $wackel($wackel(curImg))
    }

    proc StartWackel { b } {
        variable wackel

        if { $wackel(onoff) == 0 } {
            set wackel(onoff) 1
            Wackel $b
        } else {
            StopWackel $b
        }
    }

    proc StopWackel { b } {
        variable ns
        variable wackel

        set wackel(onoff)  0
        set wackel(curImg) 1
        after $wackel(wackelSpeed) "${ns}::Wackel $b"
    }

    proc Wackel { b } {
        variable ns
        variable wackel

        if { $wackel(onoff) == 1 } {
            set wackel(curImg) [expr 1 - $wackel(curImg)]
            $b configure -image $wackel($wackel(curImg))
            update idletasks
            after $wackel(wackelSpeed) "${ns}::Wackel $b"
        }
    }

    proc Str { key args } {
        variable msgStr

        set str $msgStr($key)
        return [eval {format $str} $args]
    }

    proc DestroyTclLogo { w img } {
        ShrinkWindow $w y
        image delete $img
        destroy $w
    }

    proc ShowTclLogo { args } {
        variable ns
        variable msgStr
        variable url

        set t ".poShowTclLogo"
        if { [winfo exists $t] } {
            poWin Raise $t
            return
        }

        array set msgStr [list \
            WithHelp "With a little help from my Tcl friends ..." \
            Thanks   "Thanks to %s" \
        ]

        toplevel $t
        wm title $t "Tcl/Tk Information"
        wm resizable $t false false

        ttk::frame $t.fr
        pack $t.fr -fill both -expand 1

        set ph [::poImgData::pwrdLogo200]
        ttk::label $t.fr.img -image $ph
        pack $t.fr.img
        ttk::label $t.fr.l1 -anchor w -text [Str WithHelp]
        pack $t.fr.l1

        set row 0
        ttk::frame $t.f
        pack $t.f -fill both -expand 1
        foreach extension $args {
            set retVal [catch {package present $extension} versionStr]
            if { $retVal != 0 } {
                set versionStr "(not loaded)"
            }
            switch -exact -- $extension {
                Tk       { set progName  "Tcl/Tk [info patchlevel]"
                            set url($row) "http://www.tcl.tk/"
                            set author    "all Tcl/Tk core developers"
                          }
                Img       { set progName  "Img $versionStr"
                            set url($row) "http://sourceforge.net/projects/tkImg/"
                            set author    "Jan Nijtmans, Andreas Kupries"
                          }
                Tktable   { set progName  "Tktable $versionStr"
                            set url($row) "http://sourceforge.net/projects/tktable/"
                            set author    "Jeffrey Hobbs"
                          }
                tkdnd     { set progName  "tkdnd $versionStr"
                            set url($row) "https://github.com/petasis/tkdnd/"
                            set author    "Georgios Petasis"
                          }
                tksvg     { set progName  "tksvg $versionStr"
                            set url($row) "https://github.com/auriocus/tksvg/"
                            set author    "Christian Gollwitzer"
                          }
                twapi     { set progName  "twapi $versionStr"
                            set url($row) "http://twapi.magicsplat.com/"
                            set author    "Ashok P. Nadkarni"
                          }
                tablelist { set progName  "tablelist $versionStr"
                            set url($row) "http://www.nemethi.de/"
                            set author    "Csaba Nemethi"
                          }
            }
            ttk::label $t.f.lext$row -text $progName
            eval ttk::entry $t.f.rext$row -state normal -width 35 \
                                -textvariable ${ns}::url($row)
            poToolhelp AddBinding $t.f.lext$row [Str Thanks $author]
            grid $t.f.lext$row -row $row -column 0 -sticky w
            grid $t.f.rext$row -row $row -column 1 -sticky w
            incr row
        }
        bind $t <KeyPress-Escape> "${ns}::DestroyTclLogo $t $ph"
        bind $t <KeyPress-Return> "${ns}::DestroyTclLogo $t $ph"
        focus $t
    }
}

catch {poLog Debug "Loaded Package poTklib (Module [info script])"}
