OUTPUT BUFFER:
# Lesson14.tcl # # NeHe's Outline Font Tutorial # # This Code Was Created By Jeff Molofee 2000 # Modified by Shawn T. to handle (%3.2f, num) parameters. # A HUGE Thanks To Fredric Echols For Cleaning Up # And Optimizing The Base Code, Making It More Flexible! # If You've Found This Code Useful, Please Let Me Know. # Visit My Site At nehe.gamedev.net # # Modified for Tcl3D by Paul Obermeier 2006/08/26 # See www.tcl3d.org for the Tcl3D extension. package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set gDemo(listFont) {-family {Courier} -size 10} # Display mode. set gDemo(fullScreen) false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set gDemo(rot) 0.0 ; # Used To Rotate The Text set gDemo(fontfile) [tcl3dGetExtFile [file join [file dirname [info script]] \ "Data" "Test.ttf"]] if { [info procs tcl3dHaveFTGL] ne "" } { if { ![tcl3dHaveFTGL] } { tk_messageBox -icon error -type ok -title "Error" \ -message "You do not have FTGL installed." exit -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 SetFullScreenMode { win } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win $sw $sh wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+0" $sw $sh] wm geometry $win $fmtStr wm overrideredirect $win 1 focus -force $win } proc SetWindowMode { win w h } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win 10 10 wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+25" $w $h] wm geometry $win $fmtStr wm overrideredirect $win 0 focus -force $win } # Toggle between windowing and fullscreen mode. proc ToggleWindowMode {} { if { $::gDemo(fullScreen) } { SetFullScreenMode . set ::gDemo(fullScreen) false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::gDemo(fullScreen) true } } proc BuildFont {} { global gDemo set gDemo(font) [FTGLExtrdFont font $gDemo(fontfile)] if { [$gDemo(font) Error] } { error "Error: Failed to open font $gDemo(fontfile)" } set point_size 12 if { ! [$gDemo(font) FaceSize $point_size] } { error "Errror: Unable to set font face size $point_size" } $gDemo(font) Depth 2 } # Custom GL "Print" Routine proc glPrint { str } { global gDemo set bbox [tcl3dFTGLGetBBox $gDemo(font) $str] foreach {x1 y1 z1 x2 y2 z2} $bbox { break } set length [expr {$x2 - $x1}] glTranslatef [expr {$length/-2}] 0.0 0.0 $gDemo(font) Render $str } # Resize And Initialize The GL Window proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h ; # Reset The Current Viewport glMatrixMode GL_PROJECTION ; # Select The Projection Matrix glLoadIdentity ; # Reset The Projection Matrix # Calculate The Aspect Ratio Of The Window gluPerspective 45.0 [expr double($w)/double($h)] 0.1 1000.0 glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix glLoadIdentity ; # Reset The Modelview Matrix set ::gDemo(winWidth) $w set ::gDemo(winHeight) $h } # All Setup For OpenGL Goes Here proc CreateCallback { toglwin } { glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.0 0.0 0.0 0.5 ; # Black Background glClearDepth 1.0 ; # Depth Buffer Setup glEnable GL_DEPTH_TEST ; # Enables Depth Testing glDepthFunc GL_LEQUAL ; # The Type Of Depth Testing To Do glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calculations glEnable GL_LIGHT0 ; # Enable Default Light (Quick And Dirty) glEnable GL_LIGHTING ; # Enable Lighting glEnable GL_COLOR_MATERIAL ; # Enable Coloring Of Material BuildFont ; # Build The Font } # Here's Where We Do All The Drawing proc DisplayCallback { toglwin } { global gDemo # Clear Screen And Depth Buffer 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 ; # Reset The Current Modelview Matrix glTranslatef 0.0 0.0 -100.0 ; # Move One Unit Into The Screen glRotatef $gDemo(rot) 1.0 0.0 0.0 ; # Rotate On The X Axis glRotatef [expr {$gDemo(rot)*1.5}] 0.0 1.0 0.0 ; # Rotate On The Y Axis glRotatef [expr {$gDemo(rot)*1.4}] 0.0 0.0 1.0 ; # Rotate On The Z Axis # Pulsing Colors Based On The Rotation glColor3f [expr {1.0*cos($gDemo(rot)/20.0)}] \ [expr {1.0*sin($gDemo(rot)/25.0)}] \ [expr {1.0-0.5*cos($gDemo(rot)/17.0)}] # Print GL Text To The Screen glPrint [format "NeHe - %3.2f" [expr {$gDemo(rot)/50}]] # Increase The Rotation Variable set gDemo(rot) [expr {$gDemo(rot) + 0.5}] $toglwin swapbuffers } 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 } } proc Cleanup {} { global gDemo if { [info exists gDemo(font)] } { $gDemo(font) -delete unset gDemo(font) } unset gDemo } # Put all exit related code here. proc ExitProg {} { exit } # 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 $::gDemo(winWidth) -height $::gDemo(winHeight) \ -swapinterval 1 \ -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::gDemo(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: NeHe's Outline Font Tutorial (Lesson 14)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .