#******************************************************************************
#
#       Copyright:      2005-2025 Paul Obermeier (obermeier@tcl3d.org)
#
#                       See the file "Tcl3D_License.txt" for information on
#                       usage and redistribution of this file, and for a
#                       DISCLAIMER OF ALL WARRANTIES.
#
#       Module:         Tcl3D -> demos
#       Filename:       Makefile
#
#       Author:         Paul Obermeier
#
#       Description:    Script to present the Tcl3D demos.
#
#******************************************************************************

package require Img
package require tcl3d

# Window size.
set gPres(winWidth)  1200
set gPres(winHeight)  900

set gPres(dirList)  [list]
set gPres(fileList) [list]
set gPres(skipList) [list]
set gPres(skipMachine) ""

# Display mode.
set gPres(fullscreen) false

# Automatic mode.
set gPres(auto)       false
set gPres(screenshot) false
set gPres(type)       "Window"
set gPres(waitMs)     1000
set gPres(mode)       "Safe"

array set gPresInfoList {
    num   4
    0,str "Tcl3D intro" \
    0,cmd "PresIntro" \
    1,str "Tcl3D packages" \
    1,cmd "PresPkgInfo" \
    2,str "OpenGL information" \
    2,cmd "PresGLInfo" \
    3,str "OpenGL extensions" \
    3,cmd "PresGLExtInfo" \
}

# Determine the directory of this script.
set gPres(scriptDir) [file dirname [info script]]

proc PrintUsage { progName { msg "" } } {
    global gPres

    puts ""
    if { $msg ne "" } {
        puts "Error: $msg"
    }
    puts ""
    puts "Usage: $progName \[Options\] \[Directory\]"
    puts ""
    puts "Run the presentation framework for specified directories."
    puts "If no directory name is specified, all directories are used."
    puts "The framework is started in interactive mode by default."
    puts ""
    puts "General options:"
    puts "  --help        : Display this usage message and exit."
    puts "  --fullscreen  : Make window fullscreen. Default: No."
    puts "  --size <x> <y>: Window size in pixels. Default: $gPres(winWidth) x $gPres(winHeight)."
    puts "  --skip <mach> : Skip demos for specified machine."
    puts ""
    puts "Automatic mode options:"
    puts "  --auto      : Run the demo programs in automatic mode. Default: No."
    puts "  --screenshot: Create screenshot of every demo. Default: No."
    puts "  --type      : Specify screenshot type. Default: Window."
    puts "                Available types: Window, Widget, Togl."
    puts "  --wait <sec>: Wait sec seconds before starting next demo. Default: 1."
    puts "  --mode <str>: Run demos in specified OpenGL execution mode. Default: Safe."
    puts "                Available modes: Normal, Safe, Debug."
    puts ""
}

proc Skip { demoFile args } {
    global gPres

    if { [llength $args] == 0 } {
        lappend gPres(skipList) $demoFile
    }
    foreach machine $args {
        if { [string equal -nocase $machine "all"] || \
             [string equal -nocase $machine $gPres(skipMachine)] } {
            lappend gPres(skipList) $demoFile
        }
    }
}

set curArg 0
while { $curArg < $argc } {
    set curParam [lindex $argv $curArg]
    if { [string compare -length 1 $curParam "-"]  == 0 || \
         [string compare -length 2 $curParam "--"] == 0 } {
        set curOpt [string tolower [string trimleft $curParam "-"]]
        if { $curOpt eq "auto" } {
            set gPres(auto) true
        } elseif { $curOpt eq "screenshot" } {
            set gPres(screenshot) true
        } elseif { $curOpt eq "type" } {
            incr curArg
            set type [string totitle [lindex $argv $curArg]]
            if { $type eq "Window" || $type eq "Widget" || $type eq "Togl" } {
                set gPres(type) $type
            } else {
                PrintUsage $argv0 "Invalid screenshot type \"$type\" specified."
                exit 1
            }
        } elseif { $curOpt eq "wait" } {
            incr curArg
            set waitSec [lindex $argv $curArg]
            if { $waitSec < 0 } {
                set waitSec 0
            }
            set gPres(waitMs) [expr { int($waitSec * 1000.0) }]
        } elseif { $curOpt eq "mode" } {
            incr curArg
            set mode [string totitle [lindex $argv $curArg]]
            if { $mode eq "Normal" || $mode eq "Safe" || $mode eq "Debug" } {
                set gPres(mode) $mode
            } else {
                PrintUsage $argv0 "Invalid mode \"$mode\" specified."
                exit 1
            }
        } elseif { $curOpt eq "fullscreen" } {
            set gPres(fullscreen) true
        } elseif { $curOpt eq "size" } {
            incr curArg
            set winWidth [lindex $argv $curArg]
            incr curArg
            set winHeight [lindex $argv $curArg]
            if { $winWidth < 300 || $winHeight < 300 } {
                PrintUsage $argv0 "Window size must be greater than 300 pixel."
                exit 1
            } else {
                set gPres(winWidth)  $winWidth
                set gPres(winHeight) $winHeight
            }
        } elseif { $curOpt eq "skip" } {
            incr curArg
            set gPres(skipMachine) [lindex $argv $curArg]
        } elseif { $curOpt eq "help" } {
            PrintUsage $argv0
            exit 1
        }
    } else {
        set dirOrFileName [lindex $argv $curArg]
        if { [file isdirectory $dirOrFileName] } {
            lappend gPres(dirList) [file normalize $dirOrFileName]
        } elseif { [file isfile $dirOrFileName] } {
            lappend gPres(fileList) [file normalize $dirOrFileName]
        }
    }
    incr curArg
}

