OUTPUT BUFFER:
# cgFireInTheSky.tcl # # Original files from: http://www.shadertech.com/shaders/FireInTheSky-src.zip # # Original files are Copyright (c) 2002 Jason Jerald # This software is provided 'as-is', without any express or implied warranty. # In no event will the authors be held liable for any damages arising from the # use of this software. # # Permission is granted to anyone to use this software for any purpose, # including commercial applications, and to alter it and redistribute it # freely, subject to the following restrictions: # # 1. The origin of this software must not be misrepresented; # you must not claim that you wrote the original software. # If you use this software in a product, an acknowledgment in # the product documentation would be appreciated but is not required. # # 2. Altered source versions must be plainly marked as such, # and must not be misrepresented as being the original software. # # 3. This notice may not be removed or altered from any source distribution. # # 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 g_TexWidth 256 set g_NoiseTex [tcl3dVector GLfloat [expr $::g_TexWidth*$::g_TexWidth]] set g_RotationX 0.0 set g_RotationY 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" 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 GetFileName { fileName } { return [tcl3dGetExtFile [file join $::g_scriptDir $fileName]] } proc InitCgShader {} { set ::g_lightPos { 0.0 1.0 0.0 } tcl3dCgResetError set ::g_profile [tcl3dCgFindProfile $::CG_PROFILE_ARBFP1 $::CG_PROFILE_FP30] if { $::g_profile eq "" } { error "Could not find Cg fragment profile ARBFP1 or FP30" } # Create cgContext. set ::g_context [cgCreateContext] # Add shaders into context set ::g_CloudShader [cgCreateProgramFromFile $::g_context \ CG_SOURCE [GetFileName "CloudShader.cg"] \ $::g_profile "main" "NULL"] set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgCreateProgramFromFile CloudShader: $retVal" } tcl3dCgPrintProgramInfo $::g_CloudShader "CloudShader.cg" set ::g_OceanShader [cgCreateProgramFromFile $::g_context \ CG_SOURCE [GetFileName "OceanShader.cg"] \ $::g_profile "main2" "NULL"] set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgCreateProgramFromFile OceanShader: $retVal" } tcl3dCgPrintProgramInfo $::g_OceanShader "OceanShader.cg" set ::g_SunShader [cgCreateProgramFromFile $::g_context \ CG_SOURCE [GetFileName "SunShader.cg"] \ $::g_profile "main3" "NULL"] set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgCreateProgramFromFile SunShader: $retVal" } tcl3dCgPrintProgramInfo $::g_SunShader "SunShader.cg" # noise set ::NoiseTextureParam [cgGetNamedParameter $::g_CloudShader "Noise"] # light position set ::LightPosParam [cgGetNamedParameter $::g_OceanShader "LightPos"] # Load our programs cgGLLoadProgram $::g_CloudShader set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgGLLoadProgram CloudShader: $retVal" } cgGLLoadProgram $::g_OceanShader set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgGLLoadProgram OceanShader: $retVal" } cgGLLoadProgram $::g_SunShader set retVal [tcl3dCgGetError $::g_context] if { $retVal ne "" } { error "cgGLLoadProgram SunShader: $retVal" } CreateNoiseTexture # Create texture surface set ::g_textureId [tcl3dVector GLuint 1] glGenTextures 1 $::g_textureId glBindTexture GL_TEXTURE_2D [$::g_textureId get 0] glEnable GL_TEXTURE_2D glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR 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_LUMINANCE \ $::g_TexWidth $::g_TexWidth \ 0 GL_LUMINANCE GL_FLOAT $::g_NoiseTex glDisable GL_TEXTURE_2D } proc Render {} { glClear GL_COLOR_BUFFER_BIT glColor3f 0.0 0.0 0.0 glEnable GL_TEXTURE_2D glBindTexture GL_TEXTURE_2D [$::g_textureId get 0] # the sun cgGLBindProgram $::g_SunShader cgGLEnableProfile $::g_profile glTranslatef 0.0 -0.1 -10.0 glutSolidSphere 1.5 30 30 glTranslatef -1.0 0.1 10.0 glTranslatef 0.0 -0.2 0.0 # the sky glEnable GL_BLEND glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA cgGLBindProgram $::g_CloudShader # Prepare first texture # OPA TODO cgGLActiveTexture $::g_NoiseTex # the light position cgGLSetParameter4f $::LightPosParam \ [lindex $::g_lightPos 0] [lindex $::g_lightPos 1] \ [lindex $::g_lightPos 2] 1.0 glBegin GL_QUADS glTexCoord2f 0.0 0.0; glVertex3f -10.0 1.0 1.0 glTexCoord2f 1.0 0.0; glVertex3f 10.0 1.0 1.0 glTexCoord2f 1.0 1.0; glVertex3f 10.0 0.0 -10.0 glTexCoord2f 0.0 1.0; glVertex3f -10.0 0.0 -10.0 glEnd glDisable GL_BLEND # the ocean cgGLBindProgram $::g_OceanShader glBegin GL_QUADS glTexCoord2f 0 0; glVertex3f -10.0 -1.0 1.0 glTexCoord2f 1 0; glVertex3f 10.0 -1.0 1.0 glTexCoord2f 1 1; glVertex3f 10.0 0.0 -10.0 glTexCoord2f 0 1; glVertex3f -10.0 0.0 -10.0 glEnd cgGLDisableProfile $::g_profile } proc CreateNoiseTexture {} { for { set i 0 } { $i < $::g_TexWidth } { incr i } { for { set j 0 } { $j < $::g_TexWidth } { incr j } { set ind [expr {$i*$::g_TexWidth + $j}] # We are using the low-level tcl3dVector access functions # here for speed issues. GLfloat_setitem $::g_NoiseTex $ind \ [expr {([PRNGenerator $ind] + 1.0) / 2}] } } } proc PRNGenerator { x } { set x [expr ($x << 13) ^ $x] set Prime1 15731 set Prime2 789221 set Prime3 1376312589 return [expr {(1.0 - (($x * ($x*$x*$Prime1 + $Prime2) + $Prime3) & \ 0x7fffffff) / 1073741824.0)}] } 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 1 0 0 0 0 1 0 glRotatef $::g_RotationX 0 1 0 glRotatef $::g_RotationY 1 0 0 Render glPopMatrix $toglwin swapbuffers } proc CreateCallback { toglwin } { glClearColor 0.0 0.0 0.0 1.0 glDisable GL_LIGHTING InitCgShader } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity # Calculate the aspect ratio of the window */ gluPerspective 60.0 [expr double($w)/double($h)] 0.01 1000.0 glMatrixMode GL_MODELVIEW glLoadIdentity } proc Cleanup {} { if { [info exists ::g_textureId] } { glDeleteTextures 1 [$::g_textureId get 0] $::g_textureId delete } $::g_NoiseTex delete cgDestroyContext $::g_context foreach var [info globals g_*] { uplevel #0 unset $var } } # 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 512 -height 512 \ -double true -depth true -alpha 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: Fire in the sky" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .