no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 13)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
# Mandelbrot shader using GPGPU techniques
#
# Author: Gabriel Zachmann, June 2007
#
# The code is derived from ../fbo_demo/saxpy.cpp
#
# The original code can be found at:
# http://zach.in.tu-clausthal.de/teaching/cg2_08/downloads/simple_glsl_demos.tar.gz
#
# Modified and extended for Tcl3D by Paul Obermeier 2009/01/04
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d 0.4.0

tcl3dOglSetNormalMode

tcl3dConsoleCreate .tcl3dOutputConsole "# " "Info Messages"

# Font to be used in the Tk listbox.
set g_listFont {-family {Courier} -size 10}

set g_WinWidth  512
set g_WinHeight 512

set g_Stopwatch [tcl3dNewSwatch]
tcl3dStartSwatch $::g_Stopwatch

# command line options
set g_Opts(NumIter)         50      ; # Number of function iterations
set g_Opts(RangeCenter,0) -0.6
set g_Opts(RangeCenter,1)  0.0
set g_Opts(RangeSize)      3.0      ; # Square section of the Mandelbrot set

# Stack for holding zoom parameters.
lappend gBox(stack) [list $g_Opts(RangeCenter,0) $g_Opts(RangeCenter,1) $g_Opts(RangeSize)]

# Will be set to true in CreateCallback, if all needed OpenGL extensions are available.
set g_Opts(haveOglExtensions) false 

set g_Opts(TexSize,X)      $::g_WinWidth  ; # Resolution of the range of the M-set
set g_Opts(TexSize,Y)      $::g_WinHeight ; # Resolution of the range of the M-set

set g_ColorMethods [list "Random" "Renorm"]
set g_Opts(ColorMethod)  "Renorm"

set g_Opts(BackColor)  #00FF00
set g_Opts(InnerColor) #FF0000
set g_Opts(OuterColor) #0000FF
set g_Opts(BandFrequ)  0.02

set gBox(x1) 100
set gBox(x2) 300
set gBox(y1) 100
set gBox(y2) 300
set gBox(draw) 0

set attachmentpoints [list $::GL_COLOR_ATTACHMENT0_EXT $::GL_COLOR_ATTACHMENT1_EXT]

# 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 PrintGeneralInfo {} {
    global tcl_platform

    if { ! [winfo exists .fr.info] } {
        return
    }
    if { $::g_Opts(RenderMethod) eq "GLSL" } {
        .fr.info configure -text \
                 [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \
                  $tcl_platform(os) [glGetString GL_RENDERER] \
                  [glGetString GL_VERSION] [info patchlevel]]
    } elseif { $::g_Opts(RenderMethod) eq "Tcl" } {
        .fr.info configure -text \
                 [format "Running on %s with a Tcl implementation (Tcl %s)" \
                  $tcl_platform(os) [info patchlevel]]
    } else {
        .fr.info configure -text \
                 [format "Running on %s with a C implementation (Tcl %s)" \
                  $tcl_platform(os) [info patchlevel]]
    }
    #update
}

proc PrintTiming { secs } {
    puts [format "%d x %d (%d pixels) with %d iterations: %.3f secs" \
          $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y) \
          [expr $::g_Opts(TexSize,X) * $::g_Opts(TexSize,Y)] \
                $::g_Opts(NumIter) $secs]
}

proc CheckExtProc { extProc } {
    if { ![tcl3dOglHaveFunc $extProc] } {
        puts "Extension procedure $extProc not available"
        return false
    }
    return true
}

proc CheckGLErrors { msg } {
    set errMsg [tcl3dOglGetError]
    if { $errMsg eq "" } {
        return
    }
    puts "$msg: $errMsg"
}

# Check framebuffer status.
# Copied directly out of the spec, modified to deliver a return value.
proc CheckFramebufferStatus {} {
    set status [glCheckFramebufferStatusEXT GL_FRAMEBUFFER_EXT]
    if { $status == $::GL_FRAMEBUFFER_COMPLETE_EXT } {
        return true
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT } {
        puts "Framebuffer incomplete, incomplete attachment"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_UNSUPPORTED_EXT } {
        puts "Unsupported framebuffer format"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT } {
        puts "Framebuffer incomplete, missing attachment"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT } {
        puts "Framebuffer incomplete, attached images must have same dimensions"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT } {
        puts "Framebuffer incomplete, attached images must have same format"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT } {
        puts "Framebuffer incomplete, missing draw buffer"
        return false
    }  elseif { $status == $::GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT } {
        puts "Framebuffer incomplete, missing read buffer"
        return false
    } else {
        puts "Unknown status $status"
        return false
    }
}

# Set up a floating point texture with NEAREST filtering.
# (mipmaps etc. are unsupported for floating point textures)
proc SetupTexture { texID } {
    # make active and bind
    glBindTexture GL_TEXTURE_2D $texID

    # turn off filtering and wrap modes!
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP

    # define texture with floating point format
    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA32F_ARB \
                 $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y) 0 GL_RGBA GL_FLOAT NULL

    # check if that worked
    CheckGLErrors "SetupTexture"
}

# Transfer data to texture.
# Check web page for detailed explanation on the difference between ATI and NVIDIA.
proc TransferToTexture { data texID } {
    # version (a): HW-accelerated on NVIDIA
    glBindTexture GL_TEXTURE_2D $texID
    glTexSubImage2D GL_TEXTURE_2D 0 0 0 $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y) \
                    GL_RGBA GL_FLOAT $data

    # version (b): HW-accelerated on ATI
    # This version not tested with Tcl3D. Don't have a ATI card.
    # glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT GL_COLOR_ATTACHMENT0_EXT GL_TEXTURE_2D $texID 0
    # glDrawBuffer GL_COLOR_ATTACHMENT0_EXT
    # glRasterPos2i 0 0
    # glDrawPixels $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y) GL_RGBA GL_FLOAT $data
    # glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT GL_COLOR_ATTACHMENT0_EXT GL_TEXTURE_2D 0 0
}

proc CreateTextures {} {
    # create textures
    glGenTextures 2 $::g_TexId

    # set up textures
    SetupTexture [$::g_TexId get $::readTex]
    SetupTexture [$::g_TexId get $::writeTex]

    # set texenv mode from modulate (the default) to replace)
    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE

    # check if something went completely wrong
    CheckGLErrors "CreateTextures"
}

#
# Create framebuffer object, bind it to reroute rendering operations
# from the traditional framebuffer to the off-screen buffer
#
proc InitFBO {} {
    # create FBO (off-screen framebuffer)
    glGenFramebuffersEXT 1 $::g_FBO

    # bind offscreen framebuffer (that is, skip the window-specific render target)
    glBindFramebufferEXT GL_FRAMEBUFFER_EXT [$::g_FBO get 0]

    # create 'viewport' exactly with same dimensions as the texture(s)
    glViewport 0 0 $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y)

    # orthographic projection for 1:1 pixel=texture mapping
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluOrtho2D 0.0 $::g_Opts(TexSize,X) 0.0 $::g_Opts(TexSize,Y)
    glMatrixMode GL_MODELVIEW
    glLoadIdentity

    # check if something went completely wrong
    CheckGLErrors "InitFBO"
}

proc ReadShaderFile { fileName } {
    set pathName [file join $::g_ScriptDir $fileName]
    set realPath [tcl3dGetExtFile $pathName]
    set retVal [catch {open $realPath r} fp]
    if { $retVal == 0 } {
        set buffer [read $fp]
        close $fp
    } else {
        error "Cannot open shader file $realPath"
    }
    return $buffer
}

proc LoadAttachShader { program_id shader_id filename } {
    set shadersource [ReadShaderFile $filename]

    tcl3dOglShaderSource $shader_id $shadersource
    glCompileShader $shader_id
    glAttachShader $program_id $shader_id
}

proc SetShaders { vert_source frag_source } {
    set sh_prog_id [glCreateProgram]

    if { $vert_source ne "" } {
        set s_id [glCreateShader GL_VERTEX_SHADER]
        LoadAttachShader $sh_prog_id $s_id $vert_source
    }

    if { $frag_source ne "" } {
        set s_id [glCreateShader GL_FRAGMENT_SHADER]
        LoadAttachShader $sh_prog_id $s_id $frag_source
    }

    glLinkProgram $sh_prog_id

    glUseProgram $sh_prog_id

    return $sh_prog_id
}

#
# Performs the actual calculation.
#
proc PerformComputation {} {
    # attach two textures to FBO
    # because it's much faster to select a new render target via glDrawBuffer(),
    # than to attach a different texture
    glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT \
                              [lindex $::attachmentpoints $::writeTex] \
                              GL_TEXTURE_2D [$::g_TexId get $::writeTex] 0
    CheckGLErrors "perform 0"
    glFramebufferTexture2DEXT GL_FRAMEBUFFER_EXT \
                              [lindex $::attachmentpoints $::readTex] \
                              GL_TEXTURE_2D [$::g_TexId get $::readTex] 0
    CheckGLErrors "perform 1"

    # check if that worked
    if { ! [CheckFramebufferStatus] } {
        puts "glFramebufferTexture2DEXT failed!"
        exit
    }

    # 1st phase: init array with z_1 = c
    set sh_prog_id [SetShaders "mandelbrot1.vert" "mandelbrot1.frag"]

    set range_center_uni [glGetUniformLocation $sh_prog_id "RangeCenter"]
    glUniform2f $range_center_uni $::g_Opts(RangeCenter,0) $::g_Opts(RangeCenter,1)
    set range_size_uni [glGetUniformLocation $sh_prog_id "RangeSize"]
    glUniform1f $range_size_uni $::g_Opts(RangeSize)

    # Calling glFinish() is only neccessary to get accurate timings,
    # and we need a high number of iterations to avoid timing noise.
    glFinish

    tcl3dResetSwatch $::g_Stopwatch
    set startTime [tcl3dLookupSwatch $::g_Stopwatch]

    # fill texture with initial values (z_1)
    RenderScreenSizedQuad

    # swap role of the two textures (read-only source becomes
    # write-only target and the other way round):
    SwapTextures

    # 2nd phase: do the iteration to compute z_i
    set sh_prog_id [SetShaders "mandelbrot2.vert" "mandelbrot2.frag"]

    set zi_minus_1_uni [glGetUniformLocation $sh_prog_id "zi_minus_1"]
    glUniform1i $zi_minus_1_uni 0 ; # tex unit 0
    set range_center_uni [glGetUniformLocation $sh_prog_id "RangeCenter"]
    glUniform2f $range_center_uni $::g_Opts(RangeCenter,0) $::g_Opts(RangeCenter,1)
    set range_size_uni [glGetUniformLocation $sh_prog_id "RangeSize"]
    glUniform1f $range_size_uni $::g_Opts(RangeSize)
    set cur_iteration_uni [glGetUniformLocation $sh_prog_id "curIteration"]

    for { set i 1 } { $i <= $::g_Opts(NumIter) } { incr i } {
        # pass in new iteration value
        glUniform1f $cur_iteration_uni $i

        # set render destination
        glDrawBuffer [lindex $::attachmentpoints $::writeTex]

        # enable "read" texture (read-only), which contains results
        # from last iteration
        glBindTexture GL_TEXTURE_2D [$::g_TexId get $::readTex]

        # make quad filled to hit every pixel/texel
        RenderScreenSizedQuad

        # swap role of the two textures (read-only source becomes
        # write-only target and the other way round):
        SwapTextures
    }

    # 3rd phase: compute nice colors from the iteration count stored in each texel
    set sh_prog_id [SetShaders "mandelbrot3.vert" "mandelbrot3.frag"]

    set zn_uni [glGetUniformLocation $sh_prog_id "zn"]
    glUniform1i $zn_uni 0
    set max_iter_uni [glGetUniformLocation $sh_prog_id "MaxIterations"]
    glUniform1f $max_iter_uni $::g_Opts(NumIter)

    set back_color_uni [glGetUniformLocation $sh_prog_id "BackColor"]
    eval glUniform4f $back_color_uni [tcl3dName2rgbaf $::g_Opts(BackColor)]

    set inner_color_uni [glGetUniformLocation $sh_prog_id "InnerColor"]
    eval glUniform4f $inner_color_uni [tcl3dName2rgbaf $::g_Opts(InnerColor)]

    set outer_color_uni [glGetUniformLocation $sh_prog_id "OuterColor"]
    eval glUniform4f $outer_color_uni [tcl3dName2rgbaf $::g_Opts(OuterColor)]

    set band_frequ_uni [glGetUniformLocation $sh_prog_id "BandFrequ"]
    glUniform1f $band_frequ_uni $::g_Opts(BandFrequ)

    set colorMethod [glGetUniformLocation $sh_prog_id "ColorMethod"]
    if { $::g_Opts(ColorMethod) eq "Random" } {
        glUniform1f $colorMethod 0
    } else {
        glUniform1f $colorMethod 1
    }

    glDrawBuffer [lindex $::attachmentpoints $::writeTex]
    glBindTexture GL_TEXTURE_2D [$::g_TexId get $::readTex]
    RenderScreenSizedQuad
    SwapTextures

    # done, stop timer, calc MFLOP/s if neccessary
    glFinish

    set endTime [tcl3dLookupSwatch $::g_Stopwatch]
    PrintTiming [expr $endTime - $startTime]

    # done, just do some checks if everything went smoothly.
    CheckFramebufferStatus
    CheckGLErrors "PerformComputation"
    #puts "[tcl3dOglGetProgramInfoLog $sh_prog_id]"
}

#
# swaps the role of the two y-textures (read-only and write-only)
# Think of "pointer swapping".
#
proc SwapTextures {} {
    set h  $::writeTex
    set ::writeTex  $::readTex
    set ::readTex $h
}

proc RenderScreenSizedQuad {} {
    # make quad filled to hit every pixel/texel
    # (should be default but we never know)
    glPolygonMode GL_FRONT GL_FILL

    # and render the quad with normalized texcoords
    set xSize [expr $::g_Opts(TexSize,X) -0]
    set ySize [expr $::g_Opts(TexSize,Y) -0]
    set xoff 0.5
    set yoff 0.5
    set xtoff [expr (0.5) / $::g_Opts(TexSize,X)]
    set ytoff [expr (0.5 + $::g_Opts(TexSize,Y)) / $::g_Opts(TexSize,Y)]
    set xtoff 0.0
    set ytoff 0.0
    #puts "xtoff = $xtoff ytoff = $ytoff"
    glBegin GL_QUADS
        glTexCoord2f [expr 0.0 + $xtoff] [expr 0.0 + $ytoff] ; glVertex2f [expr 0.0 + $xoff]    [expr 0.0 + $yoff]
        glTexCoord2f [expr 1.0 + $xtoff] [expr 0.0 + $ytoff] ; glVertex2f [expr $xSize + $xoff] [expr 0.0 + $yoff]
        glTexCoord2f [expr 1.0 + $xtoff] [expr 1.0 + $ytoff] ; glVertex2f [expr $xSize + $xoff] [expr $ySize + $yoff]
        glTexCoord2f [expr 0.0 + $xtoff] [expr 1.0 + $ytoff] ; glVertex2f [expr 0.0 + $xoff]    [expr $ySize + $yoff]
    glEnd
}

