Demo 24 of 68 in category RedBook
 |
# feedback.tcl
#
# An example of the OpenGL red book modified to work with Tcl3D.
# The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc.
# The Tcl3D sources are Copyright (c) 2005-2022, Paul Obermeier.
# See file LICENSE for complete license information.
#
# This program demonstrates use of OpenGL feedback. First,
# a lighting environment is set up and a few lines are drawn.
# Then feedback mode is entered, and the same lines are
# drawn. The results in the feedback buffer are printed.
package require tcl3d
tcl3dConsoleCreate .tcl3dOutputConsole "# " "Feedback Output"
set feedBuffer [tcl3dVector GLfloat 1024]
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
# 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
}
}
proc CreateCallback { toglwin } {
glEnable GL_LIGHTING
glEnable GL_LIGHT0
}
# Draw a few lines and two points, one of which will
# be clipped. If in feedback mode, a passthrough token
# is issued between the each primitive.
#
proc drawGeometry { mode } {
glBegin GL_LINE_STRIP
glNormal3f 0.0 0.0 1.0
glVertex3f 30.0 30.0 0.0
glVertex3f 50.0 60.0 0.0
glVertex3f 70.0 40.0 0.0
glEnd
if { $mode == $::GL_FEEDBACK } {
glPassThrough 1.0
}
glBegin GL_POINTS
glVertex3f -100.0 -100.0 -100.0 ; # will be clipped
glEnd
if { $mode == $::GL_FEEDBACK } {
glPassThrough 2.0
}
glBegin GL_POINTS
glNormal3f 0.0 0.0 1.0
glVertex3f 50.0 50.0 0.0
glEnd
}
# Write contents of one vertex to stdout.
proc print3DcolorVertex { size } {
puts -nonewline " "
for { set i 0 } { $i < 7 } { incr i } {
puts -nonewline [format "%4.2f " \
[$::feedBuffer get [expr $size- $::count]]]
set ::count [expr $::count - 1]
}
puts ""
}
# Write contents of entire buffer. (Parse tokens!)
proc printBuffer { size } {
set ::count $size
while { $::count } {
set token [$::feedBuffer get [expr $size-$::count]]
incr ::count -1
if { $token == $::GL_PASS_THROUGH_TOKEN } {
puts "GL_PASS_THROUGH_TOKEN"
puts [format " %4.2f" [$::feedBuffer get [expr $size-$::count]]]
incr ::count -1
} elseif { $token == $::GL_POINT_TOKEN } {
puts "GL_POINT_TOKEN"
print3DcolorVertex $size
} elseif { $token == $::GL_LINE_TOKEN } {
puts "GL_LINE_TOKEN"
print3DcolorVertex $size
print3DcolorVertex $size
} elseif { $token == $::GL_LINE_RESET_TOKEN } {
puts "GL_LINE_RESET_TOKEN"
print3DcolorVertex $size
print3DcolorVertex $size
}
}
}
proc DisplayCallback { toglwin } {
glMatrixMode GL_PROJECTION
glLoadIdentity
glOrtho 0.0 100.0 0.0 100.0 0.0 1.0
glClearColor 0.0 0.0 0.0 0.0
glClear GL_COLOR_BUFFER_BIT
drawGeometry $::GL_RENDER
glFeedbackBuffer 1024 GL_3D_COLOR $::feedBuffer
glRenderMode GL_FEEDBACK
drawGeometry $::GL_FEEDBACK
set size [glRenderMode GL_RENDER]
printBuffer $size
glFlush
$toglwin swapbuffers
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
}
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 400 -height 400 -double true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 1
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: OpenGL Red Book example feedback"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
