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

package require poFti
package require Img
package require tcl3d

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

# Print info message into widget a the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc ReadFtiAsTexture { fileName } {
    set width  512
    set height 512

    set iconObj [poFti Icon new]
    $iconObj Read $fileName

    set win .fti
    toplevel $win
    wm geometry $win "+0+0"
    ttk::frame $win.fr
    pack $win.fr -expand 1 -fill both
    canvas $win.c -width $width -height $height -background "#C9C9C9"
    pack $win.c
    update
    $iconObj Draw $win.c -width $width -height $height
    set phImg [$iconObj AsPhoto $win.c]
    destroy $win
    raise .
    $iconObj destroy

    set vecImg [tcl3dVectorFromPhoto $phImg]
    image delete $phImg

    glEnable GL_TEXTURE_2D
    glPixelStorei GL_UNPACK_ALIGNMENT 1
    gluBuild2DMipmaps GL_TEXTURE_2D 4 $width $height \
                      $::GL_RGBA GL_UNSIGNED_BYTE $vecImg
    $vecImg -delete
}

# Togl widget create callback.
# This is called by Tcl/Tk when the widget has been realized.
proc CreateCallback { toglwin } {
    glEnable GL_DEPTH_TEST

    ReadFtiAsTexture $::gFtiFile

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP
    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE
}

# Togl widget reshape callback.
# This is called by Tcl/Tk when the widget has been resized.
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h
}

# Togl widget display callback.
# This is called by Tcl/Tk when the widget's contents have to be redrawn.
proc DisplayCallback { toglwin } {
    set aspect [expr double ([$toglwin width]) / double ([$toglwin height])]

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glMatrixMode GL_MODELVIEW
    glLoadIdentity

    glDisable GL_TEXTURE_2D
    glDisable GL_DEPTH_TEST
    glBegin GL_QUADS
        glColor3f 0.0 0.0 0.3
        glVertex2f -1.0 -1.0
        glColor3f 0.0 0.0 0.3
        glVertex2f 1.0 -1.0
        glColor3f 0.0 0.0 0.9
        glVertex2f 1.0 1.0
        glColor3f 0.0 0.0 0.9
        glVertex2f -1.0 1.0
    glEnd

    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glFrustum [expr -1.0 * $aspect] $aspect -1.0 1.0 2.0 10.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -3.0
    glScalef  $::gScale $::gScale $::gScale
    glRotatef $::gXangle 0.0 1.0 0.0
    glRotatef $::gYangle 1.0 0.0 0.0

    glEnable GL_DEPTH_TEST
    glEnable GL_TEXTURE_2D
    glColor4ubv [list 255 255 255 255]

    glBegin GL_QUADS
        glTexCoord2f 0.0 0.0
        glVertex2f -1.0 -1.0
        glTexCoord2f 1.0 0.0
        glVertex2f 1.0 -1.0
        glTexCoord2f 1.0 1.0
        glVertex2f 1.0 1.0
        glTexCoord2f 0.0 1.0
        glVertex2f -1.0 1.0
    glEnd

    $toglwin swapbuffers
}

proc AskOpen { toglwin } {
    set fileTypes {
        { "FTI files" *.fti }
        { "All files" * }
    }
    set imgName [tk_getOpenFile -filetypes $fileTypes \
                                -initialdir $::gLastDir]
    if { $imgName ne "" } {
        set gLastDir [file dirname $imgName]
        ReadFtiAsTexture $imgName
        $toglwin postredisplay
    }
}

proc ExitProg {} {
    exit
}

proc HelpProg {} {
    tk_messageBox -message "Simple FTI icon viewer powered by Tcl3D.\n\
                            Copyright 2026 by Paul Obermeier.\n\n\
                            https://www.tcl3d.org" \
                           -type ok -icon info -title "About $::gAppName"
    focus .
}

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

# Make the widgets
proc CreateWindows {} {
    set ::gXangle 0.0
    set ::gYangle 0.0
    set ::gScale  1.0

    wm title . "Tcl3D demo: $::gAppName"

    # Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
    frame .fr
    pack .fr -expand 1 -fill both

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

    set fileMenu $hMenu.file
    menu $fileMenu -tearoff 0

    AddMenuCmd $fileMenu "Open ..." "Ctrl+O" "AskOpen .fr.view"
    AddMenuCmd $fileMenu "Quit"     "Ctrl+Q" ExitProg
    bind . <Control-o>  "AskOpen .fr.view"
    bind . <Control-q>  ExitProg

    set helpMenu $hMenu.help
    menu $helpMenu -tearoff 0
    AddMenuCmd $helpMenu "About $::gAppName ..."  ""   HelpProg

    . configure -menu $hMenu

    togl .fr.view -width 600 -height 600 \
        -double true -depth true \
        -createcommand  CreateCallback \
        -displaycommand DisplayCallback \
        -reshapecommand ReshapeCallback
    pack .fr.view -fill both -expand true -side top

    label .fr.info
    pack .fr.info -expand false -side top

    bind .fr.view <ButtonPress-1> {
        set ::gStartx %x
        set ::gStarty %y
        set ::gXangle0 $gXangle
        set ::gYangle0 $gYangle
    }

    bind .fr.view <B1-Motion> {
        set ::gXangle [expr $gXangle0 + (%x - $gStartx) / 3.0 ]
        set ::gYangle [expr $gYangle0 + (%y - $gStarty) / 3.0 ]
        .fr.view postredisplay
    }

    bind .fr.view <ButtonPress-2> {
        set ::gStartx %x
        set ::gStarty %y
        set ::gScale0 $gScale
    }

    bind .fr.view <B2-Motion> {
        set q [ expr ($::gStarty - %y) / 400.0 ]
        set ::gScale [expr $gScale0 * exp($q)]
        .fr.view postredisplay
    }
    bind . <Key-Escape> ExitProg
}

set ::gAppName "FTI 3D Viewer"

if { $argc == 0 } {
    set ::gFtiFile "../examples/accessx.fti"
} else {
    set ::gFtiFile [lindex $argv 0]
}
set gLastDir [file dirname $::gFtiFile]

CreateWindows

PrintInfo [tcl3dOglGetInfoString]
