OUTPUT BUFFER:
# 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 0.3.1 # 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 } 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 } 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