proc CalculateWithGLSL {} {
    Reset

    InitFBO        ; # init off-screen framebuffer
    CreateTextures ; # create textures for vectors
    PerformComputation ; # and start computation

    # show final result, which is in the "read" texture
    glUseProgram 0 ; # use fixed-function pipeline
}

proc GetRenormalizedColor { re im n } {
    if { $n >= $::g_Opts(NumIter) }  {
        return $::g_Opts(BackColor)
    }
    set innerColor [tcl3dName2rgb $::g_Opts(InnerColor)]
    set outerColor [tcl3dName2rgb $::g_Opts(OuterColor)]
    set len [expr {sqrt ($re*$re + $im*$im)}]
    set f [expr {$n + 1.0 - log (log ($len)) / log(2) }]
    set mix1 [expr {$f * $::g_Opts(BandFrequ)}]
    if { $mix1 > 1.0 } {
        set mix1 1.0 
    }
    set mix2 [expr {1.0 - $mix1}]
    return [tcl3dRgb2Name \
            [expr {int ($mix2 * [lindex $innerColor 0] + \
                        $mix1 * [lindex $outerColor 0])}] \
            [expr {int ($mix2 * [lindex $innerColor 1] + \
                        $mix1 * [lindex $outerColor 1])}] \
            [expr {int ($mix2 * [lindex $innerColor 2] + \
                        $mix1 * [lindex $outerColor 2])}]]
}

proc GetRandomColor { n } {
    global g_Colors

    return $g_Colors($n)
}

proc SetupRandomColors {} {
    global g_Colors

    set randomGen [tcl3dNewRandomGen 0]
    for { set i 0 } { $i < $::g_Opts(NumIter) } { incr i } {
        set g_Colors($i) [tcl3dRgb2Name \
                          [tcl3dGetRandomInt $randomGen 0 255] \
                          [tcl3dGetRandomInt $randomGen 0 255] \
                          [tcl3dGetRandomInt $randomGen 0 255]]
    }
    set g_Colors($::g_Opts(NumIter)) $::g_Opts(BackColor)
    tcl3dDeleteRandomGen $randomGen
}

proc CalculateWithC {} {
    PhotoImage blank
    PhotoImage config -width $::g_Opts(TexSize,X) -height $::g_Opts(TexSize,Y)

    foreach { br bg bb } [tcl3dName2rgb $::g_Opts(BackColor)]  { break }
    foreach { ir ig ib } [tcl3dName2rgb $::g_Opts(InnerColor)] { break }
    foreach { or og ob } [tcl3dName2rgb $::g_Opts(OuterColor)] { break }

    tcl3dResetSwatch $::g_Stopwatch
    set startTime [tcl3dLookupSwatch $::g_Stopwatch]

    tcl3dUtilFractalToPhoto PhotoImage $::g_Opts(ColorMethod) \
        $::g_Opts(TexSize,X) $::g_Opts(TexSize,Y) \
        $::g_Opts(RangeCenter,0) $::g_Opts(RangeCenter,1) $::g_Opts(RangeSize) \
        $::g_Opts(NumIter) $::g_Opts(BandFrequ) \
        $br $bg $bb \
        $ir $ig $ib \
        $or $og $ob

    set endTime [tcl3dLookupSwatch $::g_Stopwatch]
    PrintTiming [expr $endTime - $startTime]
    update
}

proc CalculateWithTcl {} {
    PhotoImage blank
    PhotoImage config -width $::g_Opts(TexSize,X) -height $::g_Opts(TexSize,Y)
    SetupRandomColors

    set xScale [expr {$::g_Opts(RangeSize) / $::g_Opts(TexSize,X)}]
    set yScale [expr {$::g_Opts(RangeSize) / $::g_Opts(TexSize,Y)}]
    set Rmin [expr {$::g_Opts(RangeCenter,0) - $::g_Opts(RangeSize)*0.5}]
    set Imin [expr {$::g_Opts(RangeCenter,1) - $::g_Opts(RangeSize)*0.5}]

    tcl3dResetSwatch $::g_Stopwatch
    set startTime [tcl3dLookupSwatch $::g_Stopwatch]

    set step 4                                  ;# Do interlaced drawing
    set numIter $::g_Opts(NumIter)
    for {set start 0} {$start < $step} {incr start} {
        for {set x $start} {$x < $::g_Opts(TexSize,X)} {incr x $step} {
            set c_re [expr {$Rmin + $x * $xScale}]
            set data [list]
            for {set y [expr {$::g_Opts(TexSize,Y)-1}]} {$y >= 0} {incr y -1} {
                set c_im [expr {$Imin + $y * $yScale}]

                set z_re $c_re
                set z_im $c_im
                for {set n 0} {$n < $numIter} {incr n} {
                    set z_re2 [expr {$z_re * $z_re}] ; # Have we escaped yet?
                    set z_im2 [expr {$z_im * $z_im}]
                    if {($z_re2 + $z_im2) > 4} {
                        break
                    }
                    set z_im [expr {2 * $z_re * $z_im + $c_im}]
                    set z_re [expr {$z_re2 - $z_im2 + $c_re}]
                }
                if { $::g_Opts(ColorMethod) eq "Random" } {
                    lappend data [GetRandomColor $n]
                } else {
                    lappend data [GetRenormalizedColor $z_re $z_im $n]
                }
            }
            PhotoImage put $data -to $x 0
        }
        update
    }
    set endTime [tcl3dLookupSwatch $::g_Stopwatch]
    PrintTiming [expr $endTime - $startTime]
}

proc Update {} {
    set ::g_Opts(TexSize,X) $::g_Opts(TexSize)
    set ::g_Opts(TexSize,Y) $::g_Opts(TexSize)

    if { $::g_Opts(RenderMethod) eq "GLSL" } {
        CalculateWithGLSL
        DisplayCallback .fr.toglwin
    } elseif { $::g_Opts(RenderMethod) eq "Tcl" } {
        CalculateWithTcl
    } else {
        CalculateWithC
    }
}

proc CreateCallback { toglwin } {
    global g_Opts


    set g_Opts(haveOglExtensions) true
    if { ![tcl3dOglHaveExtension "GL_EXT_framebuffer_object"] } {
        puts "Extension GL_EXT_framebuffer_object missing"
        set g_Opts(haveOglExtensions) false
    }
    if { ![tcl3dOglHaveExtension "GL_ARB_texture_float"] } {
        puts "Extension GL_ARB_texture_float missing"
        set g_Opts(haveOglExtensions) false
    }
    if { ! [tcl3dOglHaveExtension "GL_ARB_texture_non_power_of_two"] } {
        puts "Extension GL_ARB_texture_non_power_of_two missing"
        set g_Opts(haveOglExtensions) false
    }
    set maxColorAttachments [tcl3dOglGetIntState GL_MAX_COLOR_ATTACHMENTS_EXT]
    if { $maxColorAttachments < 2 } {
        puts "Number of color attachments available is: $maxColorAttachments"
        puts "Needed for GLSL fractal generation are 2."
        set g_Opts(haveOglExtensions) false
    }

    set texSizeX $::g_Opts(TexSize,X)
    set texSizeY $::g_Opts(TexSize,Y)

    # check whether we can actually load textures of that size on the GPU
    glTexImage2D GL_PROXY_TEXTURE_2D 0 $::GL_RGBA32F_ARB \
                 $texSizeX $texSizeY 0 $::GL_RGBA GL_FLOAT NULL

    set realWidth [tcl3dVector GLint 1]
    glGetTexLevelParameteriv GL_PROXY_TEXTURE_2D 0 GL_TEXTURE_WIDTH $realWidth
    if { [$realWidth get 0] == 0 } {
        puts [format "Can't load textures of type GL_RGBA32F_ARB (Size %d x %d)." \
              $texSizeX $texSizeY]
        set g_Opts(haveOglExtensions) false
    }
    $realWidth delete

    if { ! [CheckExtProc "glGenFramebuffersEXT"] } {
        set g_Opts(haveOglExtensions) false
    }
    if { ! [CheckExtProc "glDeleteFramebuffersEXT"] } {
        set g_Opts(haveOglExtensions) false
    }
    if { ! [CheckExtProc "glFramebufferTexture2DEXT"] } {
        set g_Opts(haveOglExtensions) false
    }
    if { ! $g_Opts(haveOglExtensions) } {
        puts "GLSL mode disabled because of missing prerequisites."
    }
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    global g_Opts

    if { $g_Opts(RenderMethod) eq "GLSL" } {
        set w [$toglwin width]
        set h [$toglwin height]
    }

    set ::g_WinWidth  $w
    set ::g_WinHeight $h

    if { 0 && $g_Opts(RenderMethod) eq "GLSL" } {
        glViewport 0 0 $fractalSize $fractalSize

        glMatrixMode GL_PROJECTION
        glLoadIdentity

        gluOrtho2D 0.0 $fractalSize 0.0 $fractalSize
        glMatrixMode GL_MODELVIEW
        glLoadIdentity
    }
}

proc DisplayCallback { toglwin } {
    # no clear necessary, since we draw the whole screen, and without z
    glMatrixMode GL_MODELVIEW

    glLoadIdentity
    # default for camera = 0,0,0; looking at -z; near = -1; far = +1

    # restore render destination to regular frame buffer
    glBindFramebufferEXT GL_FRAMEBUFFER_EXT 0

    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_TexId get $::readTex]

    # texture states; just to make sure
    glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP

    glColor3f 1 1 0
    RenderScreenSizedQuad

    DrawBoxTogl
    # no swap buffers here, because we don't animate anything
    glFinish
}

proc Reset {} {
    Cleanup false

    # Texture identifiers
    set ::g_TexId [tcl3dVector GLuint 2]

    # Framebuffer object identifier
    set ::g_FBO [tcl3dVector GLuint 1]

    # ping pong management vars
    set ::writeTex 0
    set ::readTex  1
}

proc Cleanup { { fullCleanup true } } {
    if { [info exists ::g_TexId] } {
        glDeleteTextures 2 [$::g_TexId get 0]
        $::g_TexId delete
    }
    if { [info exists ::g_FBO] } {
        glDeleteFramebuffersEXT  1 [$::g_FBO get 0]
        $::g_FBO delete
    }
    if { $fullCleanup } {
        tcl3dDeleteSwatch $::g_Stopwatch
        foreach var [info globals g_*] {
            uplevel #0 unset $var
        }
    }
}

proc ExitProg {} {
    exit
}

proc Center2Box {} {
    global gBox g_Opts

    set cx   $g_Opts(RangeCenter,0)
    set cy   $g_Opts(RangeCenter,1)
    set size $g_Opts(RangeSize)

    set gBox(x1) [expr {$cx - $size/2}]
    set gBox(y1) [expr {$cy - $size/2}]
    set gBox(x2) [expr {$cx + $size/2}]
    set gBox(y2) [expr {$cy + $size/2}]
}

proc Box2Center {} {
    global gBox g_Opts

    set x1 $gBox(x1)
    set y1 $gBox(y1)
    set x2 $gBox(x2)
    set y2 $gBox(y2)
    set dx [expr {$x2 - $x1}]
    set dy [expr {$y2 - $y1}]

    set g_Opts(RangeCenter,0) [expr {$x1 + $dx/2}]
    set g_Opts(RangeCenter,1) [expr {$y1 + $dy/2}]
    set g_Opts(RangeSize) [expr $dx>$dy? $dx : $dy]
}

proc Canvas2Z { winType x y } {
    global gBox g_Opts

    set xScale [expr {double($g_Opts(RangeSize)) / $::g_Opts(TexSize,X)}]
    set yScale [expr {double($g_Opts(RangeSize)) / $::g_Opts(TexSize,Y)}]

    set xMin [expr {$g_Opts(RangeCenter,0) - $g_Opts(RangeSize)/2}]
    set yMin [expr {$g_Opts(RangeCenter,1) - $g_Opts(RangeSize)/2}]

    set re [expr {$xMin + $xScale * $x}]
    if { $winType eq "Togl" } {
        set im [expr {$yMin + $yScale * $y}]
    } else {
        set im [expr {$yMin + $yScale * ($::g_WinHeight -1 - $y)}]
    }

    return [list $re $im]
}

proc ZoomOut { winType w } {
    global gBox g_Opts

    if { [llength $gBox(stack)] < 2 } {
        return
    }
    set a [lindex $gBox(stack) end-1]
    set gBox(stack) [lrange $gBox(stack) 0 end-1]

    foreach {g_Opts(RangeCenter,0) g_Opts(RangeCenter,1) g_Opts(RangeSize)} $a break
    Update
}

proc ZoomIn { winType w } {
    global gBox g_Opts

    foreach {Rmin Imin} [Canvas2Z $winType $gBox(x1) $gBox(y1)] break
    foreach {Rmax Imax} [Canvas2Z $winType $gBox(x2) $gBox(y2)] break

    set g_Opts(RangeCenter,0) [expr $Rmin + ($Rmax - $Rmin)/2]
    set g_Opts(RangeCenter,1) [expr $Imin + ($Imax - $Imin)/2]
    set g_Opts(RangeSize)     [expr $Rmax - $Rmin]
    puts "ZoomIn $g_Opts(RangeCenter,0) $g_Opts(RangeCenter,1) $g_Opts(RangeSize)"

    lappend gBox(stack) [list $g_Opts(RangeCenter,0) $g_Opts(RangeCenter,1) $g_Opts(RangeSize)]
    set gBox(draw) 0
    if { $winType eq "Canvas" } {
        DrawBoxCanvas $w
    }
    Update
}

# Draw an interactive zoom box on a Togl window. Used for GLSL render mode.
proc DrawBoxTogl {} {
    global gBox

    if { ! $gBox(draw) } {
        return
    }
    glDisable GL_LIGHTING
    glMatrixMode GL_PROJECTION
    glPushMatrix
        glLoadIdentity
        gluOrtho2D 0 $::g_Opts(TexSize,X) 0 $::g_Opts(TexSize,Y)
        glMatrixMode GL_MODELVIEW
        glPushMatrix
            glLoadIdentity
            glColor3f 1 1 1
            glBegin GL_LINE_LOOP
                glVertex2f $gBox(x1) $gBox(y1)
                glVertex2f $gBox(x2) $gBox(y1)
                glVertex2f $gBox(x2) $gBox(y2)
                glVertex2f $gBox(x1) $gBox(y2)
            glEnd
        glPopMatrix
        glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glEnable GL_LIGHTING
}

# Draw an interactive zoom box on a canvas widget. Used for Tcl and C render mode.
proc DrawBoxCanvas { w } {
    global gBox

    $w delete box
    if { $gBox(draw) } {
        $w create rect $gBox(x1) $gBox(y1) $gBox(x2) $gBox(y2) \
            -outline white -tag box \
            -dash 1
    }
}

# Handle the interactive zoom box. Used for all render modes.
proc HandleBox { what winType w x y} {
    global gBox

    if { $what == 0 } {                           ; # Button down
        set gBox(draw) 0
        set gBox(x1) $x
        set gBox(y1) $y
        if { $winType eq "Togl" } {
            set gBox(y1) [expr $::g_WinHeight -1 - $y]
        }
    } else {                                      ; # Button motion
        set gBox(draw) 1
        set gBox(x2) $x
        set gBox(y2) $y
        if { $winType eq "Togl" } {
            set gBox(y2) [expr $::g_WinHeight -1 - $y]
        }
    }

    if { $winType eq "Togl" } {
        $w postredisplay
    } else {
        DrawBoxCanvas $w
    }
}

# Choose a color for
proc GetColor { buttonId which } {
    global gPo

    set newColor [tk_chooseColor -initialcolor $::g_Opts($which)]
    if { $newColor ne "" } {
        set ::g_Opts($which) $newColor
        $buttonId configure -background $newColor
    }
    Update
}

proc InitPhoto {} {
    catch { image delete PhotoImage }
    image create photo PhotoImage -width $::g_Opts(TexSize,X) -height $::g_Opts(TexSize,Y)
}

proc InitCanvas {} {
    catch { destroy .fr.toglwin }
    if { $::g_Opts(RenderMethod) eq "GLSL" } {
        togl .fr.toglwin -width $::g_Opts(TexSize,X) -height $::g_Opts(TexSize,Y) \
                         -createproc CreateCallback   \
                         -reshapeproc ReshapeCallback \
                         -displayproc DisplayCallback
        set mode "Togl"
    } else {
        InitPhoto
        canvas .fr.toglwin -width $::g_Opts(TexSize,X) -height $::g_Opts(TexSize,Y) \
               -borderwidth 0 -relief flat -highlightthickness 0
        .fr.toglwin create image 0 0 -image PhotoImage -anchor nw -tag Image
        bind .fr.toglwin  "ReshapeCallback .fr.toglwin %w %h"
        set mode "Canvas"
    }
    bind .fr.toglwin          [list HandleBox 0 $mode %W %x %y]
    bind .fr.toglwin         [list HandleBox 1 $mode %W %x %y]
    bind .fr.toglwin   [list ZoomIn  $mode %W]
    bind .fr.toglwin          [list ZoomOut $mode %W]
    bind .fr.toglwin          [list ZoomOut $mode %W]
    bind .fr.toglwin  [list ZoomOut $mode %W]
    bind .  [list ZoomOut $mode %W]

    grid .fr.toglwin -row 0 -column 0 -sticky sw
}


proc InitRenderMethods {} {
    global g_RenderMethods g_Opts

    togl .fr.toglwin -width $::g_WinWidth -height $::g_WinHeight \
                     -createproc CreateCallback

    set g_RenderMethods [list "Tcl"]
    set g_Opts(RenderMethod) [lindex $g_RenderMethods end]

    if { [info commands tcl3dUtilFractalToPhoto] ne "" } {
        lappend g_RenderMethods "C"
        set g_Opts(RenderMethod) [lindex $g_RenderMethods end]
    }

    if { $g_Opts(haveOglExtensions) } {
        lappend g_RenderMethods "GLSL"
        set g_Opts(RenderMethod) [lindex $g_RenderMethods end]
    }
    destroy .fr.toglwin
}

proc ResetCanvas { args } {
    InitCanvas
    PrintGeneralInfo
    Update
}

proc SaveScreenShot { w fileName } {
    . configure -cursor watch
    update
    # Create a name on the file system, if running from within a Starpack.
    set fileName [tcl3dGenExtName $fileName]
    set imgName [file rootname $fileName]
    set imgExt ".ppm"
    set imgFmt "PPM"
    set imgOpt ""
    append imgName $imgExt
    after 300
    tcl3dWidget2File $w $imgName "" $imgFmt $imgOpt
    puts "Screenshot written to: $imgName"
    . configure -cursor top_left_arrow
}

proc SaveImg { w } {
    global g_Opts

    set fileName [format "mandelshot-%s" $g_Opts(RenderMethod)]
    SaveScreenShot $w $fileName
}

frame .fr
pack .fr -expand 1 -fill both

InitRenderMethods

Reset

InitCanvas

frame   .fr.btns
listbox .fr.usage -font $::g_listFont -height 2
label   .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.btns    -row 0 -column 1 -sticky news
grid .fr.usage   -row 1 -column 0 -sticky news -columnspan 2
grid .fr.info    -row 2 -column 0 -sticky news -columnspan 2
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1

.fr.usage insert end "Mouse-L Zoom in"
.fr.usage insert end "Mouse-R Step back"

frame .fr.btns.frTexSize
label .fr.btns.frTexSize.l -text "Texture size:"
tk_optionMenu .fr.btns.frTexSize.m g_Opts(TexSize) 512 256 128
pack .fr.btns.frTexSize -fill x -side top
pack .fr.btns.frTexSize.l .fr.btns.frTexSize.m -side left -expand 1 -fill x
trace variable g_Opts(TexSize) w ResetCanvas

frame .fr.btns.frIter
label .fr.btns.frIter.l -text "Iterations:" -anchor w
spinbox .fr.btns.frIter.e -textvariable ::g_Opts(NumIter) \
                          -command Update -width 10 \
                          -from 10 -to 1000 -increment 10
bind .fr.btns.frIter.e  Update

pack .fr.btns.frIter   -side top -fill x
pack .fr.btns.frIter.l -side left -expand 1 -fill x
pack .fr.btns.frIter.e -side left -expand 1 -fill x

frame .fr.btns.frCenterRe
label .fr.btns.frCenterRe.l  -text "Center Re:" -anchor w
spinbox .fr.btns.frCenterRe.e -textvariable ::g_Opts(RangeCenter,0) \
                              -command Update -width 10 \
                              -from -3.0 -to 3.0 -increment 0.1
bind .fr.btns.frCenterRe.e  Update
pack .fr.btns.frCenterRe   -side top -fill x
pack .fr.btns.frCenterRe.l -side left -expand 1 -fill x
pack .fr.btns.frCenterRe.e -side left -expand 1 -fill x

frame .fr.btns.frCenterIm
label .fr.btns.frCenterIm.l  -text "Center Im:" -anchor w
spinbox .fr.btns.frCenterIm.e -textvariable ::g_Opts(RangeCenter,1) \
                              -command Update -width 10 \
                              -from -3.0 -to 3.0 -increment 0.1
bind .fr.btns.frCenterIm.e  Update
pack .fr.btns.frCenterIm -fill x -side top
pack .fr.btns.frCenterIm.l .fr.btns.frCenterIm.e -side left -expand 1 -fill x

frame .fr.btns.frRangeSize
label .fr.btns.frRangeSize.l -text "Box size:" -anchor w
spinbox .fr.btns.frRangeSize.e -textvariable ::g_Opts(RangeSize) \
                               -command Update -width 10 \
                               -from 0.05 -to 5 -increment 0.05
bind .fr.btns.frRangeSize.e  Update
pack .fr.btns.frRangeSize -fill x -side top
pack .fr.btns.frRangeSize.l .fr.btns.frRangeSize.e -side left -expand 1 -fill x

labelframe .fr.btns.frRenderMethod -text "Render Method"
pack .fr.btns.frRenderMethod -fill x -side top -padx 2
foreach cmd $g_RenderMethods {
    radiobutton .fr.btns.frRenderMethod.b_$cmd -text $cmd -value $cmd \
                -variable g_Opts(RenderMethod) -command ResetCanvas
    pack .fr.btns.frRenderMethod.b_$cmd -fill x -side left
}

labelframe .fr.btns.frColorMethod -text "Coloring Method"
pack .fr.btns.frColorMethod -fill x -side top -padx 2
foreach cmd $g_ColorMethods {
    radiobutton .fr.btns.frColorMethod.b_$cmd -text $cmd -value $cmd \
                -variable g_Opts(ColorMethod) -command ResetCanvas
    pack .fr.btns.frColorMethod.b_$cmd -fill x -side left
}

set frRenormOpts .fr.btns.frRenormOpts
set frColor $frRenormOpts.frColor
set frFrequ $frRenormOpts.frFrequ
labelframe $frRenormOpts -text "Renorm Options"
frame $frColor 
frame $frFrequ
pack $frRenormOpts -fill x -side top -padx 2
pack $frColor $frFrequ -fill x -side top

label $frColor.l  -text "Colors:" -anchor w
button $frColor.bi -text "..." -bg $::g_Opts(InnerColor) \
                   -command "GetColor $frColor.bi InnerColor"
button $frColor.bo -text "..." -bg $::g_Opts(OuterColor) \
                   -command "GetColor $frColor.bo OuterColor"
pack $frColor.l $frColor.bi $frColor.bo \
      -side left -expand 1 -fill x

label $frFrequ.l -text "Band frequency:" -anchor w
spinbox $frFrequ.e -textvariable ::g_Opts(BandFrequ) \
                   -command Update -width 10 \
                   -from 0.001 -to 0.1 -increment 0.005
bind $frFrequ.e  Update
pack $frFrequ.l $frFrequ.e -side left -expand 1 -fill x


frame  .fr.btns.frSaveImg
button .fr.btns.frSaveImg.b -text "Save as image" -command [list SaveImg .fr.toglwin]
pack .fr.btns.frSaveImg -fill x -side top
pack .fr.btns.frSaveImg.b -side left -expand 1 -fill x

set appName "Tcl3D demo: Mandelbrot"
wm title . $appName

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind .  "ExitProg"
#update

Update
PrintGeneralInfo