# Copyright:      2005-2024 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
# Filename:       modelViewer.tcl
#
# Author:         Paul Obermeier
#
# Description:    Tcl program to display 3D model files in all formats supported
#                 by the Tcl3D extension.

# Set next variable to 1, if you want to source this file and use a separate
# toplevel, instead of integrating into the widget hierarchy.
set gUseToplevel 0

# Enable azimuth and elevation sliders.
set gShowSliders 1

# Set next variable to 1, if your graphic supports multisampling.
set gUseMultisampling 0

# Set next variable to 1, if you want screen rectangle mode enabled.
set gUseScreenRect 0

# Enable the use of angles instead of trackball matrix.
set gPo(useAngles) 1

if { $::gUseToplevel } {
    set gRoot   .po
    set gRootFr .po.fr
} else {
    set gRoot   .
    set gRootFr .fr
}

proc InitPackages { args } {
    global gPo

    foreach pkg $args {
        set retVal [catch {package require $pkg} gPo(ext,$pkg,version)]
        set gPo(ext,$pkg,avail) [expr !$retVal]
    }
}

InitPackages Img tcl3d

set gTextureId [tcl3dVector GLuint 1]
set g_ScriptName [info script]
set g_ScriptDir  [file dirname [info script]]

proc GetPackageInfo {} {
    global gPo

    set msgList {}
    foreach name [lsort [array names gPo "ext,*,avail"]] {
        set pkg [lindex [split $name ","] 1]
        lappend msgList [list $pkg $gPo(ext,$pkg,avail) $gPo(ext,$pkg,version)]
    }
    return $msgList
}

proc poWin:CreateScrolledWidget { wType w titleStr args } {
    if { [winfo exists $w.par] } {
        destroy $w.par
    }
    frame $w.par
    if { [string compare $titleStr ""] != 0 } {
        label $w.par.label -text "$titleStr"
    }
    eval { $wType $w.par.widget \
            -xscrollcommand "$w.par.xscroll set" \
            -yscrollcommand "$w.par.yscroll set" } $args
    scrollbar $w.par.xscroll -command "$w.par.widget xview" -orient horizontal
    scrollbar $w.par.yscroll -command "$w.par.widget yview" -orient vertical
    set rowNo 0
    if { [string compare $titleStr ""] != 0 } {
        set rowNo 1
        grid $w.par.label -sticky ew -columnspan 2
    }
    grid $w.par.widget $w.par.yscroll -sticky news
    grid $w.par.xscroll               -sticky ew
    grid rowconfigure    $w.par $rowNo -weight 1
    grid columnconfigure $w.par 0      -weight 1
    pack $w.par -side top -fill both -expand 1
    return $w.par.widget
}

proc poWin:CreateScrolledText { w titleStr args } {
    return [eval {poWin:CreateScrolledWidget text $w $titleStr} $args ]
}

proc poWin:CreateScrolledListbox { w titleStr args } {
    return [eval {poWin:CreateScrolledWidget listbox $w $titleStr} $args ]
}

proc poMisc:Max { a b } {
    if { $a > $b } {
        return $a
    } else {
        return $b
    }
}

proc PkgInfo {} {
    set tw .tcl3dModelView:PkgInfoWin
    catch { destroy $tw }

    toplevel $tw
    wm title $tw "Package Information"
    wm resizable $tw true true

    frame $tw.fr0 -relief sunken -borderwidth 1
    grid  $tw.fr0 -row 0 -column 0 -sticky nwse
    set textId [poWin:CreateScrolledText $tw.fr0 "" -wrap word -height 2]

    $textId insert end "Tcl version: [info patchlevel]\n" avail
    foreach pkgInfo [GetPackageInfo] {
        set msgStr "Package [lindex $pkgInfo 0]: [lindex $pkgInfo 2]\n"
        if { [lindex $pkgInfo 1] == 1} {
            set tag avail
        } else {
            set tag unavail
        }
        $textId insert end $msgStr $tag
    }
    $textId tag configure avail   -background lightgreen
    $textId tag configure unavail -background red
    $textId configure -state disabled

    # Create OK button
    frame $tw.fr1 -relief sunken -borderwidth 1
    grid  $tw.fr1 -row 1 -column 0 -sticky nwse
    button $tw.fr1.b -text "OK" -command "destroy $tw" -default active
    bind $tw.fr1.b <KeyPress-Return> "destroy $tw"
    pack $tw.fr1.b -side left -fill x -padx 2 -expand 1

    grid columnconfigure $tw 0 -weight 1
    grid rowconfigure    $tw 0 -weight 1

    bind $tw <Escape> "destroy $tw"
    bind $tw <Return> "destroy $tw"
    focus $tw
}

proc GLInfo {} {
    global gPo

    set tw .tcl3dModelView:GLInfoWin
    catch { destroy $tw }

    toplevel $tw
    wm title $tw "OpenGL Information"
    wm resizable $tw true true

    frame $tw.fr0 -relief sunken -borderwidth 1
    grid  $tw.fr0 -row 0 -column 0 -sticky nwse
    set textId [tcl3dCreateScrolledText $tw.fr0 "" -wrap word -height 4]

    foreach glInfo [tcl3dOglGetVersions gPo(toglWin)] {
        set msgStr "[lindex $glInfo 0]: [lindex $glInfo 1]\n"
        $textId insert end $msgStr avail
    }
    $textId tag configure avail   -background lightgreen
    $textId configure -state disabled

    # Create OK button
    frame $tw.fr1 -relief sunken -borderwidth 1
    grid  $tw.fr1 -row 1 -column 0 -sticky nwse
    button $tw.fr1.b -text "OK" -command "destroy $tw" -default active
    bind $tw.fr1.b <KeyPress-Return> "destroy $tw"
    pack $tw.fr1.b -side left -fill x -padx 2 -expand 1

    grid columnconfigure $tw 0 -weight 1
    grid rowconfigure    $tw 0 -weight 1

    bind $tw <Escape> "destroy $tw"
    bind $tw <Return> "destroy $tw"
    focus $tw
}

proc ShortcutInfo {} {
    set tw .tcl3dModelView:ShortcutInfoWin
    catch { destroy $tw }

    toplevel $tw
    wm title $tw "Shortcut Information"
    wm resizable $tw true true

    frame $tw.fr0 -relief sunken -borderwidth 1
    grid  $tw.fr0 -row 0 -column 0 -sticky nwse
    set textId [poWin:CreateScrolledText $tw.fr0 "" -wrap none -height 9]
    $textId insert end "Key l: Toggle line and flat shaded drawing\n"
    $textId insert end "Key f: Toggle showing backfaces as faces or lines\n"
    if { $::gUseMultisampling } {
        $textId insert end "Key m: Toggle drawing with/without multisampling\n"
    }
    if { $::gUseScreenRect } {
        $textId insert end "Key b: Toggle drawing the enclosing screen rect\n"
    }
    $textId insert end "Key r: Reset translations and rotations\n"
    $textId insert end "\n"
    $textId insert end "LeftMouseButton         : Rotate object\n"
    $textId insert end "RightMouseButton        : Zoom in and out\n"
    $textId insert end "Ctrl + RightMouseButton : Move up and down\n"
    $textId insert end "Shift + RightMouseButton: Move left and right\n"

    $textId configure -state disabled

    # Create OK button
    frame $tw.fr1 -relief sunken -borderwidth 1
    grid  $tw.fr1 -row 1 -column 0 -sticky nwse
    button $tw.fr1.b -text "OK" -command "destroy $tw" -default active
    bind $tw.fr1.b <KeyPress-Return> "destroy $tw"
    pack $tw.fr1.b -side left -fill x -padx 2 -expand 1

    grid columnconfigure $tw 0 -weight 1
    grid rowconfigure    $tw 0 -weight 1

    bind $tw <Escape> "destroy $tw"
    bind $tw <Return> "destroy $tw"
    focus $tw
}

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

proc AddMenuCheck { menu label acc var cmd args } {
    eval {$menu add checkbutton -label $label -accelerator $acc \
                                -variable $var -command $cmd} $args
}

proc MoveStart { win x y } {
    set ::mouseX $x
    set ::mouseY $y
}

proc MoveCont { win x y axis } {
    global gPo

    set diff [expr $y - $::mouseY]
    set gPo($axis) [expr $gPo($axis) + 0.1 * $diff]
    set ::mouseX $x
    set ::mouseY $y
    $win postredisplay
}

proc MoveEnd { win x y } {
    $win postredisplay
}

proc ShowMainWin { title } {
    global tcl_platform gPo gRoot gRootFr

    if { $::gUseToplevel } {
        if { [file tail $::g_ScriptName] eq [file tail $::argv0] } {
            # If started directly from tclsh or wish, then destroy
            # default toplevel.
            wm withdraw .
        }
        toplevel $gRoot
    }

    # Create the windows title.
    wm title $gRoot $title
    wm minsize $gRoot 100 100

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

    frame $gRootFr.workfr -relief sunken -borderwidth 1
    pack $gRootFr.workfr -side top -fill both -expand 1

    frame $gRootFr.workfr.imgfr  -relief raised -borderwidth 1
    frame $gRootFr.workfr.infofr -relief sunken -borderwidth 1

    grid $gRootFr.workfr.imgfr  -row 0 -column 0 -sticky news
    grid $gRootFr.workfr.infofr -row 1 -column 0 -sticky news
    grid rowconfigure    $gRootFr.workfr 0 -weight 1
    grid columnconfigure $gRootFr.workfr 0 -weight 1

    label $gRootFr.workfr.infofr.label -text Ready -anchor w
    pack  $gRootFr.workfr.infofr.label -fill x -in $gRootFr.workfr.infofr

    frame $gRootFr.workfr.imgfr.fr
    pack  $gRootFr.workfr.imgfr.fr -expand 1 -fill both

    if { $::gUseMultisampling } {
        togl $gRootFr.workfr.imgfr.fr.toglwin \
             -width 800 -height 500 \
             -multisamplebuffers 1 -multisamplesamples 2 \
             -double true -depth true \
             -createcommand CreateCallback \
             -displaycommand DisplayCallback \
             -reshapecommand ReshapeCallback
    } else {
        togl $gRootFr.workfr.imgfr.fr.toglwin \
             -width 800 -height 500 \
             -double true -depth true \
             -createcommand CreateCallback \
             -displaycommand DisplayCallback \
             -reshapecommand ReshapeCallback
    }

    #pack  $gRootFr.workfr.imgfr.fr.toglwin -expand 1 -fill both
    grid $gRootFr.workfr.imgfr.fr.toglwin -row 0 -column 0 -stick news
    if { $::gShowSliders } {
        scale $gRootFr.workfr.imgfr.fr.azi -from -180 -to 180 \
                            -length 380 -resolution 1 \
                            -command UpdatePosition \
                            -showvalue true -orient horizontal \
                            -variable gPo(ry)
        scale $gRootFr.workfr.imgfr.fr.ele -from 180 -to -180 \
                            -length 380 -resolution 1 \
                            -command UpdatePosition \
                            -showvalue true -orient vertical \
                            -variable gPo(rx)
        grid $gRootFr.workfr.imgfr.fr.azi -row 1 -column 0 -columnspan 2 -sticky ew
        grid $gRootFr.workfr.imgfr.fr.ele -row 0 -column 1 -sticky ns
    }
    grid rowconfigure    $gRootFr.workfr.imgfr.fr 0 -weight 1
    grid columnconfigure $gRootFr.workfr.imgfr.fr 0 -weight 1

    set gPo(toglWin) $gRootFr.workfr.imgfr.fr.toglwin

    bind $gPo(toglWin) <Double-1> "AskOpenMod"

    # Create menus File, Edit, View, Settings and Help
    set hMenu $gRootFr.menufr
    menu $hMenu -borderwidth 2 -relief sunken
    $hMenu add cascade -menu $hMenu.file -label File      -underline 0
    $hMenu add cascade -menu $hMenu.edit -label Edit      -underline 0
    $hMenu add cascade -menu $hMenu.view -label View      -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" AskOpenMod
    AddMenuCmd $fileMenu "Save as ..." "Ctrl+S" AskSaveMod
    if { $::tcl_platform(os) ne "Darwin" } {
        $fileMenu add separator
        AddMenuCmd $fileMenu "Quit" "Ctrl+Q" ExitProg
    }

    bind $gRoot <Control-o>  AskOpenMod
    bind $gRoot <Control-s>  AskSaveMod
    bind $gRoot <Control-q>  ExitProg
    bind $gRoot <Escape>     ExitProg
    if { [string compare $tcl_platform(os) "windows"] == 0 } {
        bind $gRoot <Alt-F4> ExitProg
    }
    wm protocol $gRoot WM_DELETE_WINDOW "ExitProg"

    set editMenu $hMenu.edit
    menu $editMenu -tearoff 0
    AddMenuCmd $editMenu "Add texture ..."  "Ctrl+T" AskOpenTex
    $editMenu add separator
    AddMenuCmd $editMenu "Reset transformations"        "r" \
               "ResetTfms; $::gPo(toglWin) postredisplay"

    bind $gRoot <Control-t>  AskOpenTex

    set viewMenu $hMenu.view
    menu $viewMenu -tearoff 0

    AddMenuCheck $viewMenu "Use display list"           "d" \
                 ::optUseDisplayList "ToggleDisplayList 0"
    AddMenuCheck $viewMenu "View back faces as lines"   "f" \
                 ::optMarkBackFaces "ToggleBackFaceMode 0"
    AddMenuCheck $viewMenu "Line mode"                  "l" \
                 ::optLines "ToggleDrawMode 0"
    if { $::gUseMultisampling } {
        AddMenuCheck $viewMenu "Multisampling mode"         "m" \
                     ::optMultisampling "ToggleMultisampling 0"
    }
    if { $::gUseScreenRect } {
        AddMenuCheck $viewMenu "Show enclosing screen rect" "b" \
                     ::optShowBB "ToggleScreenRect 0"
    }
    AddMenuCheck $viewMenu "Lighting on/off"            "" \
                 ::optMakeLight "ToggleLighting 0"

    $viewMenu add separator
    AddMenuCmd $viewMenu "Show Euler angles"            "" \
               "ShowAngleWindow"

    set helpMenu $hMenu.help
    menu $helpMenu -tearoff 0
    AddMenuCmd $helpMenu "About $gPo(appName) ..."     ""   HelpProg
    AddMenuCmd $helpMenu "About shortcuts ..."         ""   ShortcutInfo
    AddMenuCmd $helpMenu "About packages ..."          ""   PkgInfo
    AddMenuCmd $helpMenu "About OpenGL version..."     ""   GLInfo

    $gRoot configure -menu $hMenu

    bind $gRoot <Key-d> "ToggleDisplayList"
    bind $gRoot <Key-l> "ToggleDrawMode"
    bind $gRoot <Key-f> "ToggleBackFaceMode"
    if { $::gUseMultisampling } {
        bind $gRoot <Key-m> "ToggleMultisampling"
    }
    if { $::gUseScreenRect } {
        bind $gRoot <Key-b> "ToggleScreenRect"
    }
    bind $gRoot <Key-r> "ResetTfms; $::gPo(toglWin) postredisplay"

    bind $gPo(toglWin) <ButtonPress-1>   "AngOff ; tcl3dTbStartMotion %W %x %y"
    bind $gPo(toglWin) <ButtonRelease-1> "tcl3dTbStopMotion %W"
    bind $gPo(toglWin) <B1-Motion>       "tcl3dTbMotion %W %x %y"

    if { $::tcl_platform(os) eq "Darwin" } {
        bind $gPo(toglWin) <ButtonPress-2>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <B2-Motion>       "MoveCont  %W %x %y tz"
        bind $gPo(toglWin) <ButtonRelease-2> "MoveEnd   %W %x %y"

        bind $gPo(toglWin) <Control-ButtonPress-2>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <Control-B2-Motion>       "MoveCont  %W %x %y ty"
        bind $gPo(toglWin) <Control-ButtonRelease-2> "MoveEnd   %W %x %y"

        bind $gPo(toglWin) <Shift-ButtonPress-2>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <Shift-B2-Motion>       "MoveCont  %W %x %y tx"
        bind $gPo(toglWin) <Shift-ButtonRelease-2> "MoveEnd   %W %x %y"
    } else {
        bind $gPo(toglWin) <ButtonPress-3>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <B3-Motion>       "MoveCont  %W %x %y tz"
        bind $gPo(toglWin) <ButtonRelease-3> "MoveEnd   %W %x %y"

        bind $gPo(toglWin) <Control-ButtonPress-3>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <Control-B3-Motion>       "MoveCont  %W %x %y ty"
        bind $gPo(toglWin) <Control-ButtonRelease-3> "MoveEnd   %W %x %y"

        bind $gPo(toglWin) <Shift-ButtonPress-3>   "MoveStart %W %x %y"
        bind $gPo(toglWin) <Shift-B3-Motion>       "MoveCont  %W %x %y tx"
        bind $gPo(toglWin) <Shift-ButtonRelease-3> "MoveEnd   %W %x %y"
    }
}

proc WriteInfoStr { str } {
    global gRootFr

    $gRootFr.workfr.infofr.label configure -text $str
}

proc HelpProg {} {
    global gRoot

    tk_messageBox -message "Simple model viewer powered by Tcl3D.\n\
                            Copyright 2006-2024 by Paul Obermeier.\n\n\
                            https://www.tcl3d.org" \
                           -type ok -icon info -title "$::gPo(appName)"
    focus $gRoot
}

# Trigger loading of a default model file when running from the presentation framework.
proc StartAnimation {} {
    ReadModel [file join $::g_ScriptDir "f-16.obj"]
}

proc Cleanup {} {
    foreach w [winfo children .] {
        if { [string match ".tcl3dModelView:*" $w] } {
            destroy $w
        }
    }
    if { [info exists ::objId] } {
        glmDeleteModel $::objId
        unset ::objId
    }
    uplevel #0 unset gPo
}

proc ExitProg {} {
    global gPo gRoot

    tcl3dTbStopMotion $gPo(toglWin)
    Cleanup
    if { $::gUseToplevel } {
        destroy $gRoot
    }
    if { [file tail $::g_ScriptName] eq [file tail $::argv0] } {
        # If started directly from tclsh or wish, then exit application.
        exit
    }
}

proc ReadModel { fileName } {
    global gPo gRoot

    WriteInfoStr "Reading model file $fileName ..."
    if { [info exists ::objId] } {
        glmDeleteModel $::objId
        unset ::objId
    }
    ResetTfms
    if { [file extension $fileName] eq ".sab" } {
        set ::objId [glmReadSAB $fileName]
        set gPo(curFile,type) "sab"
    } elseif { [file extension $fileName] eq ".obj" } {
        set ::objId [glmReadOBJ $fileName]
        set gPo(curFile,type) "obj"
    } elseif { [file extension $fileName] eq ".pof" } {
        set ::objId [glmReadPOF $fileName]
        set gPo(curFile,type) "pof"
    } else {
        error "Unknown file extension $fileName"
    }
    set gPo(curFile,name) $fileName
    set ::scaleFactor [glmUnitize $::objId]
    if { ! [glmHaveVertexNormals $::objId] } {
        if { ! [glmHaveFacetNormals $::objId] } {
            # puts "Creating facet normals"
            glmFacetNormals $::objId
        }
    }
    calculateObjSizes
    wm title $gRoot [format "%s (%s)" \
             $gPo(appName) [file tail $fileName]]
    $::gPo(toglWin) postredisplay
}

proc SaveModel { fileName } {
    global gPo

    if { [file extension $gPo(curFile,name)] eq ".sab" } {
        set tmpObjId [glmReadSAB $gPo(curFile,name)]
    } elseif { [file extension $gPo(curFile,name)] eq ".obj" } {
        set tmpObjId [glmReadOBJ $gPo(curFile,name)]
    } elseif { [file extension $gPo(curFile,name)] eq ".pof" } {
        set tmpObjId [glmReadPOF $gPo(curFile,name)]
    } else {
        error "Unknown file extension $gPo(curFile,name)"
    }

    if { [file extension $fileName] eq ".sab" } {
        glmWriteSAB $tmpObjId $fileName
    } elseif { [file extension $fileName] eq ".pof" } {
        glmWritePOF $tmpObjId $fileName
    } elseif { [file extension $fileName] eq ".obj" } {
        glmWriteOBJ $tmpObjId $fileName $::GLM_FLAT
    } else {
        error "Unknown file extension $fileName"
    }
    glmDeleteModel $tmpObjId
}

proc AskOpenMod {} {
    global gPo

    set fileTypes {
        { "All files"       "*" }
        { "Wavefront files" "*.obj" }
        { "SAB CAD files"   "*.sab" }
        { "POF CAD files"   "*.pof" }
    }
    set modName [tk_getOpenFile -filetypes $fileTypes \
                                -initialdir $gPo(lastDir)]
    if { $modName != "" } {
        set gPo(lastDir) [file dirname $modName]
        ReadModel $modName
    }
}

proc AskSaveMod {} {
    global gPo

    set fileTypes {
        { "All files"       "*" }
        { "Wavefront files" "*.obj" }
        { "SAB CAD files"   "*.sab" }
        { "POF CAD files"   "*.pof" }
    }
    set modName [tk_getSaveFile -filetypes $fileTypes \
                                -initialdir $gPo(lastDir)]
    if { $modName != "" } {
        set gPo(lastDir) [file dirname $modName]
        SaveModel $modName
    }
}

proc AskOpenTex {} {
    global gPo

    set fileTypes {
        { "Image files" "*.pcx *ppm *.tga *.bmp *.jpg *.rgb *.rgba" }
        { "All files"       "*" }
    }
    set texName [tk_getOpenFile -filetypes $fileTypes \
                                -initialdir $gPo(lastDir)]
    if { $texName != "" } {
        set gPo(lastDir) [file dirname $texName]
        ReadTex $texName
        set gPo(curFile,haveTex) 1
    }
}

# The Togl callback functions, when the Togl window is created,
# it's size is changed, and when the window content has to be redrawn.

proc CreateCallback { toglwin } {
    set light0_ambient  {  0.0 0.0 0.0 1.0 }
    set light0_diffuse  {  1.0 1.0 1.0 1.0 }
    set light0_specular {  1.0 1.0 1.0 1.0 }
    set light0_position { -1.0 1.0 1.0 0.0 }

    set light1_ambient  {  0.0 0.0 0.0 1.0 }
    set light1_diffuse  {  1.0 1.0 1.0 1.0 }
    set light1_specular {  1.0 1.0 1.0 1.0 }
    set light1_position {  1.0 1.0 1.0 0.0 }

    glLightfv GL_LIGHT0 GL_AMBIENT  $light0_ambient
    glLightfv GL_LIGHT0 GL_DIFFUSE  $light0_diffuse
    glLightfv GL_LIGHT0 GL_SPECULAR $light0_specular
    glLightfv GL_LIGHT0 GL_POSITION $light0_position

    glLightfv GL_LIGHT1 GL_AMBIENT  $light1_ambient
    glLightfv GL_LIGHT1 GL_DIFFUSE  $light1_diffuse
    glLightfv GL_LIGHT1 GL_SPECULAR $light1_specular
    glLightfv GL_LIGHT1 GL_POSITION $light1_position

    glEnable GL_DEPTH_TEST
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
    glEnable GL_LIGHT1

    tcl3dTbInit $toglwin
    tcl3dTbAnimate $toglwin $::GL_TRUE
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    set aspect [expr double ($w) / double ($h)]
    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective $::fov $aspect 0.1 [expr 50 * $::maxSize]
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    gluLookAt 0.0 0.0 $::dist 0.0 0.0 0.0 0.0 1.0 0.0
    tcl3dTbReshape $toglwin $w $h
}

# Write contents of one vertex to stdout.
proc print2DVertex { size } {
    # puts -nonewline "  "
    set n [$::feedbackBuffer get [expr {$size - $::count}]]
    incr ::count -1
    for { set i 0 } { $i < $n } { incr i } {
        set x [$::feedbackBuffer get [expr {$size - $::count}]]
        incr ::count -1
        set y [$::feedbackBuffer get [expr {$size - $::count}]]
        incr ::count -1

        # puts -nonewline [format "(%4.2f, %4.2f) " $x $y] 
        if { $x > $::bb(x2) } {
            set ::bb(x2) $x
        }
        if { $y > $::bb(y2) } {
            set ::bb(y2) $y
        }
        if { $x < $::bb(x1) } {
            set ::bb(x1) $x
        }
        if { $y < $::bb(y1) } {
            set ::bb(y1) $y
        }
    }
    # puts ""
}

# Write contents of entire buffer.  (Parse tokens!)
proc printBuffer { size } {
    set ::count $size
    set ::bb(x1)  10000
    set ::bb(x2) -10000
    set ::bb(y1)  10000
    set ::bb(y2) -10000
    while { $::count } {
        set token [$::feedbackBuffer get [expr {$size-$::count}]]
        incr ::count -1
        if { $token == $::GL_PASS_THROUGH_TOKEN } {
            puts "GL_PASS_THROUGH_TOKEN"
            puts [format "  %4.2f" [$::feedbackBuffer get [expr {$size-$::count}]]]
            incr ::count -1
        } elseif { $token == $::GL_POLYGON_TOKEN } {
            # puts "GL_POLYGON_TOKEN"
            print2DVertex $size
        }
    }
    WriteInfoStr [format "BBox (x1,x2) (y1,y2): (%4.1f, %4.1f) (%4.1f, %4.1f)" \
                 $::bb(x1) $::bb(x2) $::bb(y1) $::bb(y2)]
}

proc drawScreenRect { toglwin x1 x2 y1 y2 } {
    glDisable GL_LIGHTING
    glMatrixMode GL_PROJECTION
        glPushMatrix
        glLoadIdentity
        gluOrtho2D 0 [$toglwin width] 0 [$toglwin height]
        glMatrixMode GL_MODELVIEW
            glPushMatrix
            glLoadIdentity
            glColor3f 0 1 1
            glBegin GL_LINE_LOOP
                glVertex2f $x1 $y1
                glVertex2f $x2 $y1
                glVertex2f $x2 $y2
                glVertex2f $x1 $y2
            glEnd
            glPopMatrix
        glMatrixMode GL_PROJECTION
            glPopMatrix
    glMatrixMode GL_MODELVIEW
    glEnable GL_LIGHTING
}

proc drawGeometry { mode } {
    global gPo

    glPushMatrix

    obj2ogl $mode
    glPopMatrix
}

proc SetCamera {} {
    global gPo

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    gluLookAt 0.0 0.0 $::dist 0.0 0.0 0.0 0.0 1.0 0.0
    glTranslatef $gPo(tx) $gPo(ty) $gPo(tz)
}

proc Abs { a } {
    if { $a < 0 } {
        return [expr -1 * $a] 
    } else {
        return $a
    }
}

proc getMatrixAngles {} {
    set tmpMat [tcl3dVector GLfloat 16]
    set tmpVec [tcl3dVector GLfloat  3]

    glGetFloatv GL_MODELVIEW_MATRIX $tmpMat

    set retVal [tcl3dMatfGetAngles1 $tmpMat $tmpVec]

    set rx [tcl3dRadToDeg [$tmpVec get 0]]
    set ry [tcl3dRadToDeg [$tmpVec get 1]]
    set rz [tcl3dRadToDeg [$tmpVec get 2]]
    #puts "Angles1 ($retVal): $rx $ry $rz"

    set retVal [tcl3dMatfGetAngles $tmpMat $tmpVec]

    set rx [tcl3dRadToDeg [$tmpVec get 0]]
    set ry [tcl3dRadToDeg [$tmpVec get 1]]
    set rz [tcl3dRadToDeg [$tmpVec get 2]]
    #puts "Angles ($retVal): $rx $ry $rz"

    $tmpMat delete
    $tmpVec delete
    return [list $rx $ry $rz]
}

proc convertMatrixToAngles {} {
    global gPo

    set angList [getMatrixAngles]

    set gPo(rx) [expr int ([lindex $angList 0])]
    set gPo(ry) [expr -1 * int ([lindex $angList 1])]
    set gPo(rz) [expr int ([lindex $angList 2])]
}

proc DisplayCallback { toglwin } {
    global gPo

    if { $::optMultisampling } {
        glEnable GL_MULTISAMPLE
    } else {
        glDisable GL_MULTISAMPLE
    }
    if { [info exists ::objId] && [glmHaveTexCoords $::objId] && $gPo(curFile,haveTex) } {
        glEnable GL_TEXTURE_2D
    } else {
        glDisable GL_TEXTURE_2D
    }

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

    # Viewport command is not really needed, but has been inserted for
    # Mac OSX. Presentation framework (Tk) does not send a reshape event,
    # when switching from one demo to another.
    glViewport 0 0 [$toglwin width] [$toglwin height]

    glColor3f 0.0 1.0 0.0

    SetCamera

    if { $gPo(useAngles) } {
        glRotatef $gPo(rx) 1 0 0
        glRotatef $gPo(ry) 0 1 0
        glRotatef $gPo(rz) 0 0 1
    } else {
        tcl3dTbMatrix $toglwin
        convertMatrixToAngles
    }

    glPolygonMode GL_FRONT GL_FILL
    if { $::optMarkBackFaces } {
        glPolygonMode GL_BACK  GL_LINE
    } else {
        glPolygonMode GL_BACK  GL_FILL
    }

    drawGeometry $::GL_RENDER

    if { $::optShowBB } {
        glFeedbackBuffer $::feedbackSize GL_2D $::feedbackBuffer
        glRenderMode GL_FEEDBACK
        drawGeometry $::GL_FEEDBACK
        set size [glRenderMode GL_RENDER]
        # TODO: Check size for being in correct range.
        printBuffer $size

        drawScreenRect $toglwin $::bb(x1) $::bb(x2) $::bb(y1) $::bb(y2)
    }

    glFlush
    $toglwin swapbuffers
}

proc calculateObjSizes {} {
    set objSize [tcl3dVector GLfloat 3]
    glmDimensions $::objId $objSize
    set ::maxSize 0.0
    set ::maxSize [poMisc:Max $::maxSize [$objSize get 0]]
    set ::maxSize [poMisc:Max $::maxSize [$objSize get 1]]
    set ::maxSize [poMisc:Max $::maxSize [$objSize get 2]]
    set ::dist [expr 0.5 * $::maxSize / tan (3.1415926 / 180.0 * (0.5 * $::fov))]
    WriteInfoStr [format "Size (x,y,z): (%.2f, %.2f, %.2f)" \
                   [expr 1.0 / $::scaleFactor * [$objSize get 0]] \
                   [expr 1.0 / $::scaleFactor * [$objSize get 1]] \
                   [expr 1.0 / $::scaleFactor * [$objSize get 2]]]
    $objSize delete
}

proc CreateDisplayList { mode } {
    global gPo

    if { $::optUseDisplayList } {
        if { [info exists gPo(displayList)] } {
            glDeleteLists $gPo(displayList) 1
        }
        set gPo(displayList) [glmList $::objId $mode]
    }
}

# Function to draw the in-memory representation of a Wavefront 3D model
# with OpenGL calls.

proc obj2ogl { mode } {
    global gPo

    if { ! [info exists ::objId] } {
        return
    }
    set mode 0
    if { [glmHaveTexCoords $::objId] && $gPo(curFile,haveTex) } {
        #puts "Have texture coordinates and texture file"
        set mode [expr $mode | $::GLM_TEXTURE]
    }
    if { [glmHaveMaterials $::objId] } {
        #puts "Have materials"
        set mode [expr $mode | $::GLM_MATERIAL]
    }
    if { $::optLines } {
        #puts "Drawing lines"
        set mode [expr $mode | $::GLM_LINE]
    } elseif { [glmHaveVertexNormals $::objId] } {
        #puts "Drawing smooth shaded"
        glShadeModel GL_SMOOTH
        set mode [expr $mode | $::GLM_SMOOTH]
    } elseif { [glmHaveFacetNormals $::objId] } {
        #puts "Drawing flat shaded"
        glShadeModel GL_FLAT
        set mode [expr $mode | $::GLM_FLAT]
    } else {
        #puts "Drawing without shading"
        set mode [expr $mode | $::GLM_NONE]
    }
    if { $::optUseDisplayList } {
        if { ! [info exists gPo(displayList)] } {
            CreateDisplayList $mode
        }
        glCallList $gPo(displayList)
    } else {
        glmDraw $::objId $mode
    }
}

proc ToggleScreenRect { { sw 1 } } {
    if { $::optLines } {
        tk_messageBox \
            -message "Screen rectangle mode only supported in face mode." \
            -type ok -icon info -title "$::gPo(appName) Information"
        return
    }
    if { $sw } {
        set ::optShowBB [expr ! $::optShowBB]
    }
    $::gPo(toglWin) postredisplay
}

proc ToggleDisplayList { { sw 1 } } {
    global gPo

    if { $sw } {
        set ::optUseDisplayList [expr ! $::optUseDisplayList]
    }
    if { ! $::optUseDisplayList && [info exists gPo(displayList)] } {
        glDeleteLists $gPo(displayList) 1
        unset gPo(displayList)
    }
    $::gPo(toglWin) postredisplay
}

proc ToggleMultisampling { { sw 1 } } {
    if { $sw } {
        set ::optMultisampling [expr ! $::optMultisampling]
    }
    $::gPo(toglWin) postredisplay
}

proc ToggleDrawMode { { sw 1 } } {
    if { $sw } {
        set ::optLines [expr ! $::optLines]
    }
    $::gPo(toglWin) postredisplay
}

proc ToggleBackFaceMode { { sw 1 } } {
    if { $sw } {
        set ::optMarkBackFaces [expr ! $::optMarkBackFaces]
    }
    $::gPo(toglWin) postredisplay
}

proc ToggleLighting { { sw 1 } } {
    if { $sw } {
        set ::optMakeLight [expr ! $::optMakeLight]
    }
    if { $::optMakeLight } {
        glEnable GL_LIGHTING
        glEnable GL_LIGHT0
    } else {
        glDisable GL_LIGHTING
        glDisable GL_LIGHT0
    }
    $::gPo(toglWin) postredisplay
}

proc AngOn {} {
    global gPo

    set gPo(useAngles) 1
    #puts "Angle on $gPo(count)"
    incr gPo(count)
}

proc AngOff {} {
    global gPo

    set gPo(useAngles) 0
    convertMatrixToAngles
    #puts "Angle off $gPo(count)"
}

proc ShowAngleWindow {} {
    global gPo

    set tw .modelViewer:angleWin

    if { [winfo exists $tw] } {
        wm deiconify $tw
        update
        raise $tw
        return
    }

    toplevel $tw
    wm title $tw "Euler angles"
    wm resizable $tw false false

    AngOn

    set labels { "Pitch    (X):" \
                 "Roll     (Y):" \
                 "Yaw      (Z):" }

    # Generate left column with text labels.
    set row 0
    foreach labelStr $labels {
        label $tw.l$row -text $labelStr
        grid  $tw.l$row -row $row -column 0 -sticky nw
        incr row
    }

    # Generate right column with scale widgets.
    set row 0
    frame $tw.fr$row
    grid $tw.fr$row -row $row -column 1 -sticky news
    scale $tw.fr$row.sx -from -180 -to 180 \
                        -length 380 -resolution 1 \
                        -command UpdatePosition \
                        -showvalue false -orient horizontal \
                        -variable gPo(rx)
    entry $tw.fr$row.ex -textvariable gPo(rx) -width 10 
    pack $tw.fr$row.sx $tw.fr$row.ex -side left -anchor w -pady 2
    bind $tw.fr$row.ex <KeyPress-Return> "UpdatePositionGlobal"

    incr row
    frame $tw.fr$row
    grid $tw.fr$row -row $row -column 1 -sticky news
    scale $tw.fr$row.sx -from -180 -to 180 \
                        -length 380 -resolution 1 \
                        -command UpdatePosition \
                        -showvalue false -orient horizontal \
                        -variable gPo(ry)
    entry $tw.fr$row.ex -textvariable gPo(ry) -width 10 
    pack $tw.fr$row.sx $tw.fr$row.ex -side left -anchor w -pady 2
    bind $tw.fr$row.ex <KeyPress-Return> "UpdatePositionGlobal"

    incr row
    frame $tw.fr$row
    grid $tw.fr$row -row $row -column 1 -sticky news
    scale $tw.fr$row.sx -from -180 -to 180 \
                        -length 380 -resolution 1 \
                        -command UpdatePosition \
                        -showvalue false -orient horizontal \
                        -variable gPo(rz)
    entry $tw.fr$row.ex -textvariable gPo(rz) -width 10 
    pack $tw.fr$row.sx $tw.fr$row.ex -side left -anchor w -pady 2
    bind $tw.fr$row.ex <KeyPress-Return> "UpdatePositionGlobal"

    # Create Close button
    incr row
    frame $tw.fr$row
    grid  $tw.fr$row -row $row -column 0 -columnspan 2 -sticky news

    bind  $tw <KeyPress-Escape> "AngOff ; destroy $tw"
    button $tw.fr$row.b -text "Close" -command "AngOff ; destroy $tw"
    wm protocol $tw WM_DELETE_WINDOW "AngOff ; destroy $tw"

    pack $tw.fr$row.b -side left -fill x -padx 2 -expand 1

    focus $tw
}

proc UpdatePositionGlobal {} {
    global gPo

    $::gPo(toglWin) postredisplay
}

proc UpdatePosition { val } {
    global gPo

    AngOn
    $::gPo(toglWin) postredisplay
    getMatrixAngles
}

proc ResetTfms {} {
    global gPo

    set gPo(tx) 0.0
    set gPo(ty) 0.0
    set gPo(tz) 0.0
    # Start values for model rotation
    set gPo(rx) 45
    set gPo(ry) 45 
    set gPo(rz) 0
    if { [info exists gPo(toglWin)] } {
        tcl3dTbInit $gPo(toglWin)
    }
}

proc ReadImg { imgName numChans } {
    if { $numChans != 3 && $numChans != 4 } {
        error "Error: Only 3 or 4 channels allowed ($numChans supplied)"
    }
    set retVal [catch {set phImg [image create photo -file $imgName]} err1]
    if { $retVal != 0 } {
        error "Error reading image $imgName ($err1)"
    } else {
        set w [image width  $phImg]
        set h [image height $phImg]
        set texImg [tcl3dVectorFromPhoto $phImg $numChans]
        image delete $phImg
    }
    return [list $texImg $w $h]
}

proc ReadTex { fileName } {
    set imgInfo [ReadImg $fileName 3]
    set imgData   [lindex $imgInfo 0]
    set imgWidth  [lindex $imgInfo 1]
    set imgHeight [lindex $imgInfo 2]

    if { [tcl3dIsPow2 $imgWidth] && [tcl3dIsPow2 $imgHeight] } {
        # Create The Texture
        glGenTextures 1 $::gTextureId

        glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_DECAL
        glBindTexture GL_TEXTURE_2D [$::gTextureId get 0]
        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
        glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
        glTexImage2D GL_TEXTURE_2D 0 $::GL_RGB $imgWidth $imgHeight \
                     0 GL_RGB GL_UNSIGNED_BYTE $imgData
    } else {
        tk_messageBox \
            -message "Texture dimensions must be a power of two." \
            -type ok -icon info -title "$::gPo(appName) Information"
    }

    # Delete the image data vector.
    $imgData delete
}

if { $gUseToplevel } {
    catch { destroy $gRoot }
}

set gPo(appName) "Tcl3D Model Viewer"
set gPo(lastDir) [pwd]
set gPo(lastFile) "Default"
set gPo(curFile,type) ""
set gPo(curFile,haveTex) 0
set gPo(count) 0
#AngOff

set ::maxSize 10
set ::dist 10
set ::fov 60

set ::optShowBB         0
set ::optLines          0
set ::optMarkBackFaces  0
set ::optMultisampling  0
set ::optMakeLight      1
set ::optUseDisplayList 0

ResetTfms

# TODO: 
# This size must be changed according to the number of polygons of the model.
# Plus take into account the format specified with glFeedbackBuffer.
set feedbackSize 100000
set feedbackBuffer [tcl3dVector GLfloat $feedbackSize]

ShowMainWin $gPo(appName)

if { $argc != 0 } {
    set modName [lindex $argv 0]
    if { $modName ne "" } {
        ReadModel $modName
    }
}