# Read the skip file presentation.skip.
set skipFile [tcl3dGetExtFile [file join $gPres(scriptDir) "presentation.skip"]]
if { ! [file exists $skipFile] } {
    PrintUsage $argv0 "Skip file \"$skipFile\" not existent."
    exit 1
}
source $skipFile
set gPres(skipList) [lsort -unique $gPres(skipList)]

if { [llength $gPres(dirList)] == 0 && [llength $gPres(fileList)] == 0 } {
    foreach dir [lsort -dictionary [glob -nocomplain -dir [pwd] -types d *]] {
        lappend gPres(dirList) [file normalize $dir]
    }
}

proc bmpData:exit {} {
return {
#define exit_width 16
#define exit_height 16
static unsigned char exit_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x18, 0x18, 0x30, 0x0c, 0x60, 0x06,
   0xc0, 0x03, 0x80, 0x01, 0xc0, 0x03, 0x60, 0x06, 0x30, 0x0c, 0x18, 0x18,
   0x0c, 0x30, 0x04, 0x20, 0x00, 0x00, 0x00, 0x00};
}
}
set gPres(bmps,exit) [image create bitmap -data [bmpData:exit]]

proc bmpData:info {} {
return {
#define info_width 16
#define info_height 16
static unsigned char info_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00,
   0xc0, 0x03, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
   0x80, 0x01, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x00};
}
}
set gPres(bmps,info) [image create bitmap -data [bmpData:info]]

proc bmpData:full {} {
return {
#define full_width 16
#define full_height 16
static char full_bits[] = {
  0x00, 0x00, 0xfe, 0x7f, 0xfe, 0x7f, 0xfe, 0x7f, 0xfe, 0x7f, 0x06, 0x60,
  0x06, 0x60, 0x06, 0x60, 0x06, 0x60, 0x06, 0x60, 0x06, 0x60, 0x06, 0x60,
  0x06, 0x60, 0x06, 0x60, 0xfe, 0x7f, 0xfe, 0x7f};
}
}
set gPres(bmps,full) [image create bitmap -data [bmpData:full]]

proc bmpData:help {} {
return {
#define questionmark_width 16
#define questionmark_height 16
static char questionmark_bits[] = {
  0x80, 0x01, 0x40, 0x02, 0x20, 0x04, 0x00, 0x04, 0x00, 0x04, 0x00, 0x02,
  0x80, 0x01, 0x40, 0x00, 0x20, 0x00, 0x20, 0x00, 0x20, 0x04, 0x40, 0x02,
  0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x80, 0x01};
}
}
set gPres(bmps,help) [image create bitmap -data [bmpData:help]]

proc bmpData:demo {} {
return {
#define demo_width 16
#define demo_height 16
static unsigned char demo_bits[] = {
   0xfe, 0x0f, 0x02, 0x18, 0x02, 0x28, 0x02, 0x78, 0x02, 0x40, 0x02, 0x40,
   0x02, 0x40, 0x02, 0x40, 0xe2, 0x47, 0x02, 0x40, 0xe2, 0x47, 0x02, 0x40,
   0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00};
}
}
set gPres(bmps,demo) [image create bitmap -data [bmpData:demo]]

rename ::exit ::presentationExit
if { $gPres(auto) == false } {
    proc ::exit { { status 0 } } {
        StopRunningAnimation
        set answer [tk_messageBox -icon question -type yesno \
                                  -title "Exit confirmation" \
                                  -message "Do you want to quit the presentation?"]
        if { $answer eq "yes" } {
            ::presentationExit
        }
        set ::gExit 0
    }
} else {
    proc ::exit { { status 0 } } {
        StopRunningAnimation
    }

    rename ::tk_messageBox ::presentationMessageBox
    proc ::tk_messageBox { args } {
        set missing false
        foreach { key value } $args {
            if { $key eq "-title" } {
                if { [string match "Missing*" $value] } {
                    set missing true
                }
            } elseif { $key eq "-message" } {
                if { $missing } {
                    puts "  Warning: $value"
                }
            }
        }
    }

    rename ::tcl3dConsoleCreate ::dummyConsole
    proc ::tcl3dConsoleCreate { args } {
    }
}

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc LoadFileIntoTextWidget { w fileName } {
    set retVal [catch {open $fileName r} fp]
    if { $retVal != 0 } {
        error "Could not open file $fileName for reading."
    }
    $w delete 1.0 end
    while { ![eof $fp] } {
        $w insert end [read $fp 2048]
    }
    close $fp
}

proc TextWidgetToFile { w fileName } {
    set fileTypes {
            {"Tcl files" ".tcl"}
            {"All files" "*"} }

    set dumpDir [file dirname $fileName]
    set dumpFile [file tail $fileName]
    set saveName [tk_getSaveFile -filetypes $fileTypes \
                          -initialfile $dumpFile -initialdir $dumpDir \
                          -title "Save Tcl script to file system"]
    if { $saveName != "" } {
        set retVal [catch {open $saveName w} fp]
        if { $retVal != 0 } {
            error "Could not open file $saveName for writing."
        }
        puts -nonewline $fp [$w get 1.0 end]
        close $fp
    }
}

proc AddMenuCmd { menu label acc cmd } {
    $menu add command -label $label -accelerator $acc -command $cmd
}

proc ShowEditor { fileName } {
    global gPres

    # Font to be used in the text widget.
    set textFont {-family {Courier} -size 10}

    if { ! [info exists gPres(editCount)] } {
        set gPres(editCount) 0
    } else {
        incr gPres(editCount)
    }

    set titleStr "Tcl3D script: [file tail $fileName]"
    set tw ".poTextEdit_$gPres(editCount)"

    toplevel $tw
    wm title $tw $titleStr
    ttk::frame $tw.workfr -relief sunken -borderwidth 1
    pack  $tw.workfr -side top -fill both -expand 1

    set hMenu $tw.menufr
    menu $hMenu -borderwidth 2 -relief sunken
    $hMenu add cascade -menu $hMenu.file -label File -underline 0

    set textId [tcl3dCreateScrolledText $tw.workfr "$fileName" -font $textFont]

    set fileMenu $hMenu.file
    menu $fileMenu -tearoff 0
    AddMenuCmd $fileMenu "Save as ..." "Ctrl+S" "TextWidgetToFile $textId [list $fileName]"
    AddMenuCmd $fileMenu "Close" "Ctrl+W" "destroy $tw"

    bind $tw <Control-s> "TextWidgetToFile $textId [list $fileName]"
    bind $tw <Control-w> "destroy $tw"
    bind $tw <Escape>    "destroy $tw"
    wm protocol $tw WM_DELETE_WINDOW "destroy $tw"

    $tw configure -menu $hMenu 

    LoadFileIntoTextWidget $textId $fileName
    $textId configure -state disabled -cursor top_left_arrow
    focus $tw
}

proc OpenContextMenu { lb x y } {
    global gPres

    StopRunningAnimation
    set w .poContextMenu
    catch { destroy $w }
    menu $w -tearoff false -disabledforeground white

    set noSel [llength [$lb curselection]]
    if { $noSel != 0 } {
        set curInd [lindex [$lb curselection] 0]
        set fileName [$lb get $curInd]
        set filePath $gPres(demoDir,$curInd)
        set fullName [file join $filePath $fileName]
        if { $::tcl_platform(platform) eq "windows" || \
             $::tcl_platform(platform) eq "unix" } {
            $w add command -label "ScreenShot (Window -> File)" \
                           -command "ScreenShot Window [list $fullName]"
        }
        $w add command -label "ScreenShot (Widgets -> File)" \
                       -command "ScreenShot Widget [list $fullName]"
        $w add command -label "ScreenShot (Togl -> File)" \
                       -command "ScreenShot Togl [list $fullName]"
        if { [string compare $::tcl_platform(platform) "windows"] == 0 } {
            $w add command -label "ScreenShot (Window -> Clipboard)" \
                           -command "ScreenShot Window"
            $w add command -label "ScreenShot (Widgets -> Clipboard)" \
                           -command "ScreenShot Widget"
            $w add command -label "ScreenShot (Togl -> Clipboard)" \
                           -command "ScreenShot Togl"
        }
        $w add separator
        $w add command -label "View script" \
                       -command "ShowEditor [list $fullName]"
    } else {
        set menuTitle "Nothing selected"
        $w add command -label "$menuTitle" -state disabled -background "#303030"
    }
    tk_popup $w $x $y
}

proc StopRunningAnimation {} {
    if { [info commands "StopAnimation"] eq "StopAnimation" } {
        StopAnimation
    }
}

proc KillRunningAnimation {} {
    StopRunningAnimation

    set evList [after info]
    foreach ev $evList {
        if { [string match "after*" $ev] } {
            after cancel $ev
        }
    }
    if { [info commands "Cleanup"] eq "Cleanup" } {
        Cleanup
    }
    catch { unset ::gDemo) }
}

proc TryToStartAnimation { name } {
    global gPres

    AddMenuBindings
    if { $name eq "" } {
        set msgStr "inline script"
    } else {
        set msgStr [file tail $name]
    }
    if { $gPres(auto) == false } {
        puts ""
        puts "Available bindings for $msgStr"
        PrintBindings .
        PrintBindings $gPres(toglwin)
    }
    if { [info commands "StartAnimation"] eq "StartAnimation" } {
        # Before starting the new script via the StartAnimation command,
        # check, if there are any left-over events (typically after idles),
        # and wait until they are finished.
        set evList [after info]
        set afterRunning false
        foreach ev $evList {
            if { [string match "after*" $ev] } {
                set afterRunning true
                break
            }
        }
        if { ! $afterRunning } {
            if { $gPres(auto) == true } {
                after $gPres(waitMs) "event generate .fr <Key-Escape>"
            }
            StartAnimation
        }
    } else {
        proc StartAnimation {} {
        }
    }
}

proc AddMenuBindings {} {
    global gPres

    set frBttn $gPres(widList,frBttn)
    bind . <Shift-Key-F1>     "$frBttn.info invoke"
    bind . <Shift-Key-F2>     "$frBttn.help invoke"
    bind . <Shift-Key-F3>     "$frBttn.demo invoke"
    bind . <Shift-Key-F4>     "$frBttn.full invoke"
    bind . <Shift-Key-F5>     "$frBttn.exit invoke"
    bind . <Key-Escape> "$frBttn.exit invoke"
}

proc DeleteBindings { w } {
    if { [winfo exists $w] } {
        foreach b [bind $w] {
            bind $w $b ""
        }
    }
}

proc PrintBindings { w } {
    if { [winfo exists $w] } {
        foreach b [lsort [bind $w]] {
            puts "$w $b: [bind $w $b]"
        }
    }
}

proc DeleteAnimationCmds {} {
    global gPres

    if { [info commands "StartAnimation"] eq "StartAnimation" } {
        rename ::StartAnimation {}
    }
    if { [info commands "StopAnimation"] eq "StopAnimation" } {
        rename ::StopAnimation {}
    }
    if { [info commands "Cleanup"] eq "Cleanup" } {
        rename ::Cleanup {}
    }
    # Get all bindings and delete them to avoid unwanted actions.
    DeleteBindings .
    DeleteBindings $gPres(toglwin)
}

proc PresIntro {} {
    lappend retVal "title \"Tcl3D intro\""

    lappend retVal "speed 1"
    lappend retVal "angle -50"
    lappend retVal "align center"

    lappend retVal "color 0.9 0.4 0.4"
    lappend retVal "line \"Tcl3D\""
    lappend retVal "line \"Doing 3D with Tcl\""
    lappend retVal "line \"\""

    lappend retVal "color 0.8 0.8 0.8"
    lappend retVal "line \"is brought to you by\""
    lappend retVal "line \"Paul Obermeier\""
    lappend retVal "line \"\""

    lappend retVal "color 0.0 0.8 0.0"
    lappend retVal "line \"Get it from\""
    lappend retVal "line \"www.tcl3d.org\""
    return [join $retVal "\n"]
}

proc PresPkgInfo {} {
    lappend retVal "title \"Tcl3D packages\""
    lappend retVal "fonttype 2d"
    lappend retVal "speed 1.5"
    lappend retVal "angle 0"
    lappend retVal "color 0.8 0.8 0.8"
    lappend retVal "align center"
    lappend retVal "Loaded Tcl3D packages"
    lappend retVal "using [expr $::tcl_platform(pointerSize) * 8]-bit"
    lappend retVal "Tcl [info patchlevel] / Tk $::tk_patchLevel"
    lappend retVal ""
    lappend retVal "align left"
    lappend retVal "color 0.2 0.8 0.2"
    set vers [package versions tcl3d]
    set msgStr "tcl3d: $vers"
    lappend retVal $msgStr

    foreach pkgInfo [tcl3dGetPackageInfo] {
        set pkg    [lindex $pkgInfo 0]
        set avail  [lindex $pkgInfo 1]
        set pkgVer [lindex $pkgInfo 2]
        set libVer [lindex $pkgInfo 3]
        if { ! $avail } {
            set pkgVer "Not available"
        }
        if { $libVer ne "" && $avail } {
            set msgStr "$pkg: $pkgVer ($libVer)"
        } else {
            set msgStr "$pkg: $pkgVer"
        }
        if { $avail } {
            lappend retVal "color 0.0 1.0 0.0"
        } else {
            lappend retVal "color 1.0 0.0 0.0"
        }
        lappend retVal $msgStr
    }
    return [join $retVal "\n"]
}

proc PresGLInfo {} {
    global gPres

    lappend retVal "title \"OpenGL information\""
    lappend retVal "fonttype 2d"
    lappend retVal "speed 1.0"
    lappend retVal "angle 0"
    lappend retVal "color 0.8 0.8 0.8"
    lappend retVal "align center"
    lappend retVal "Information about the OpenGL driver"
    lappend retVal ""
    lappend retVal "align left"
    lappend retVal "color 0.2 0.8 0.2"
    foreach glInfo [tcl3dOglGetVersions $gPres(toglwin)] {
        set msgStr "[lindex $glInfo 0]: [lindex $glInfo 1]"
        lappend retVal $msgStr
    }
    return [join $retVal "\n"]
}

proc PresGLExtInfo {} {
    global gPres

    set extList [lsort -dictionary -unique [tcl3dOglGetExtensions $gPres(toglwin) "all"]]
    set numExt [llength $extList]

    lappend retVal "title \"OpenGL extensions\""
    lappend retVal "fonttype 2d"
    lappend retVal "speed 2.0"
    lappend retVal "angle 0"
    lappend retVal "align center"
    if { $numExt == 0 } {
        lappend retVal "color 1.0 0.0 0.0"
        lappend retVal "No OpenGL extensions available"
    } else {
        lappend retVal "color 0.8 0.8 0.8"
        lappend retVal "$numExt OpenGL extensions available"
        lappend retVal ""
        lappend retVal "align left"

        set r 0.5
        foreach ext $extList {
            lappend retVal "color $r 1.0 $r"
            lappend retVal $ext
            set r [expr $r - 0.05]
            if { $r < 0.0 } {
                set r 0.5
            }
        }
    }
    return [join $retVal "\n"]
}

proc ShowInfoList {} {
    global gPres gPresInfoList

    if { ! [info exists gPres(widList,lbInfo)] || \
         ! [winfo exists $gPres(widList,lbInfo)] } {
        catch { destroy $gPres(widList,varFrame) }
        ttk::frame $gPres(widList,varFrame)
        pack $gPres(widList,varFrame) -side top -anchor w -fill x
        set gPres(widList,lbInfo) [ttk::labelframe $gPres(widList,varFrame).frInf \
                              -text "Information"]
        pack $gPres(widList,varFrame).frInf -expand 1 -fill both -side top \
             -padx 3 -pady 5 -ipadx 2 -ipady 2
        for { set i 0 } { $i < $gPresInfoList(num) } { incr i } {
            ttk::radiobutton $gPres(widList,lbInfo).rb$i \
                        -value $i -style Toolbutton \
                        -text $gPresInfoList($i,str) \
                        -command "ShowInfoByInd $i"
            pack $gPres(widList,lbInfo).rb$i -expand 1 -fill x \
                 -side top -anchor w
        }
    }
    $gPres(widList,lbInfo).rb0 invoke
}

proc ShowInfoByInd { ind } {
    global gPres gPresInfoList

    set cmdName $gPresInfoList($ind,cmd)
    ShowText "" [$cmdName]
}

proc ShowText { msgFile msgStr } {
    global gPres

    KillRunningAnimation
    DeleteAnimationCmds
    destroy .fr
    uplevel #0 source [list [file join $gPres(toolDir) "textdisplay.tcl"]]
    if { $msgStr ne "" } {
        uplevel #0 EvalMsgStr [list $msgStr]
    }
    if { $msgFile ne "" } {
        uplevel #0 EvalMsgFile [list [file join $gPres(toolDir) $msgFile]]
    }

    TryToStartAnimation $msgFile
}

proc ShowDemoList { { rootDir "" } } {
    global gPres

    if { ! [info exists gPres(widList,lbDemoDirs)] || \
         ! [winfo exists $gPres(widList,lbDemoDirs)] } {
        catch { destroy $gPres(widList,varFrame) }
        ttk::frame $gPres(widList,varFrame)
        pack $gPres(widList,varFrame) -side top -anchor w -fill x
        ttk::frame $gPres(widList,varFrame).frLb1
        ttk::frame $gPres(widList,varFrame).frLb2
        pack $gPres(widList,varFrame).frLb1 $gPres(widList,varFrame).frLb2 \
             -expand 1 -fill both -side top
        set gPres(widList,lbDemoLabel) [ttk::label $gPres(widList,varFrame).frLb1.l]
        set gPres(widList,lbDemoDirs) [listbox $gPres(widList,varFrame).frLb1.lb \
                              -height 5 -selectmode browse \
                              -highlightcolor green -highlightthickness 2]
        pack $gPres(widList,lbDemoLabel) $gPres(widList,lbDemoDirs) \
             -side top -expand 1 -fill both
        set gPres(widList,lbDemoFiles) [tcl3dCreateScrolledListbox \
                $gPres(widList,varFrame).frLb2 "Demo scripts" \
                -height 20 -selectmode browse \
                -highlightcolor green -highlightthickness 2]

        bind $gPres(widList,lbDemoFiles) <<LeftMouseRelease>> "ShowDemoByListbox"
        bind $gPres(widList,lbDemoDirs)  <<LeftMouseRelease>> "ShowDemoList Sel"
        bind $gPres(widList,lbDemoFiles) <Key-space> "ShowDemoByListbox"
        bind $gPres(widList,lbDemoDirs)  <Key-space> "ShowDemoList Sel"
        bind $gPres(widList,lbDemoFiles) <<RightMousePress>> \
                                {OpenContextMenu [winfo containing %X %Y] %X %Y}
    }
    if { $rootDir eq "" } {
        set rootDir $gPres(toolDir)
        set addParent false
    } else {
        set curSel [$gPres(widList,lbDemoDirs) curselection]
        if { [llength $curSel] == 0 } {
            return
        } else {
            set curInd [lindex $curSel 0]
        }
        set curDir [$gPres(widList,lbDemoDirs) get $curInd]
        set rootDir [file normalize [file join $gPres(curDemoDir) $curDir]]
        if { $rootDir eq [file normalize $gPres(toolDir)] } {
            set addParent false
        } else {
            set addParent true
        }
    }
    $gPres(widList,lbDemoDirs)  delete 0 end
    $gPres(widList,lbDemoFiles) delete 0 end
    set gPres(curDemoDir) $rootDir
    if { $addParent } {
        $gPres(widList,lbDemoDirs) insert end ".."
    }
    set dirCont [lsort -dictionary [glob -nocomplain -dir $rootDir *]]
    # First check, if a file named "leaf" exists in current directory.
    # If yes, then we don't show sub-directories in the directory listing,
    # but display the script files of theses sub-directories directly in the 
    # file listing. This behaviour has been implemented to keep the structure
    # of existing demo tutorials (ex. NeHe's), but avoid having the user to
    # click the directory structure up and down.
    set curFile 0
    set curDir  0
    set isLeaf false
    foreach f $dirCont {
        set sf [file tail $f]
        if { $sf eq "leaf" } {
            set isLeaf true
            break
        }
    }
    foreach f $dirCont {
        set sf [file tail $f]
        if { [file isdirectory $f] } {
            if { $isLeaf } {
                set dirCont [lsort -dictionary [glob -nocomplain -dir $f *.tcl]]
                foreach subFile $dirCont {
                    set shortSubFile [file tail $subFile]
                    $gPres(widList,lbDemoFiles) insert end $shortSubFile
                    set gPres(demoDir,$curFile) $f
                    incr curFile
                }
            } else {
                if { ! [string equal -nocase "CVS" [file tail $f]] } {
                    $gPres(widList,lbDemoDirs) insert end $sf
                    incr curDir
                }
            }
        } elseif { [string match "*.tcl" $f] && $addParent } {
            # Show all Tcl scripts in the file listbox, except the scripts at 
            # the top level, which are responsible for the presentation itself.
            $gPres(widList,lbDemoFiles) insert end $sf
            set gPres(demoDir,$curFile) [file dirname $f]
            incr curFile
        }
    }
    if { $addParent } {
        set msgStr [file tail $rootDir]
        incr curDir
    } else {
        set msgStr "Categories"
    }
    $gPres(widList,lbDemoLabel) configure -text $msgStr
    $gPres(widList,lbDemoDirs) configure -height $curDir
}

proc ShowDemoByListbox {} {
    global gPres

    set curSel [$gPres(widList,lbDemoFiles) curselection]
    if { [llength $curSel] == 0 } {
        return
    }
    set curInd [lindex $curSel 0]
    set fileName [$gPres(widList,lbDemoFiles) get $curInd]
    set filePath $gPres(demoDir,$curInd)
    ShowDemo $fileName $filePath
}

proc ShowDemo { demoFile demoPath } {
    global gPres

    KillRunningAnimation
    DeleteAnimationCmds
    destroy .fr
    catch { destroy .tcl3dOutputConsole }
    uplevel #0 source [list [file join $demoPath $demoFile]]

    TryToStartAnimation $demoFile
}

proc ShowPoSoftLogo {} {
    StopRunningAnimation
    tcl3dLogoShowPoSoft "Tcl3D Version 1.0.2" \
        "Copyright 2005-2025 Paul Obermeier" ""
}

proc ShowTclLogo {} {
    StopRunningAnimation
    tcl3dLogoShowTcl Tcl Tk Img
}

proc ShowHelpList {} {
    global gPres

    if { ! [info exists gPres(widList,lbHelp)] || \
         ! [winfo exists $gPres(widList,lbHelp)] } {
        catch { destroy $gPres(widList,varFrame) }
        ttk::frame $gPres(widList,varFrame)
        pack $gPres(widList,varFrame) -side top -anchor w -fill x

        ttk::labelframe $gPres(widList,varFrame).frHelp -text "Help"
        pack $gPres(widList,varFrame).frHelp -expand 1 -fill both -side top \
             -padx 3 -pady 5 -ipadx 2 -ipady 2
        ttk::button $gPres(widList,varFrame).frHelp.b1 \
               -text "About Tcl3D" -command "ShowPoSoftLogo"
        ttk::button $gPres(widList,varFrame).frHelp.b2 \
               -text "About Tcl" -command "ShowTclLogo"
        pack $gPres(widList,varFrame).frHelp.b1 \
             $gPres(widList,varFrame).frHelp.b2 \
             -expand 1 -fill x -side top -anchor w

        set gPres(widList,lbHelp) [ttk::labelframe $gPres(widList,varFrame).frDocu \
                              -text "Documentation"]
        pack $gPres(widList,lbHelp) -expand 1 -fill both -side top \
             -padx 3 -pady 5 -ipadx 2 -ipady 2
        set dirCont [lsort -dictionary [glob -nocomplain -dir $gPres(toolDir) *.txt]]
        set i 0
        foreach f $dirCont {
            set sf [file rootname [file tail $f]]
            ttk::radiobutton $gPres(widList,lbHelp).rb$i \
                        -value $i -style Toolbutton \
                        -text $sf -command "ShowHelpByName [list $f]"
            pack $gPres(widList,lbHelp).rb$i -expand 1 -fill x \
                 -side top -anchor w
            incr i
        }
    }
    $gPres(widList,lbHelp).rb0 invoke
}

proc ShowHelpByName { fileName } {
    global gPres

    set filePath [file join $gPres(toolDir) $fileName]
    lappend retVal "title \"Tcl3D help: [file rootname [file tail $fileName]]\""
    lappend retVal "fonttype tex"
    lappend retVal "speed 1.0"
    lappend retVal "angle 0"
    lappend retVal "color 1 1 1"
    lappend retVal "align left"
    ShowText $filePath [join $retVal "\n"]
}

proc SetFullScreenMode { win } {
    set sh [winfo screenheight $win]
    set sw [winfo screenwidth  $win]

    wm minsize $win $sw $sh
    wm maxsize $win $sw $sh
    set fmtStr [format "%dx%d+0+0" $sw $sh]
    wm geometry $win $fmtStr
    wm overrideredirect $win 1
    focus -force $win
}

proc SetWindowMode { win w h } {
    set sh [winfo screenheight $win]
    set sw [winfo screenwidth  $win]

    wm minsize $win 10 10
    wm maxsize $win $sw $sh
    set fmtStr [format "%dx%d+0+25" $w $h]
    wm geometry $win $fmtStr
    wm overrideredirect $win 0
    focus -force $win
}

# Toggle between windowing and fullscreen mode.
proc ToggleWindowMode {} {
    global gPres

    StopRunningAnimation
    if { $gPres(fullscreen) } {
        SetFullScreenMode .
        set gPres(fullscreen) false
    } else {
        SetWindowMode . $gPres(winWidth) $gPres(winHeight)
        set gPres(fullscreen) true
    }
}

# 3 dummy callback functions for first instantiation of Togl widget.
proc CreateCallback { toglwin } {
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
}

proc DisplayCallback { toglwin } {
}

proc FindToglWindow { winList } {
    global gToglWin

    if { $gToglWin ne "" } {
        return
    }
    foreach win $winList {
        if { [winfo class $win] eq "Togl" } {
            set gToglWin $win
            return
        } else {
            if { [llength [winfo children $win]] > 0 } {
                FindToglWindow [winfo children $win]
            }
        }
    }
}

