# ftglTest.tcl
#
# C++ source changed by mrn@paus.ch/ max rheiner
# original source: henryj@paradise.net.nz
#
# Modified for Tcl3D by Paul Obermeier 2006/01/18
# See www.tcl3d.org for the Tcl3D extension.
#
# A test program showing the 5 different font rendering types.

package require Tk
package require tcl3d

if { ! [tcl3dHaveFTGL] } {
    tk_messageBox -icon error -type ok -title "Missing Tcl3D module" \
                  -message "Demo needs the tcl3dFTGL module."
    proc Cleanup {} {}
    exit 1
    return
}

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

set DEFAULT_FONT [tcl3dGetExtFile [file join $g_scriptDir "Vera.ttf"]]

array set gFonts {
    0   BITMAP
    1   PIXMAP
    2   OUTLINE
    3   POLYGON
    4   EXTRUDE
    5   TEXTURE
    num 6
    cur 0
}

proc GetCurFontName {} {
    global gFonts

    set ind $gFonts(cur)
    return $gFonts($ind)
}

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

# 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 CreateCallback { toglwin } {
    glClearColor 0.0 0.0 0.0 0.0
    glPolygonMode GL_FRONT_AND_BACK GL_FILL
}

proc LoadFont { fontFile } {
    global gFonts

    set gFonts(0,id) [FTGLBitmapFont  font0 $fontFile]
    set gFonts(1,id) [FTGLPixmapFont  font1 $fontFile]
    set gFonts(2,id) [FTGLOutlineFont font2 $fontFile]
    set gFonts(3,id) [FTGLPolygonFont font3 $fontFile]
    set gFonts(4,id) [FTGLExtrdFont   font4 $fontFile]
    set gFonts(5,id) [FTGLTextureFont font5 $fontFile]

    for { set i 0 } { $i < $gFonts(num) } { incr i } {
        if { [$gFonts($i,id) Error] } {
            error "Failed to open font $fontFile"
        }
        set point_size 18
        if { ! [$gFonts($i,id) FaceSize $point_size] } {
            error "ERROR: Unable to set font face size $point_size"
        }
    }
    wm title . "Tcl3D demo: FTGL using TrueType file [file tail $fontFile]"

}

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

    set ::g_WinWidth  $w 
    set ::g_WinHeight $h

    set aspect [expr double ($w) / double ($h)]

    # Use the whole window.
    glViewport 0 0 $w $h

    # We are going to do some 2-D orthographic drawing.
    glMatrixMode GL_PROJECTION

    glLoadIdentity
    if { $w >= $h } {
        set size [expr double ($w) / 2.0]
    } else {
        set size [expr double ($h) / 2.0]
    }

    if { $w <= $h } {
        set aspect [expr double ($h)/double ($w)]
        glOrtho [expr -1.0*$size] $size \
                [expr -1.0*$size*$aspect] [expr $size*$aspect] \
                -100000.0 100000.0
    } else {
        set aspect [expr double ($w)/double ($h)]
        glOrtho [expr -1.0*$size*$aspect] [expr $size*$aspect] \
                [expr -1.0*$size] $size \
                -100000.0 100000.0
    }

    # Make the world and window coordinates coincide so that 1.0 in
    # model space equals one pixel in window space.
    glScaled $aspect $aspect 1.0

    # Now determine where to draw things.
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
}

proc DrawFont {} {
    global gFonts gOpts

    # Set up some strings with the characters to draw.
    set count -1

    incr count
    set str($count) "000-031: Control characters"

    incr count
    set str($count) "032-063: "
    for { set i 32 } { $i < 64 } { incr i } {
        append str($count) [format "%c" $i]
    }

    incr count
    set str($count) "064-095: "
    for { set i 64 } { $i < 96 } { incr i } {
        append str($count) [format "%c" $i]
    }

    incr count
    set str($count) "096-127: "
    for { set i 96 } { $i < 128 } { incr i } {
        append str($count) [format "%c" $i]
    }

    # 128-159 are control characters.
    incr count
    set str($count) "128-159: Control characters"

    incr count
    set str($count) "160-191: "
    for { set i 160 } { $i < 192 } { incr i } {
        append str($count) [format "%c" $i]
    }

    incr count
    set str($count) "192-223: "
    for { set i 192 } { $i < 224 } { incr i } {
        append str($count) [format "%c" $i]
    }

    incr count
    set str($count) "224-255: "
    for { set i 224 } { $i < 256 } { incr i } {
        append str($count) [format "%c" $i]
    }

    glColor3f 1.0 1.0 1.0

    set x [expr -$::g_WinWidth/2 + 5]
    set yild 25.0
    for { set j 0 } { $j <= $count } { incr j } {
        set y [expr $::g_WinHeight/2-($j+1)*$yild]
        set curFontInd  $gFonts(cur)
        set curFontName $gFonts($curFontInd)

        switch -exact -- $curFontName {
            "BITMAP" -
            "PIXMAP" {
                glRasterPos2f $x $y
                $gFonts($curFontInd,id) Render $str($j)
            }
            "POLYGON" -
            "OUTLINE" -
            "EXTRUDE" - 
            "TEXTURE" {
                if { $curFontName eq "TEXTURE" } {
                    glEnable GL_TEXTURE_2D
                    glEnable GL_BLEND
                    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
                }
                glPushMatrix
                    glTranslatef $x $y 0.0
                    $::gFonts($curFontInd,id) Render $str($j)
                glPopMatrix
                if { $curFontName eq "TEXTURE" } {
                    glDisable GL_TEXTURE_2D
                    glDisable GL_BLEND
                }
            }
            default {
                tk_messageBox -icon error -type ok -title "Error" \
                              -message "Unknown font type $curFontName"
            }
        }
    }
    glFlush
}

proc DisplayCallback { toglwin } {
    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]

    DrawFont
    $toglwin swapbuffers
}

proc SwitchFont {} {
    .fr.toglwin postredisplay
}

proc DeleteFonts {} {
    global gFonts

    for { set i 0 } { $i < $gFonts(num) } { incr i } {
        if { [info exists gFonts($i,id)] } {
            $gFonts($i,id) -delete
            unset gFonts($i,id)
        }
    }
}

proc Cleanup {} {
    global gFonts gOpts

    DeleteFonts
    unset gFonts
    unset gOpts
}

proc SelTrueTypeFile {} {
    global gOpts

    set fileTypes {
        {{TrueType}  {.ttf}}
        {{All files} *}
    }

    set fileName [tk_getOpenFile -filetypes $fileTypes \
                                 -initialdir $gOpts(lastDir)]
    if { $fileName ne "" } {
        DeleteFonts
        LoadFont $fileName
        set gOpts(lastDir) [file dirname $fileName]
    }
}

proc usage { program } {
    puts "Usage: $program <filename.ttf>"
}

if { $argc >= 1 && [lindex $argv 0] ne "" } {
    set filename [lindex $argv 0]
    if { ! [file exists $filename] } {
        usage $filename
        puts stderr "Couldn't open file $filename"
        exit -1
    }
} else {
    # try a default font
    set filename $DEFAULT_FONT
    if { ! [file exists $filename] } {
        usage $filename
        puts stderr "Couldn't open file $filename"
        exit -1
    }
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 640 -height 400 \
                 -double true -depth true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback
frame .fr.bfr
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.bfr     -row 1 -column 0 -sticky news
grid .fr.info    -row 2 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1

button .fr.bfr.sel -text "Select TTF file ..." -command SelTrueTypeFile
pack .fr.bfr.sel -side left -padx 5
for { set i 0 } { $i < $gFonts(num) } { incr i } {
    radiobutton .fr.bfr.b$i -text $gFonts($i) \
                -value $i -variable gFonts(cur) -command SwitchFont
    pack .fr.bfr.b$i -side left
}

set gOpts(lastDir) [pwd]

LoadFont $filename

bind . <Key-Escape> "exit"

PrintInfo [tcl3dOglGetInfoString]
