OUTPUT BUFFER:
# cgVertexExample.tcl # # Original files from: http://developer.nvidia.com/Cg # This is the example called runtime_ogl as included in the Cg Toolkit. # # Modified for Tcl3D by Paul Obermeier 2005/11/07 # See www.tcl3d.org for the Tcl3D extension. package require Tk package require tcl3d 0.5.0 if { [info procs tcl3dHaveCg] ne "" } { if { ![tcl3dHaveCg] } { tk_messageBox -icon error -type ok -title "Error" \ -message "You do not have Cg installed." exit } } set LightDiffuse {1.0 0.0 0.0 1.0} set LightPosition {1.0 1.0 1.0 0.0} # Determine the directory of this script. set g_scriptDir [file dirname [info script]] # 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 } } # Draw a box with pure Tcl commands. # This is not the most efficient way to do it, but a 1:1 # porting of the original C code. proc drawBoxTcl { size type } { set n { {-1.0 0.0 0.0} { 0.0 1.0 0.0} { 1.0 0.0 0.0} { 0.0 -1.0 0.0} { 0.0 0.0 1.0} { 0.0 0.0 -1.0} } set faces { {0 1 2 3} {3 2 6 7} {7 6 5 4} {4 5 1 0} {5 6 2 1} {7 4 0 3} } set sm [expr -0.5 * $size] set sp [expr 0.5 * $size] set v [list \ [list $sm $sm $sm] \ [list $sm $sm $sp] \ [list $sm $sp $sp] \ [list $sm $sp $sm] \ [list $sp $sm $sm] \ [list $sp $sm $sp] \ [list $sp $sp $sp] \ [list $sp $sp $sm] \ ] for { set i 0 } { $i < 6 } { incr i } { set f [lindex $faces $i] glBegin $type glNormal3fv [lindex $n $i] cgGLSetParameter3f $::TestColorParam 1.0 0.0 0.0 glVertex3fv [lindex $v [lindex $f 0]] cgGLSetParameter3f $::TestColorParam 0.0 1.0 0.0 glVertex3fv [lindex $v [lindex $f 1]] cgGLSetParameter3f $::TestColorParam 0.0 0.0 1.0 glVertex3fv [lindex $v [lindex $f 2]] cgGLSetParameter3f $::TestColorParam 1.0 1.0 1.0 glVertex3fv [lindex $v [lindex $f 3]] glEnd } } proc DrawCube {} { cgGLBindProgram $::g_program set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgGLBindProgram DrawCube: $retVal" } if { [info exists ::KdParam] } { cgGLSetParameter4f $::KdParam 1.0 1.0 0.0 1.0 } if { [info exists ::ModelViewProjParam] } { cgGLSetStateMatrixParameter $::ModelViewProjParam \ CG_GL_MODELVIEW_PROJECTION_MATRIX \ CG_GL_MATRIX_IDENTITY } cgGLEnableProfile $::g_profile drawBoxTcl 2 $::GL_QUADS cgGLDisableProfile $::g_profile } 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] glMatrixMode GL_MODELVIEW glPushMatrix glLoadIdentity gluLookAt 0.0 0.0 5.0 \ 0.0 0.0 0.0 \ 0.0 1.0 0.0 glTranslatef 0.0 0.0 -1.0 glRotatef 60 1.0 0.0 0.0 glRotatef -20 0.0 0.0 1.0 DrawCube glPopMatrix $toglwin swapbuffers } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 40.0 [expr double($w)/double($h)] 0.1 1000.0 glMatrixMode GL_MODELVIEW glLoadIdentity } proc CreateCallback { toglwin } { glLightfv GL_LIGHT0 GL_DIFFUSE $::LightDiffuse glLightfv GL_LIGHT0 GL_POSITION $::LightPosition glEnable GL_LIGHT0 glDisable GL_LIGHTING glEnable GL_DEPTH_TEST InitCgShader } proc InitCgShader {} { tcl3dCgResetError set ::g_profile [tcl3dCgFindProfile $::CG_PROFILE_VP20 $::CG_PROFILE_ARBVP1] if { $::g_profile eq "" } { error "Could not find Cg profile ARBVP1 or VP20" } set ::g_context [cgCreateContext] set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgCreateContext: $retVal" } set cgFile [tcl3dGetExtFile [file join $::g_scriptDir "cgGL_vertex_example.cg"]] set ::g_program [cgCreateProgramFromFile $::g_context \ CG_SOURCE $cgFile \ $::g_profile "main" "NULL"] set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgCreateProgramFromFile: $retVal" } tcl3dCgPrintProgramInfo $::g_program "cgGL_vertex_example.cg" if { [info exists ::g_program] } { cgGLLoadProgram $::g_program set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgGLLoadProgram: $retVal" } set ::KdParam [cgGetNamedParameter $::g_program "Kd"] set ::ModelViewProjParam [cgGetNamedParameter $::g_program "ModelViewProj"] set ::TestColorParam [cgGetNamedParameter $::g_program "IN.TestColor"] } } proc Cleanup {} { cgDestroyContext $::g_context foreach var [info globals g_*] { uplevel #0 unset $var } } proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both togl .fr.toglwin -width 400 -height 400 \ -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback label .fr.info grid .fr.toglwin -row 0 -column 0 -sticky news grid .fr.info -row 1 -column 0 -sticky news grid rowconfigure .fr 0 -weight 1 grid columnconfigure .fr 0 -weight 1 wm title . "Tcl3D demo: Simple Cg vertex shader" bind .