Demo 2 of 2 in category tcl3dFTGL
 |
# 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]
|
