OUTPUT BUFFER:
# Lesson28.tcl # # David Nikdel & NeHe's Bezier Tutorial # # This Code Was Published By Jeff Molofee 2000 # Code Was Created By David Nikdel For NeHe Productions # 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/29 # See www.tcl3d.org for the Tcl3D extension. package require Img 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 gDemo(scriptDir) [file dirname [info script]] # Display mode. set fullScreen false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set rotz 0.0 ; # Rotation about the Z axis set rotzSpeed 0.5 ; # Rotation increment, i.e. speed set showCPoints true ; # Toggles displaying the control point grid (NEW) set divs 7 ; # Number of intrapolations (conrols poly resolution) (NEW) # 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 { $::fullScreen } { SetFullScreenMode . set ::fullScreen false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::fullScreen true } } proc IncrRotSpeed { val } { set ::rotzSpeed [expr $::rotzSpeed + $val] } proc IncrNumDivs { val } { global patch set ::divs [expr $::divs + $val] if { $::divs < 1 } { set ::divs 1 } set patch(dlBPatch) [genBezier $::divs] ; # Update the patch .fr.toglwin postredisplay } proc ToggleShowPoints {} { set ::showCPoints [expr ! $::showCPoints] .fr.toglwin postredisplay } # Adds 2 points. Don't just use '+' ;) proc pointAdd { p q } { set r [list 0.0 0.0 0.0] lset r 0 [expr {[lindex $p 0] + [lindex $q 0]}] lset r 1 [expr {[lindex $p 1] + [lindex $q 1]}] lset r 2 [expr {[lindex $p 2] + [lindex $q 2]}] return $r } # Multiplies a point and a constant. Don't just use '*' proc pointTimes { c p } { set r [list 0.0 0.0 0.0] lset r 0 [expr {[lindex $p 0] * $c}] lset r 1 [expr {[lindex $p 1] * $c}] lset r 2 [expr {[lindex $p 2] * $c}] return $r } # Calculates 3rd degree polynomial based on 4 points # and a single variable (u) which is generally between 0 and 1 proc Bernstein { u p0 p1 p2 p3 } { set a [pointTimes [expr pow($u,3)] $p0] set b [pointTimes [expr 3*pow($u,2)*(1-$u)] $p1] set c [pointTimes [expr 3*$u*pow((1-$u),2)] $p2] set d [pointTimes [expr pow((1-$u),3)] $p3] set r [pointAdd [pointAdd $a $b] [pointAdd $c $d]] return $r } # Generates a display list based on the data in the patch # and the number of divisions proc genBezier { divs } { global patch set u 0 set v 0 set drawlist [glGenLists 1] ; # make the display list # get rid of any old display lists if { [info exists patch(dlBPatch)] } { glDeleteLists $patch(dlBPatch) 1 } set temp0 $patch(anchors,0,3) ; # the first derived curve (along x axis) set temp1 $patch(anchors,1,3) set temp2 $patch(anchors,2,3) set temp3 $patch(anchors,3,3) # create the first line of points for { set v 0 } { $v <= $divs } { incr v } { set px [expr double($v)/double($divs)] ; # percent along x axis # use the 4 points from the derives curve to calculate the points along that curve set last($v) [Bernstein $px $temp0 $temp1 $temp2 $temp3] } glNewList $drawlist GL_COMPILE ; # Start a new display list glBindTexture GL_TEXTURE_2D [$patch(texture) get 0] ; # Bind the texture for { set u 1 } { $u <= $divs } { incr u } { set py [expr double($u)/double($divs)] ; # percent along y axis set pyold [expr (double($u)-1.0)/double($divs)] ; # Percent along old Y axis # Calculate new bezier points set temp0 [Bernstein $py $patch(anchors,0,0) $patch(anchors,0,1) $patch(anchors,0,2) $patch(anchors,0,3)] set temp1 [Bernstein $py $patch(anchors,1,0) $patch(anchors,1,1) $patch(anchors,1,2) $patch(anchors,1,3)] set temp2 [Bernstein $py $patch(anchors,2,0) $patch(anchors,2,1) $patch(anchors,2,2) $patch(anchors,2,3)] set temp3 [Bernstein $py $patch(anchors,3,0) $patch(anchors,3,1) $patch(anchors,3,2) $patch(anchors,3,3)] glBegin GL_TRIANGLE_STRIP ; # Begin a new triangle strip for { set v 0 } { $v <= $divs } { incr v } { set px [expr double($v)/double($divs)] ; # percent along x axis glTexCoord2f $pyold $px ; # Apply the old texture coords glVertex3d [lindex $last($v) 0] \ [lindex $last($v) 1] \ [lindex $last($v) 2] ; # Old Point # Generate new point set last($v) [Bernstein $px $temp0 $temp1 $temp2 $temp3] glTexCoord2f $py $px ; # Apply the new texture coords glVertex3d [lindex $last($v) 0] \ [lindex $last($v) 1] \ [lindex $last($v) 2] ; # New Point } glEnd ; # END the triangle srip } glEndList ; # END the list return $drawlist ; # Return the display list } # set the bezier vertices proc initBezier {} { global patch set patch(anchors,0,0) [list -0.75 -0.75 -0.5] set patch(anchors,0,1) [list -0.25 -0.75 0.0] set patch(anchors,0,2) [list 0.25 -0.75 0.0] set patch(anchors,0,3) [list 0.75 -0.75 -0.5] set patch(anchors,1,0) [list -0.75 -0.25 -0.75] set patch(anchors,1,1) [list -0.25 -0.25 0.5] set patch(anchors,1,2) [list 0.25 -0.25 0.5] set patch(anchors,1,3) [list 0.75 -0.25 -0.75] set patch(anchors,2,0) [list -0.75 0.25 0.0] set patch(anchors,2,1) [list -0.25 0.25 -0.5] set patch(anchors,2,2) [list 0.25 0.25 -0.5] set patch(anchors,2,3) [list 0.75 0.25 0.0] set patch(anchors,3,0) [list -0.75 0.75 -0.5] set patch(anchors,3,1) [list -0.25 0.75 -1.0] set patch(anchors,3,2) [list 0.25 0.75 -1.0] set patch(anchors,3,3) [list 0.75 0.75 -0.5] } proc LoadImage { imgName numChans } { if { $numChans != 3 && $numChans != 4 } { error "Error: Only 3 or 4 channels allowed ($numChans supplied)" } set texName [file join $::gDemo(scriptDir) "Data" $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 LoadGLTexture {} { global patch set imgInfo [LoadImage "NeHe.bmp" 3] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] set patch(texture) [tcl3dVector GLuint 1] ; # Storage For 1 Texture # Create The Textures glGenTextures 1 $patch(texture) glBindTexture GL_TEXTURE_2D [$patch(texture) get 0] glTexImage2D GL_TEXTURE_2D 0 3 $imgWidth $imgHeight \ 0 GL_RGB GL_UNSIGNED_BYTE $imgData glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR # Delete the image data vector. $imgData delete } # 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 100.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 } { global patch glEnable GL_TEXTURE_2D ; # Enable Texture Mapping glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.05 0.05 0.05 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 initBezier ; # Initialize the Bezier's control grid LoadGLTexture ; # Load the texture set patch(dlBPatch) [genBezier $::divs] ; # Generate the patch } # Here's Where We Do All The Drawing proc DisplayCallback { toglwin } { global patch if { [info exists ::animateId] } { set ::rotz [expr $::rotz + $::rotzSpeed] } # 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 -4.0 glRotatef -75.0 1.0 0.0 0.0 glRotatef $::rotz 0.0 0.0 1.0 ; # Rotate The Triangle On The Z axis ( NEW ) glCallList $patch(dlBPatch) ; # Call the Bezier's display list # this need only be updated when the patch changes if { $::showCPoints } { glDisable GL_TEXTURE_2D glColor3f 1.0 0.0 0.0 for { set i 0 } { $i < 4 } { incr i } { # draw the horizontal lines glBegin GL_LINE_STRIP for { set j 0 } { $j < 4 } { incr j } { glVertex3dv $patch(anchors,$i,$j) } glEnd } for { set i 0 } { $i < 4 } { incr i } { # draw the vertical lines glBegin GL_LINE_STRIP for { set j 0 } { $j < 4 } { incr j } { glVertex3dv $patch(anchors,$j,$i) } glEnd } glColor3f 1.0 1.0 1.0 glEnable GL_TEXTURE_2D } $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 } } # 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 $::listFont -height 6 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: David Nikdel & NeHe's Bezier Tutorial (Lesson 28)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .