#******************************************************************************
#
#       Copyright:      2006-2026 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:    Tcl3D script to create animated text with the tcl3dFTGL
#                       extension. If FTGL is not available, the script falls
#                       back using the built-in bitmap fonts of Togl. No 3D
#                       effects are then possible.
#
#******************************************************************************

package require Tk
package require tcl3d

set validCmds [list "#" "title" "angle" "align" "fontfile" "fonttype" \
                    "line" "color" "speed" "position"]

set gWinWidth  640
set gWinHeight 480

set gStopWatch [tcl3dNewSwatch]
tcl3dResetSwatch $gStopWatch

set gAnimStarted 0
set gHaveFtgl    true

# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]

if { ! [tcl3dHaveFTGL] } {
    set ::gHaveFtgl false
}

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc IncrSpeed { off } {
    global gOpts

    set gOpts(speed) [expr {$gOpts(speed) + $off}]
    .fr.toglwin postredisplay
}

proc IncrAngle { off } {
    global gOpts

    set gOpts(angle) [expr {$gOpts(angle) + $off}]
}

proc IncrOffset { xoff yoff zoff } {
    global gOpts

    set gOpts(xoff) [expr {$gOpts(xoff) + $xoff}]
    set gOpts(yoff) [expr {$gOpts(yoff) + $yoff}]
    set gOpts(zoff) [expr {$gOpts(zoff) + $zoff}]
    .fr.toglwin postredisplay
}

proc position { x y z } {
    global gOpts

    set gOpts(xoff) $x
    set gOpts(yoff) $y
    set gOpts(zoff) $z
}

proc speed { off } {
    global gOpts

    set gOpts(speed) $off
}

proc angle { xang } {
    global gOpts

    set gOpts(angle) $xang
}

proc color { r g b } {
    global gOpts

    set gOpts(color,r) $r
    set gOpts(color,g) $g
    set gOpts(color,b) $b
}

proc align { fmt } {
    global gOpts

    if { $fmt eq "center"  || $fmt eq "right" } {
        set gOpts(align) $fmt
    } else {
        set gOpts(align) "left"
    }
}

proc fontfile { fontName } {
    global gOpts

    set fontName [format "%s.ttf" $fontName]
    set gOpts(fontfile) [tcl3dGetExtFile [file join $::g_scriptDir $fontName]]
}

proc fonttype { fontType } {
    global fontInfo

    if { $fontType ne "2d" && $fontType ne "3d" && $fontType ne "tex" } {
        set fontType "2d"
    }
    set fontInfo(curFont) $fontType
}

proc line { str } {
    global strList colorList alignList
    global gOpts

    lappend strList $str
    lappend colorList [list $gOpts(color,r) $gOpts(color,g) $gOpts(color,b)]
    lappend alignList $gOpts(align)
}

proc title { str } {
    wm title . $str
}

proc Init {} {
    global gOpts
    global strList colorList alignList lenList

    speed 1.0
    angle 0.0
    fonttype "3d"
    align "left"
    color 1.0 1.0 1.0
    position 0.0 [expr {-0.2 * $::gWinHeight}] 0.0
    set strList   [list]
    set colorList [list]
    set alignList [list]
    set lenList   [list]
}

proc ResetSpeedAndOffset { spd yoff } {
    speed $spd
    position 0.0 $yoff 0.0
}

proc SetupLighting {} {
   set light1_ambient  {  0.0 0.0 0.0 1.0 }
   set light1_diffuse  {  1.0 1.0 1.0 1.0 }
   set light1_position { -1.0 1.0 1.0 0.0 }
   glLightfv GL_LIGHT1 GL_AMBIENT  $light1_ambient
   glLightfv GL_LIGHT1 GL_DIFFUSE  $light1_diffuse
   glLightfv GL_LIGHT1 GL_POSITION $light1_position
   glEnable GL_LIGHT1

   glColorMaterial GL_FRONT GL_DIFFUSE
   glEnable GL_COLOR_MATERIAL

   glEnable GL_LIGHTING
}