proc ScreenShot { type { fileName "" } } {
    global gPres
    global gToglWin

    . configure -cursor watch
    update
    if { $type eq "Togl" } {
        # Find first Togl window in hierachy.
        set gToglWin ""
        FindToglWindow [winfo children .]
    }
    if { $fileName ne "" } {
        # Create a name on the file system, if running from within a Starpack.
        set fileName [tcl3dGenExtName $fileName]
        set imgName [file rootname $fileName]
        set imgExt ".jpg"
        set imgFmt "JPEG"
        set imgOpt "-quality 95"
        set haveScreenShot true
        append imgName $imgExt
        if { $type eq "Window" } {
            after 300
            tcl3dWindow2File $imgName $imgFmt $imgOpt
        } elseif { $type eq "Widget" } {
            tcl3dWidget2File . $imgName "*Console*" $imgFmt $imgOpt
        } elseif { $type eq "Togl" } {
            if { $gToglWin ne "" } {
                tcl3dWidget2File $gToglWin $imgName "" $imgFmt $imgOpt
            } else {
                set haveScreenShot false
                puts "No screenshot due to missing Togl window"
            }
        }
        if { $haveScreenShot } {
            puts "Screenshot of $type written to: $imgName"
        }
    } else {
        # Put the screenshot into the clipboard.
        if { $type eq "Window" } {
            after 300
            tcl3dWindow2Clipboard
        } else {
            if { $type eq "Widget" } {
                set phImg [tcl3dWidget2Img . "*Console*"]
            } elseif { $type eq "Togl" } {
                if { $gToglWin ne "" } {
                    set phImg [tcl3dWidget2Img $gToglWin]
                }
            }
            if { [info exists phImg] } {
                tcl3dImg2Clipboard $phImg
                image delete $phImg
            }
        }
    }
    . configure -cursor top_left_arrow
}

proc ExitProg {} {
    exit    
}

# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
    global gPres

    wm title . "Tcl3D Presentation"

    set frTogl [ttk::frame .fr -relief sunken -borderwidth 2]
    set frMenu [ttk::frame .frMenu]
    pack $frTogl -side left
    pack $frMenu -side left -fill y
    set frBttn [ttk::frame $frMenu.frPresBttn]
    set frMode [ttk::frame $frMenu.frModeBttn]
    set gPres(widList,frBttn) $frBttn
    set gPres(widList,varFrame) [ttk::frame $frMenu.frPresList]
    pack $frBttn $frMode -side top -anchor w -fill x
    pack $gPres(widList,varFrame) -side top -anchor w -fill x

    ttk::radiobutton $frBttn.info -image $gPres(bmps,info) \
                -value info -command "ShowInfoList" \
                -variable gPres(state) -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frBttn.info "Information and installation (Shift-F1)"

    ttk::radiobutton $frBttn.help -image $gPres(bmps,help) \
                -value help -command "ShowHelpList" \
                -variable gPres(state) -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frBttn.help "Help and documentation (Shift-F2)"

    ttk::radiobutton $frBttn.demo -image $gPres(bmps,demo) \
                -value demo -command "ShowDemoList" \
                -variable gPres(state) -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frBttn.demo "Demos and tutorials (Shift-F3)"
    pack $frBttn.info $frBttn.help $frBttn.demo -side left -expand 1 -fill x

    ttk::checkbutton $frBttn.full -image $gPres(bmps,full) \
                -command ToggleWindowMode -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frBttn.full "Toggle fullscreen mode (Shift-F4)"
    ttk::checkbutton $frBttn.exit -image $gPres(bmps,exit) \
                -command ExitProg -variable gExit -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frBttn.exit "Quit Tcl3D presentation (Shift-F5)"
    pack $frBttn.full $frBttn.exit -side left -expand 1 -fill x

    ttk::radiobutton $frMode.normal -text "Normal" \
                -value Normal -command "tcl3dOglSetNormalMode" \
                -variable gPres(mode) -takefocus 0 -style Toolbutton
    tcl3dToolhelpAddBinding $frMode.normal "Set OpenGL normal execution mode"

    ttk::radiobutton $frMode.safe -text "Safe" \
                -value Safe -command "tcl3dOglSetSafeMode" \
                -variable gPres(mode) -takefocus 0 -style Toolbutton 
    tcl3dToolhelpAddBinding $frMode.safe "Set OpenGL safe execution mode"

    ttk::radiobutton $frMode.debug -text "Debug" \
                -value Debug -command "tcl3dOglSetDebugMode" \
                -variable gPres(mode) -takefocus 0 -style Toolbutton 
    tcl3dToolhelpAddBinding $frMode.debug "Set OpenGL debug execution mode"

    pack $frMode.normal $frMode.safe $frMode.debug -side left -expand 1 -fill x

    # Create Our OpenGL Window
    togl $frTogl.toglwin -width $gPres(winWidth) -height $gPres(winHeight) \
                     -double true -depth true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    pack $frTogl.toglwin -expand 1 -fill both
    set gPres(toglwin) $frTogl.toglwin

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    AddMenuBindings

    # Disable the standard arrow events of a listbox.
    # Put the default bindings for these events onto a Shift-Arrow binding.
    # This allows most demos using the arrows for moving something around,
    # being effective, but also allows us to switch between demos and categories
    # with Tab, Space and Shift-Arrow keys.
    bind Listbox <Up> ""
    bind Listbox <Shift-Up> "tk::ListboxUpDown %W -1 ; break"
    bind Listbox <Down> ""
    bind Listbox <Shift-Down> "tk::ListboxUpDown %W 1 ; break"
    bind Listbox <Left> ""
    bind Listbox <Shift-Left> "%W xview scroll -1 units ; break"
    bind Listbox <Right> ""
    bind Listbox <Shift-Right> "%W xview scroll 1 units ; break"
    bind Listbox <Home> ""
    bind Listbox <End> ""
    bind Listbox <Prior> ""
    bind Listbox <Next> ""
}


proc FindRecursive { rootDir srcDir pattern } {
    global gPres

    if { [SkipDirOrFile [file tail $srcDir]] } {
        puts "Skipping [AbsToRel $srcDir [file normalize $gPres(toolDir)]]"
        return
    }
    set cwd [pwd]
    set retVal [catch { cd $srcDir } ]
    if { $retVal } {
        error "Could not read directory \"$srcDir\""
    }
    set dirCont [tcl3dGetDirList $srcDir 1 1  0 0]
    set dirList  [lindex $dirCont 0]
    set fileList [lindex $dirCont 1]
    foreach dir [lsort -dictionary $dirList] {
        set dirName [file tail $dir]
        set subSrcDir [file join $srcDir $dirName]
        FindRecursive $rootDir $subSrcDir $pattern
    }
    foreach fileName [lsort -dictionary $fileList] {
        if { [string first "~" $fileName] == 0 } {
            # File starts with tilde.
            set fileName [format "./%s" $fileName]
        }
        set fileAbs [file join $srcDir $fileName]
        if { [string match $pattern $fileAbs] } {
            lappend gPres(fileList) $fileAbs
        }
    }
    cd $cwd
}

proc SkipDirOrFile { dirOrFile } {
    global gPres

    set skipFlag [expr [lsearch $gPres(skipList) $dirOrFile] >= 0]
    return $skipFlag
}

proc AbsToRel { fileName rootDir } {
    # Return the relative path name of fileName compared to rootDir.
    # If fileName is not contained in rootDir, the original file name 
    # is returned.
    set rootDir  [string trimright $rootDir  "/"]
    set fileName [string trimright $fileName "/"]
    set rootLen [string length $rootDir]
    set fileLen [string length $fileName]
    if { $rootLen > $fileLen } {
        return $fileName
    }
    set rootItemList [file split $rootDir]
    set fileItemList [file split $fileName]
    if { [llength $rootItemList] > [llength $fileItemList] } {
        return $fileName
    }
    set ind 0
    foreach rootItem $rootItemList {
        if { $rootItem ne [lindex $fileItemList $ind] } {
            return $fileName
        }
        incr ind
    }
    set relPath [file join {*}[lrange $fileItemList $ind end]]
    return [format "./%s" $relPath]
}

set gPres(state) "info"
tcl3dOglSetMode $gPres(mode)
tcl3dAddEvents

CreateWindow

set gPres(toolDir) [file dirname [info script]]

ToggleWindowMode
update
ShowInfoList

if { $gPres(auto) == true } {
    if { $gPres(screenshot) } {
        # Redefine the following procedures from the tcl3dOgl and tcl3dOsg
        # utilities to output a shorter message string for automatic
        # screenshot generation.
        proc tcl3dOglGetInfoString {} {
            return [format "Using Tcl3D %s on %s %s with a %s (OpenGL %s, Tk %s %d-bit)" \
               [package versions tcl3d] \
               $::tcl_platform(os) $::tcl_platform(osVersion) \
               [glGetString GL_RENDERER] \
               [glGetString GL_VERSION] $::tk_patchLevel \
               [expr $::tcl_platform(pointerSize) == 4? 32: 64]]
        }
        proc tcl3dOsgGetInfoString {} {
            return [format "Using Tcl3D %s on %s %s with a %s (OSG %s, Tk %s %d-bit)" \
                [package versions tcl3d] \
                $::tcl_platform(os) $::tcl_platform(osVersion) \
                [glGetString GL_RENDERER] [tcl3dOsgGetVersion] \
                $::tk_patchLevel [expr $::tcl_platform(pointerSize) == 4? 32: 64]]
        }
    }

    set gPres(state) "demo"
    ShowDemoList

    puts "Platform: $tcl_platform(os) $tcl_platform(osVersion)"
    puts "Tcl/Tk  : Tcl [info patchlevel] / Tk $::tk_patchLevel ([expr $::tcl_platform(pointerSize) * 8]-bit)"
    puts "Tcl3D   : [package versions tcl3d]"
    puts "Img     : [package versions Img]"
    foreach glInfo [tcl3dOglGetVersions $gPres(toglwin)] {
        puts "[lindex $glInfo 0]: [lindex $glInfo 1]"
    }
    puts "Number of extensions: [llength [lsort -unique [tcl3dOglGetExtensions $gPres(toglwin)]]]"
    puts ""
    puts ">> Do not press any key or click the mouse during automatic execution."
    puts ""

    # Clear command line arguments, as demo scripts may fail with unknown options.
    set argc 0
    set argv [list]
    foreach fileName [lsort -dictionary $gPres(fileList)] {
        set f [file tail $fileName]
        set d [file dirname $fileName]
        if { [SkipDirOrFile $f] } {
            puts "Skipping [AbsToRel $fileName [file normalize $gPres(toolDir)]]"
            continue
        }
        catch { destroy .tcl3dOutputConsole }
        puts "Running [AbsToRel $fileName [file normalize $gPres(toolDir)]]"
        ShowDemo $f $d
        update
        if { $gPres(screenshot) } {
            ScreenShot $gPres(type) [list $fileName]
        }
        after $gPres(waitMs)
    }
    foreach dir [lsort -dictionary $gPres(dirList)] {
        set gPres(fileList) [list]
        FindRecursive $dir $dir "*.tcl"

        foreach fileName [lsort -dictionary $gPres(fileList)] {
            set f [file tail $fileName]
            set d [file dirname $fileName]

            if { [SkipDirOrFile $f] } {
                puts "Skipping [AbsToRel $fileName [file normalize $gPres(toolDir)]]"
                continue
            }
            catch { destroy .tcl3dOutputConsole }
            puts "Running [AbsToRel $fileName [file normalize $gPres(toolDir)]]"
            ShowDemo $f $d
            update
            if { $gPres(screenshot) } {
                ScreenShot $gPres(type) [list $fileName]
            }
            after $gPres(waitMs)
        }
    }
    puts "Automatic execution finished."
    presentationExit 0
}
