OUTPUT BUFFER:
# GL_Font.tcl # # Tutorial from www.GameProgrammer.org # Bitmap fonts # # Original code Copyright 2005 by Vahid Kazemi # # Modified for Tcl3D by Paul Obermeier 2006/09/15 # See www.tcl3d.org for the Tcl3D extension. package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Determine the directory of this script. set g_scriptDir [file dirname [info script]] # Window size. set winWidth 640 set winHeight 480 set count 0.0 set countIncr 0.01 set ::alpha 1.0 set ::fontColor [list 0.5 1 0.5 $::alpha] set texId [tcl3dVector GLuint 1] # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" ExitProg } # 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 LoadImage { imgName numChans } { if { $numChans != 3 && $numChans != 4 } { error "Error: Only 3 or 4 channels allowed ($numChans supplied)" } set texName [file join $::g_scriptDir $imgName] set retVal [catch {set phImg [image create photo -file $texName]} err1] if { $retVal != 0 } { error "Error reading image $texName ($err1)" } else { set w [image width $phImg] set h [image height $phImg] set texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } return [list $texImg $w $h] } proc LoadTexture { imgName } { set imgInfo [LoadImage $imgName 3] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] glGenTextures 1 $::texId glBindTexture GL_TEXTURE_2D [$::texId get 0] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $imgWidth $imgHeight \ 0 $::GL_RGB GL_UNSIGNED_BYTE $imgData $imgData delete } # Set the alpha increment. proc SetAlphaSpeed { val } { set ::countIncr [expr $::countIncr + $val] if { $::countIncr < 0.0 } { set ::countIncr 0.0 } } # This is a one-by-one translation of the original C++ demo code. # Typically you would build display lists for the individual characters # and call these. See for example Lesson24 of the NeHe tutorials. proc DrawText { x y txt size alpha color } { set x1 $x set y1 $y set offset 96 ; # First Font: -32 glEnable GL_BLEND glDisable GL_DEPTH_TEST glBlendFunc GL_SRC_ALPHA GL_ONE glBindTexture GL_TEXTURE_2D [$::texId get 0] glColor4fv $color foreach letter [split $txt {}] { if { $letter eq "\n" || $letter eq "\r" } { set x1 $x set y1 [expr {$y1 + 16 + 16*int($size-1.0)}] continue } scan $letter "%c" letterCode set cx [expr {fmod(($letterCode+$offset)/16.0, 1)}] set cy [expr {(($letterCode+$offset)/16)/16.0}] glBegin GL_QUADS glTexCoord2f $cx [expr {1-$cy}] glVertex2i $x1 $y1 glTexCoord2f $cx [expr {1-$cy-0.0625}] glVertex2i $x1 [expr {int((16*$size)+$y1)}] glTexCoord2f [expr {$cx+0.0625}] [expr {1-$cy-0.0625}] glVertex2i [expr {int((16*$size)+$x1)}] [expr {int((16*$size)+$y1)}] glTexCoord2f [expr {$cx+0.0625}] [expr {1-$cy}] glVertex2i [expr {int((16*$size)+$x1)}] $y1 glEnd set x1 [expr {$x1 + 10+ int((10*($size-1.0)))}] } glDisable GL_BLEND glEnable GL_DEPTH_TEST } # The Togl callback function called when window is resized. proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h } # The Togl callback function called when window is created. proc CreateCallback { toglwin } { glEnable GL_DEPTH_TEST glMatrixMode GL_PROJECTION glLoadIdentity gluOrtho2D 0 $::winWidth $::winHeight 0 glMatrixMode GL_MODELVIEW glEnable GL_CULL_FACE glEnable GL_TEXTURE_2D LoadTexture "font.bmp" } # The Togl callback function for rendering a frame. 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] glLoadIdentity if { [info exists ::animateId] } { set ::count [expr {$::count + $::countIncr}] set ::alpha [expr {abs(sin($::count))}] set ::fontColor [list 0.5 1 0.5 $::alpha] } DrawText 100 240 "THIS IS MY FIRST TEXT!" 2.0 $::alpha $::fontColor $toglwin swapbuffers } # Put all exit related code here. proc ExitProg {} { exit } proc Animate {} { .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } # Create the OpenGL window and some Tk helper widgets. proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both # Create Our OpenGL Window togl .fr.toglwin -width $::winWidth -height $::winHeight \ -double true -depth true \ -swapinterval 1 \ -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: GameProgrammer.org Tutorial GL_Font" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .