# 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-2026, 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]
