# ftglDemo.tcl
#
# This demo demonstrates the different rendering styles available with FTGL.
# Press <n> to change the font rendering style.
# Press <enter> to enable edit mode.
# 
# Please contact me if you have any suggestions, feature requests, or problems.
# 
# Henry Maddocks
# henryj@paradise.net.nz
# http://homepages.paradise.net.nz/henryj/
# 
# Modified for Tcl3D by Paul Obermeier 2006/01/18
# See www.tcl3d.org for the Tcl3D extension.

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
}

set EDITING     1
set INTERACTIVE 2

set fontList [list BITMAP PIXMAP OUTLINE POLYGON EXTRUDE TEXTURE]
set curFont EXTRUDE
set curFontInd 4

# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}

set g_WinWidth 640
set g_WinHeight 480

set mode $INTERACTIVE

set g_texture [tcl3dVectorFromArgs GLfloat \
    1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 \
    1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 \
    0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 \
    0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0]

# Show errors occuring in the Togl callbacks.
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 setUpLighting {} {
   # Set up lighting.
   set light1_ambient  {  1.0 1.0 1.0 1.0 }
   set light1_diffuse  {  1.0 0.9 0.9 1.0 }
   set light1_specular {  1.0 0.7 0.7 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_SPECULAR $light1_specular
   glLightfv GL_LIGHT1 GL_POSITION $light1_position
   glEnable GL_LIGHT1

   set light2_ambient  { 0.2  0.2  0.2 1.0 }
   set light2_diffuse  { 0.9  0.9  0.9 1.0 }
   set light2_specular { 0.7  0.7  0.7 1.0 }
   set light2_position { 1.0 -1.0 -1.0 0.0 }
   glLightfv GL_LIGHT2 GL_AMBIENT  $light2_ambient
   glLightfv GL_LIGHT2 GL_DIFFUSE  $light2_diffuse
   glLightfv GL_LIGHT2 GL_SPECULAR $light2_specular
   glLightfv GL_LIGHT2 GL_POSITION $light2_position
   # glEnable GL_LIGHT2

   set front_emission { 0.3  0.2  0.1 0.0 }
   set front_ambient  { 0.2  0.2  0.2 0.0 }
   set front_diffuse  { 0.95 0.95 0.8 0.0 }
   set front_specular { 0.6  0.6  0.6 0.0 }
   glMaterialfv GL_FRONT GL_EMISSION $front_emission
   glMaterialfv GL_FRONT GL_AMBIENT  $front_ambient
   glMaterialfv GL_FRONT GL_DIFFUSE  $front_diffuse
   glMaterialfv GL_FRONT GL_SPECULAR $front_specular
   glMaterialf  GL_FRONT GL_SHININESS 16.0
   glColor4fv $front_diffuse

   glLightModeli GL_LIGHT_MODEL_TWO_SIDE $::GL_FALSE
   glColorMaterial GL_FRONT GL_DIFFUSE
   glEnable GL_COLOR_MATERIAL

   glEnable GL_LIGHTING
}

proc setUpFonts { fontfile } {
    global g_fonts

    set g_fonts(BITMAP)  [FTGLBitmapFont  font0 $fontfile]
    set g_fonts(PIXMAP)  [FTGLPixmapFont  font1 $fontfile]
    set g_fonts(OUTLINE) [FTGLOutlineFont font2 $fontfile]
    set g_fonts(POLYGON) [FTGLPolygonFont font3 $fontfile]
    set g_fonts(EXTRUDE) [FTGLExtrdFont   font4 $fontfile]
    set g_fonts(TEXTURE) [FTGLTextureFont font5 $fontfile]

    foreach x [array names g_fonts] {
        if { [$g_fonts($x) Error] } {
            error "Failed to open font $fontfile"
        }
        if { ! [$g_fonts($x) FaceSize 144] } {
            error "Failed to set size"
        }
        $g_fonts($x) Depth 20
    }
    set ::g_infoFont [FTGLPixmapFont g_infoFont $fontfile]
    if { [$::g_infoFont Error] } {
        error "Failed to open font $fontfile"
    }
    $::g_infoFont FaceSize 14
    set ::myString  "A"
}

proc renderFontmetrics {} {
    global g_fonts
    global curFont

    set bbox [tcl3dFTGLGetBBox $g_fonts($curFont) $::myString]
    foreach {x1 y1 z1 x2 y2 z2} $bbox { break }

    # Draw the bounding box
    glDisable GL_LIGHTING
    glDisable GL_TEXTURE_2D
    glEnable GL_LINE_SMOOTH
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE ; # GL_ONE_MINUS_SRC_ALPHA

    glColor3f 0.0 1.0 0.0
    # Draw the front face
    glBegin GL_LINE_LOOP
        glVertex3f $x1 $y1 $z1
        glVertex3f $x1 $y2 $z1
        glVertex3f $x2 $y2 $z1
        glVertex3f $x2 $y1 $z1
    glEnd
    # Draw the back face
    if { $curFont == "EXTRUDE" && $z1 != $z2 } {
        glBegin GL_LINE_LOOP
            glVertex3f $x1 $y1 $z2
            glVertex3f $x1 $y2 $z2
            glVertex3f $x2 $y2 $z2
            glVertex3f $x2 $y1 $z2
        glEnd
        # Join the faces
        glBegin GL_LINES
            glVertex3f $x1 $y1 $z1
            glVertex3f $x1 $y1 $z2

            glVertex3f $x1 $y2 $z1
            glVertex3f $x1 $y2 $z2

            glVertex3f $x2 $y2 $z1
            glVertex3f $x2 $y2 $z2

            glVertex3f $x2 $y1 $z1
            glVertex3f $x2 $y1 $z2
        glEnd
    }

    # Draw the baseline, Ascender and Descender
    glBegin GL_LINES
        glColor3f  0.0 0.0 1.0
        glVertex3f 0.0 0.0 0.0
        glVertex3f [$g_fonts($curFont) Advance $::myString] 0.0 0.0
        glVertex3f 0.0 [$g_fonts($curFont) Ascender] 0.0
        glVertex3f 0.0 [$g_fonts($curFont) Descender] 0.0
    glEnd

    # Draw the origin
    glColor3f 1.0 0.0 0.0
    glPointSize 5.0
    glBegin GL_POINTS
        glVertex3f 0.0 0.0 0.0
    glEnd
}

proc renderFontInfo {} {
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluOrtho2D 0 $::g_WinWidth 0 $::g_WinHeight
    glMatrixMode GL_MODELVIEW
    glLoadIdentity

    # draw mode
    glColor3f 1.0 1.0 1.0
    glRasterPos2f 20.0 [expr $::g_WinHeight - (20.0 + [$::g_infoFont Ascender])]

    if { $::mode == $::EDITING } {
        $::g_infoFont Render "Edit Mode"
    }

    # draw font type
    glRasterPos2i 20 20
    switch -exact -- $::curFont {
        "BITMAP"  { $::g_infoFont Render "Bitmap Font" }
        "PIXMAP"  { $::g_infoFont Render "Pixmap Font" }
        "OUTLINE" { $::g_infoFont Render "Outline Font" }
        "POLYGON" { $::g_infoFont Render "Polygon Font" }
        "EXTRUDE" { $::g_infoFont Render "Extruded Font" }
        "TEXTURE" { $::g_infoFont Render "Texture Font" }
        default   { tk_messageBox -icon error -type ok -title "Error" \
                    -message "Unknown font type $::curFont"
        }
    }
    glRasterPos2f 20.0 [expr 20.0 + [$::g_infoFont LineHeight]]
    $::g_infoFont Render $::fontfile
}

proc do_display {} {
    switch -exact $::curFont {
        "BITMAP"  { ; }
        "PIXMAP"  { ; }
        "OUTLINE" { ; }
        "POLYGON" {
            glEnable GL_TEXTURE_2D
            glBindTexture GL_TEXTURE_2D [$::g_textureId get 0]
            glDisable GL_BLEND
            setUpLighting
        }
        "EXTRUDE" { 
            glEnable GL_DEPTH_TEST
            glDisable GL_BLEND
            glEnable GL_TEXTURE_2D
            glBindTexture GL_TEXTURE_2D [$::g_textureId get 0]
            setUpLighting
        }
        "TEXTURE" {
            glEnable GL_TEXTURE_2D
            glDisable GL_DEPTH_TEST
            setUpLighting
            glNormal3f 0.0 0.0 1.0
        }
        default {
            tk_messageBox -icon error -type ok -title "Error" \
                          -message "Unknown font type $::curFont"
        }
    }

    glColor3f 1.0 1.0 1.0
    # If you do want to switch the color of bitmaps rendered with glBitmap,
    # you will need to explicitly call glRasterPos3f (or its ilk) to lock
    # in a changed current color.

    glPushMatrix
    $::g_fonts($::curFont) Render $::myString
    glPopMatrix

    glPushMatrix
    renderFontmetrics
    glPopMatrix

    renderFontInfo
}

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]

    SetCamera
 
    switch -exact -- $::curFont {
        "BITMAP" -
        "PIXMAP" {
            glRasterPos2i [expr $::g_WinWidth / 2] [expr $::g_WinHeight / 2]
            glTranslatef  [expr $::g_WinWidth / 2] [expr $::g_WinHeight / 2] 0.0
        } 
        "OUTLINE" -
        "POLYGON" -
        "EXTRUDE" -
        "TEXTURE" { tcl3dTbMatrix $toglwin }
        default {
            tk_messageBox -icon error -type ok -title "Error" \
                          -message "Unknown font type $::curFont"
        }
    }

    glPushMatrix
    do_display
    glPopMatrix

    $toglwin swapbuffers
}

proc CreateCallback { toglwin } {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glClearColor 0.13 0.17 0.32 0.0
    glColor3f 1.0 1.0 1.0

    glEnable GL_CULL_FACE
    glFrontFace GL_CCW

    glEnable GL_DEPTH_TEST
    glEnable GL_CULL_FACE
    glShadeModel GL_SMOOTH

    glEnable GL_POLYGON_OFFSET_LINE
    glPolygonOffset 1.0 1.0

    SetCamera

    tcl3dTbInit $toglwin
    tcl3dTbAnimate $toglwin $::GL_TRUE

    set ::g_textureId [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_textureId

    glBindTexture GL_TEXTURE_2D [$::g_textureId get 0]
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGB 4 4 0 GL_RGB GL_FLOAT $::g_texture
}

proc myinit { fontfile } {
    setUpFonts $fontfile
}

proc toggleMode { toglwin } {
    if { $::mode == $::EDITING } {
        set ::mode $::INTERACTIVE
    } else {
        set ::mode $::EDITING
    }
    $toglwin postredisplay
}

proc incrFont { toglwin } {
    incr ::curFontInd
    if { $::curFontInd > 5 } {
        set ::curFontInd 0
    }
    set ::curFont [lindex $::fontList $::curFontInd]
    $toglwin postredisplay
}

proc delChar { toglwin } {
    set ::myString [string range $::myString 0 end-1]
    $toglwin postredisplay
}

proc handleKeys { toglwin key } {
    if { ! [string is alnum -strict $key] } {
        return
    }
    if { $::mode == $::INTERACTIVE } {
        set ::myString $key
    } else {
        append ::myString $key
    }
    $toglwin postredisplay
}

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

    glMatrixMode GL_MODELVIEW
    glViewport 0 0 $w $h
    glLoadIdentity

    set ::g_WinWidth $w
    set ::g_WinHeight $h
    SetCamera
    
    tcl3dTbReshape $toglwin $::g_WinWidth $::g_WinHeight
}

proc SetCamera {} {
    switch -exact -- $::curFont {
        "BITMAP" -
        "PIXMAP" {
            glMatrixMode GL_PROJECTION
            glLoadIdentity
            gluOrtho2D 0 $::g_WinWidth 0 $::g_WinHeight
            glMatrixMode GL_MODELVIEW
            glLoadIdentity
        }
        "OUTLINE" -
        "POLYGON" -
        "EXTRUDE" -
        "TEXTURE" {
            glMatrixMode GL_PROJECTION
            glLoadIdentity
            gluPerspective 90 [expr double($::g_WinWidth)/double($::g_WinHeight)] 1 1000
            glMatrixMode GL_MODELVIEW
            glLoadIdentity
            gluLookAt 0.0 0.0 [expr double($::g_WinHeight)/2.0] 0.0 0.0 0.0 0.0 1.0 0.0
        }
        default {
            tk_messageBox -icon error -type ok -title "Error" \
                          -message "Unknown font type $::curFont"
        }
    }
}


proc CreateWindow {} {
    frame .fr
    pack .fr -expand 1 -fill both
    togl .fr.toglwin -width $::g_WinWidth -height $::g_WinHeight \
                     -double true -depth true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback

    listbox .fr.usage -font $::listFont -height 3
    label   .fr.info
    grid .fr.toglwin -row 0 -column 0 -sticky news
    grid .fr.usage   -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

    wm title . "Tcl3D demo: FTGL Demo"

    bind . <Key-Escape>      "ExitProg"
    bind . <Key-Return>      "toggleMode .fr.toglwin"
    bind . <Key-n>           "incrFont .fr.toglwin"
    bind . <Key-Delete>      "delChar .fr.toglwin"
    bind . <Key-BackSpace>   "delChar .fr.toglwin"
    bind . <Shift-Key>       "handleKeys .fr.toglwin %A"
    bind . <Key>             "handleKeys .fr.toglwin %A"
    bind .fr.toglwin <ButtonPress-1>   "tcl3dTbStartMotion .fr.toglwin %x %y"
    bind .fr.toglwin <ButtonRelease-1> "tcl3dTbStopMotion .fr.toglwin"
    bind .fr.toglwin <B1-Motion>       "tcl3dTbMotion .fr.toglwin %x %y"

    .fr.usage insert end "Key-Escape Exit"
    .fr.usage insert end "Key-Return Switch to (and leave) edit mode"
    .fr.usage insert end "Key-n      Next font type"
    .fr.usage configure -state disabled
}

proc Cleanup {} {
    global g_fonts

    foreach i [array names g_fonts] {
        if { [info exists g_fonts($i)] } {
            $g_fonts($i) -delete
            unset g_fonts($i)
        }
    }
    if { [info exists g_infoFont] } {
        $::g_infoFont -delete
    }

    if { [info exists ::g_textureId] } {
        glDeleteTextures 1 [$::g_textureId get 0]
    }

    $::g_texture delete

    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

proc ExitProg {} {
    exit
}

if { $argc >= 1 && [lindex $argv 0] ne "" } {
    set fontfile [lindex $argv 0]
    if { ! [file exists $fontfile] } {
        tk_messageBox -icon error -type ok -title "Error" \
                      -message "Couldn't open truetype font file $fontfile"
        exit -1
    }
} else {
    set fontfile [file join [file dirname [info script]] "Vera.ttf"]
    set fontfile [tcl3dGetExtFile $fontfile]
}

CreateWindow

myinit $fontfile

PrintInfo [tcl3dOglGetInfoString]
