no display name and no $DISPLAY environment variable
while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
("package ifneeded Tk 8.6.11" script)
invoked from within
"package require Tk"
(in namespace eval "::request" script line 16)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
# ftglDemo.tcl
#
# This demo demonstrates the different rendering styles available with FTGL.
# Press to change the font rendering style.
# Press 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 0.3.3
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 { $::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 \
-createproc CreateCallback \
-reshapeproc ReshapeCallback \
-displayproc 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 . "exit"
bind . "toggleMode .fr.toglwin"
bind . "incrFont .fr.toglwin"
bind . "delChar .fr.toglwin"
bind . "delChar .fr.toglwin"
bind . "handleKeys .fr.toglwin %A"
bind . "handleKeys .fr.toglwin %A"
bind .fr.toglwin "tcl3dTbStartMotion .fr.toglwin %x %y"
bind .fr.toglwin "tcl3dTbStopMotion .fr.toglwin"
bind .fr.toglwin "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
}
}
if { $argc >= 1 } {
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"]
if { [info proc tcl3dGetExtFile] eq "tcl3dGetExtFile" } {
set fontfile [tcl3dGetExtFile $fontfile]
}
}
if { [info procs tcl3dHaveFTGL] ne "" } {
if { ![tcl3dHaveFTGL] } {
tk_messageBox -icon error -type ok -title "Error" \
-message "You do not have FTGL installed."
exit -1
}
}
CreateWindow
myinit $fontfile
PrintInfo [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \
$tcl_platform(os) [glGetString GL_RENDERER] \
[glGetString GL_VERSION] [info patchlevel]]