proc SetupFont {} {
    global fontInfo gOpts

    if { $::gHaveFtgl } {
        set fontInfo(3d)  [FTExtrudeFont font1 $gOpts(fontfile)]
        set fontInfo(2d)  [FTPolygonFont font2 $gOpts(fontfile)]
        set fontInfo(tex) [FTTextureFont font3 $gOpts(fontfile)]

        foreach x { 2d 3d tex } {
            if { [$fontInfo($x) Error] } {
                error "Failed to open font $gOpts(fontfile)"
            }
            if { ! [$fontInfo($x) FaceSize 40] } {
                error "Failed to set size"
            }
            $fontInfo($x) Depth 6
        }
    } else {
        set fontInfo(bitmap,size) 16
        set fontFamilies { "Courier New" "Lucida" "Courier" }
        foreach fontFamily $fontFamilies {
            set glFont \
            [format "-*-%s-%s-%s-*-*-%d-*-*-*-*-*-*-*" \
                $fontFamily "bold" "r" $fontInfo(bitmap,size)]
            set retVal [catch { .fr.toglwin loadbitmapfont $glFont } fontInfo(bitmap)]
            if { $retVal == 0 } {
                puts "Choosing font \"$glFont\""
                break
            }
        }
        if { $retVal != 0 } {
            set retVal [catch { .fr.toglwin loadbitmapfont } fontInfo(bitmap)]
            if { $retVal == 0 } {
                puts "Choosing default font"
            } else {
                error "Failed to load font from: $fontFamilies"
            }
        }
    }
}

proc PrintString { str } {
    global fontInfo

    set len [string length $str]
    if { $len > 0 } {
        glListBase $fontInfo(bitmap)
        set sa [tcl3dVectorFromString GLubyte $str]
        glCallLists $len GL_UNSIGNED_BYTE $sa
        $sa delete
    }
}

proc DrawFrame {} {
    global strList lenList alignList colorList
    global fontInfo gOpts

    SetupLighting

    set x 0.0
    set y 0.0
    set z 0.0
    if { $::gHaveFtgl } {
        glRotatef $gOpts(angle) 1 0 0
        glTranslatef $gOpts(xoff) $gOpts(yoff) $gOpts(zoff)
        glTranslatef [expr {-0.5 * $fontInfo(xmax)}] 0 0
    }
    foreach str $strList len $lenList align $alignList col $colorList {
        glColor3f [lindex $col 0] [lindex $col 1] [lindex $col 2]

        set x 0.0
        if { $align eq "center" } {
            set x [expr {0.5 * ($fontInfo(xmax) - $len)}] 
        } elseif { $align eq "right" } {
            set x [expr {$fontInfo(xmax) - $len}] 
        }
        if { $::gHaveFtgl } {
            glPushMatrix
            glTranslatef $x $y $z
            $fontInfo($fontInfo(curFont)) Render $str
            glPopMatrix
        } else {
            glLoadIdentity
            set xpos [expr {int ($gOpts(xoff) + $x + $::gWinWidth/2 - \
                            $fontInfo(xmax)/2)}]
            if { $xpos < 0 } {
                set xpos 0
            }
            set ypos [expr {int ($gOpts(yoff) + $y + $::gWinHeight/2)}]
            glRasterPos2i $xpos $ypos
            PrintString $str
        }
        set y [expr {$y - 1.5*$fontInfo(ymax)}]
    }
}

proc DisplayCallback { toglwin } {
    global fontInfo gOpts

    set startTime [tcl3dLookupSwatch $::gStopWatch]

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

    if { [info exists fontInfo(ymax)] } {
        glPushMatrix
        DrawFrame
        glPopMatrix
    }

    $toglwin swapbuffers

    if { [info exists fontInfo(ymax)] && $::gAnimStarted == 1 } {
        set endTime [tcl3dLookupSwatch $::gStopWatch]
        set elapsedTime [expr {$endTime - $startTime}]
        set vel [expr {$fontInfo(ymax) * $gOpts(speed)}]
        set gOpts(yoff) [expr {$gOpts(yoff) + $vel * $elapsedTime}]
    }
}

proc CreateCallback { toglwin } {
    glClearColor 0.13 0.17 0.32 0.0 ; # 33 43 82
    # glClearColor 0.19 0.23 0.38 0.0 ; # 49 59 98 for logo creation

    glDisable GL_BLEND
    glEnable GL_DEPTH_TEST
    glEnable GL_TEXTURE_2D
    glShadeModel GL_SMOOTH
}

proc GetAngle { size dist } {
    set radtheta [expr {2.1 * atan2 ($size/2.0, $dist)}]
    return [expr {(180.0 * $radtheta) / 3.1415926}]
}

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

    set w [$toglwin width]
    set h [$toglwin height]
    glViewport 0 0 $w $h

    set ::gWinWidth  $w
    set ::gWinHeight $h

    set dist [expr {0.5*double($w)}]
    set fov 90.0
    if { [info exists fontInfo(xmax)] } {
        set fov [GetAngle $fontInfo(xmax) $dist]
    }

    glMatrixMode GL_PROJECTION
    glLoadIdentity
    if { $::gHaveFtgl } {
        gluPerspective $fov [expr {double($w)/double($h)}] 1 [expr {$dist * 3.0}]
        glMatrixMode GL_MODELVIEW
        glLoadIdentity
        gluLookAt 0.0 0.0 $dist 0.0 0.0 0.0 0.0 1.0 0.0
    } else {
        gluOrtho2D 0.0 $w 0.0 $h
        glMatrixMode GL_MODELVIEW
        glLoadIdentity
    }
}

proc Animate {} {
    .fr.toglwin postredisplay
    set ::animateId [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    global gOpts

    tcl3dStartSwatch $::gStopWatch

    if { ! [info exists ::animateId] } {
        Animate
        set ::gAnimStarted 1
    }
}

proc StopAnimation {} {
    if { [info exists ::animateId] } {
        after cancel $::animateId
        unset ::animateId
    }
    set ::gAnimStarted 0
    tcl3dStopSwatch $::gStopWatch
}

proc DetermineMaxLen { strList } {
    global fontInfo lenList colorList alignList

    set xmax 0
    set ymax 0
    foreach str $strList {
        if { $::gHaveFtgl } {
            set bbox [tcl3dFTGLGetBBox $fontInfo($fontInfo(curFont)) $str]
            foreach {x1 y1 z1 x2 y2 z2} $bbox { break }

            set xsize [expr {$x2 - $x1}]
            set ysize [expr {$y2 - $y1}]
        } else {
            set len [string length $str]
            set xsize [expr {int (0.7*$fontInfo(bitmap,size)) * $len}]
            set ysize $fontInfo(bitmap,size)
        }
        lappend lenList $xsize
        if { $xsize > $xmax } {
            set xmax $xsize
        }
        if { $ysize > $ymax } {
            set ymax $ysize
        }
    }
    set fontInfo(xmax) $xmax
    set fontInfo(ymax) $ymax
    if { $fontInfo(xmax) > 1000 } {
        set fontInfo(xmax) 1000
    }
}

proc EvalMsgFile { msgFile } {
    global validCmds strList

    set fp [open $msgFile "r"]
    while { [gets $fp str] >= 0 } {
        set cmd [lindex $str 0]
        if { [lsearch -exact $validCmds $cmd] >= 0 } {
            eval "$str"
        } else {
            line "$str"
        }
    }
    close $fp
    SetupFont
    DetermineMaxLen $strList
}

proc EvalMsgStr { msgStr } {
    global validCmds strList

    foreach str [split $msgStr "\n"] {
        set tmp [string trim $str]
        set cmd [string trim [string range $tmp 0 [string wordend $tmp 0]]]
        if { [lsearch -exact $validCmds $cmd] >= 0 } {
            eval "$str"
        } else {
            line "$str"
        }
    }
    SetupFont
    DetermineMaxLen $strList
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $::gWinWidth -height $::gWinHeight \
                 -double true -depth true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback

grid .fr.toglwin -row 0 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1

bind .fr.toglwin <Button-1> "StartAnimation"
bind .fr.toglwin <Button-2> "StopAnimation"
bind .fr.toglwin <Button-3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"

bind . <Key-Escape> "exit"
bind . <Key-Left>   "IncrOffset -2.0 0.0 0.0"
bind . <Key-Right>  "IncrOffset  2.0 0.0 0.0"
bind . <Key-i>      "IncrOffset 0.0 0.0 -2.0"
bind . <Key-d>      "IncrOffset 0.0 0.0  2.0"
bind . <Key-Up>     "IncrSpeed  0.5"
bind . <Key-Down>   "IncrSpeed -0.5"
bind . <Key-plus>   "IncrAngle -1.0"
bind . <Key-minus>  "IncrAngle  1.0"
bind . <Key-s>      "speed 0"
bind . <Key-r>      "ResetSpeedAndOffset 1.0 0.0"

Init
title "Tcl3D Text Display"
fontfile "Vera"

if { [file tail [info script]] eq [file tail $::argv0] } {
    if { $argc >= 1 } {
        set msgFile [lindex $argv 0]
        if { ! [file exists $msgFile] } {
            tk_messageBox -icon error -type ok -title "Error" \
                          -message "Couldn't open messages file $msgFile"
            exit -1
        }
        EvalMsgFile $msgFile
    } else {
        align "center"
        speed 1
        angle -50
        append msgs {"Tcl3D" "Doing 3D with Tcl" "" "is brought to you by" \
                     "Paul Obermeier" "" "Get it from" "www.tcl3d.org"}
        foreach str $msgs {
            line $str
        }
        SetupFont
        DetermineMaxLen $strList
    }

    update
    StartAnimation
}
