[Paul Obermeier] 2007/08/03

Implementation of algorithmn described on Wiki page [Simple Chaos Theory with Tcl] using [Tcl3D].

This version adds several features:
   * Implementation of [slebetman]'s nice shading idea.
   * Interactive selection of chaos parameters.
   * Speed improvements by using a column cache.
   * Switch online between use of OpenGL or photo image for drawing.

This image shows the use of the OpenGL widget for drawing:
  
[http://www.tcl3d.org/demos/tcl3dExt/tcl3dChaosOgl.png]

This image shows the use of the photo image for drawing:
  
[http://www.tcl3d.org/demos/tcl3dExt/tcl3dChaosPhoto.png]

----

 # Copyright:      2007 Paul Obermeier (obermeier@tcl3d.org)
 # Filename:       tcl3dChaos.tcl
 # Author:         Paul Obermeier
 #
 # Description:    Implementation of algorithmn described on Wiki page
 #                 "Simple Chaos Theory with Tcl" (http://wiki.tcl.tk/11887) 
 #                 using Tcl3D.
 #                 Interesting values:
 #                 2000   8 10 14   revert
 #                 6300   3  3  3   revert
 
 package require Tk
 
 set retVal [catch {package require tcl3d} gVersion]
 set gHaveTcl3D [expr !$retVal]
 
 set gSett(Width)  640
 set gSett(Height) 480
 set gSett(PixelSize) 1
 
 set gOpts(Iterations) 300
 set gOpts(Red)     24
 set gOpts(Green)   24
 set gOpts(Blue)    24
 set gOpts(Revert)   0
 set gOpts(ScanMode) 1
 set gOpts(UseTcl3D) $gHaveTcl3D
 
 proc PrintGeneralInfo {} {
     global gOpts tcl_platform
 
     if { ! [winfo exists .fr.info] } {
         return
     }
     if { $gOpts(UseTcl3D) } {
         .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]]
     } else {
         .fr.info configure -text \
                  [format "Running on %s with a Photo image (Tcl %s)" \
                   $tcl_platform(os) [info patchlevel]]
     }
 }
 
 proc PrintExecutionInfo { msg { timeStr "" } } {
     if { [winfo exists .fr.row2.l_TimeInfo] } {
         if { $timeStr ne "" } {
             scan $timeStr "%d" ms
             set sec [expr { $ms / 1000.0 / 1000.0 }]
             append msg [format " %.1f seconds" $sec] 
         }
         .fr.row2.l_TimeInfo configure -text $msg
     }
 }
 
 proc Clip { c } {
     if {$c > 255} {
         return 255
     } elseif {$c < 0} {
         return 0
     } else {
         return $c
     }
 }
 
 proc GetColorString {r g b} {
     return "#[format %02x $r][format %02x $g][format %02x $b]"
 }
 
 proc SetPixel { x y  r g b } {
     global gSett gOpts
     global gCountPixels
 
     set r [Clip $r]
     set g [Clip $g]
     set b [Clip $b]
     if { $gOpts(UseTcl3D) } {
         glColor3ub $r $g $b
         glVertex3f $x [expr {$gSett(Height) - $y}] 0.0
     } else {
         set colorStr [GetColorString $r $g $b]
         CANVAS put $colorStr -to $x $y
     }
     incr gCountPixels
 }
 
 proc IncrPixel {x y r g b {optReverse false}} {
     global gColCache
 
     if { ! [info exists gColCache($y,r)] } {
         if {$optReverse} {
             set gColCache($y,r) 0
             set gColCache($y,g) 0
             set gColCache($y,b) 0
         } else {
             set gColCache($y,r) 255
             set gColCache($y,g) 255
             set gColCache($y,b) 255
         }
     }
     if {$optReverse} {
         set r -$r
         set g -$g
         set b -$b
     }
     
     set gColCache($y,r) [expr {$gColCache($y,r) - $r}]
     set gColCache($y,g) [expr {$gColCache($y,g) - $g}]
     set gColCache($y,b) [expr {$gColCache($y,b) - $b}]
 }
 
 proc Redraw {} {
     global gOpts
 
     if { $gOpts(UseTcl3D) } {
         .fr.toglwin postredisplay
     }
 }
 
 proc ClearBackground { reverse } {
     global gSett gOpts
 
     if { $gOpts(UseTcl3D) } {
         if {$reverse} {
             glClearColor 0.0 0.0 0.0 0.0
         } else {
             glClearColor 1.0 1.0 1.0 0.0
         }
     } else {
         InitPhoto
         if {$reverse} {
             CANVAS put black -to 0 0 $gSett(Width) $gSett(Height)
         } else {
             CANVAS put white -to 0 0 $gSett(Width) $gSett(Height)
         }
     }
 }
 
 proc Chaos { iterations r g b {optReverse false} {optUpdate false} } {
     global gSett gOpts gOgl
     global gColCache gStopUpdate gCountPixels
 
     set x 0.4
 
     set gStopUpdate false
     set gCountPixels 0
     ClearBackground $optReverse
 
     if { $gOpts(UseTcl3D) } {
         if { [info exists gOgl(DisplayListBase)] && \
              [glIsList $gOgl(DisplayListBase)] } {
             glDeleteLists $gOgl(DisplayListBase) $gOgl(DisplayListLen)
             set gOgl(DisplayListBase) [glGenLists $gSett(Width)]
             set gOgl(DisplayListLen) $gSett(Width)
         }
     }
     for {set sx 0} {$sx < $gSett(Width)} {incr sx} {
         set r_value [expr { pow(($sx*1.0)/$gSett(Width), 0.25) * 3.0 + 1.0} ]
         catch { unset gColCache }
 
         for {set i 1} {$i <= $iterations} {incr i} {
             set x  [expr {$r_value * $x * (1 - $x)}]
             set sy [expr {int($gSett(Height) - $x*$gSett(Height))}]
             IncrPixel $sx $sy $r $g $b $optReverse
         }
         if { $gOpts(UseTcl3D) } {
             glNewList [expr {$sx + $gOgl(DisplayListBase)}] GL_COMPILE
             glBegin GL_POINTS
         }
         foreach redIndex [array names gColCache "*,r"] {
             set row [lindex [split $redIndex ","] 0]
             SetPixel $sx $row $gColCache($row,r) \
                               $gColCache($row,g) \
                               $gColCache($row,b)
         }
         if { $gOpts(UseTcl3D) } {
             glEnd
             glEndList
         }
         if { $optUpdate } {
             Redraw
             update
         }
         if { $gStopUpdate } {
             set gStopUpdate false
             break
         }
     }
 }
 
 proc StartChaos {} {
     global gOpts
     global gCountPixels
 
     # Stop an already running Chaos run.
     StopChaos
 
     PrintExecutionInfo "Calculating chaos ..."
     update
     set ms [time {Chaos $gOpts(Iterations) \
                         $gOpts(Red) $gOpts(Green) $gOpts(Blue) \
                         $gOpts(Revert) $gOpts(ScanMode)} 1]
     PrintExecutionInfo "Time for $gCountPixels pixels:" $ms
     Redraw
 }
 
 proc StopChaos {} {
     global gStopUpdate
 
     set gStopUpdate true
     update
 }
 
 proc StartAnimation {} {
     StartChaos
 }
 
 proc StopAnimation {} {
     StopChaos
 }
 
 proc tclCreateFunc { toglwin } {
     global gSett gOgl
 
     glClearColor 1.0 1.0 1.0 0.0
     glPointSize $::gSett(PixelSize)
     set gOgl(DisplayListBase) [glGenLists $gSett(Width)]
     set gOgl(DisplayListLen) $gSett(Width)
 }
 
 proc tclReshapeFunc { toglwin w h } {
     global gSett gOpts
 
     set gSett(Width) $w
     set gSett(Height) $h
 
     if { $gOpts(UseTcl3D) } {
         glViewport 0 0 $w $h
         glMatrixMode GL_PROJECTION
         glLoadIdentity
 
         glOrtho 0.0 $w 0.0 $h -1.0 1.0
         glMatrixMode GL_MODELVIEW
         glLoadIdentity
     }
 }
 
 proc tclDisplayFunc { toglwin } {
     global gSett gOgl
 
     glClear GL_COLOR_BUFFER_BIT
     for { set x 0 } { $x < $gSett(Width) } { incr x } {
         glCallList [expr {$gOgl(DisplayListBase) + $x}]
     }
     $toglwin swapbuffers
 }
 
 proc InitPhoto {} {
     global gSett 
 
     catch { image delete CANVAS }
     image create photo CANVAS -width $gSett(Width) -height $gSett(Height)
 }
 
 proc InitCanvas {} {
     global gSett gOpts
 
     catch { destroy .fr.toglwin }
     if { $gOpts(UseTcl3D) } {
         togl .fr.toglwin -width $gSett(Width) -height $gSett(Height) \
                          -double true \
                          -createproc tclCreateFunc \
                          -reshapeproc tclReshapeFunc \
                          -displayproc tclDisplayFunc 
     } else {
         InitPhoto
         label .fr.toglwin -image CANVAS
     }
     grid .fr.toglwin -row 0 -column 0 -sticky news
 }
 
 proc ResetCanvas {} {
     InitCanvas
     PrintGeneralInfo
 }
 
 proc CreateWindow {} {
     global gSett gOpts
     global gHaveTcl3D gVersion
 
     frame .fr
     pack .fr -expand 1 -fill both
 
     InitCanvas
 
     frame .fr.row1
     frame .fr.row2
     label .fr.info
     grid .fr.toglwin -row 0 -column 0 -sticky news
     grid .fr.row1    -row 1 -column 0 -sticky news
     grid .fr.row2    -row 2 -column 0 -sticky news
     grid .fr.info    -row 3 -column 0 -sticky news
     grid rowconfigure .fr 0 -weight 1
     grid columnconfigure .fr 0 -weight 1
     wm title . "Tcl3D demo: Simple Chaos Theory"
 
     wm protocol . WM_DELETE_WINDOW "exit"
     bind . <Key-Escape> "exit"
 
     labelframe .fr.row1.fr1
     pack .fr.row1.fr1 -side left -padx 1 -pady 1
     foreach cmd [list "Revert" "ScanMode"] {
         checkbutton .fr.row1.fr1.cb_$cmd -text $cmd -variable gOpts($cmd) \
                     -indicatoron 1
         pack .fr.row1.fr1.cb_$cmd -side left
     }
     checkbutton .fr.row1.fr1.cb_UseTcl3D -text "Use Tcl3D" \
                 -variable gOpts(UseTcl3D) -indicatoron 1 -command ResetCanvas
     pack .fr.row1.fr1.cb_UseTcl3D -side left
     if { ! $gHaveTcl3D } {
         set gOpts(UseTcl3D) false
         .fr.row1.fr1.cb_UseTcl3D configure -state disabled
     }
 
     labelframe .fr.row1.fr2
     pack .fr.row1.fr2 -side left -padx 1 -pady 1 -ipady 1
     label .fr.row1.fr2.l_iter -text "Iterations:"
     spinbox .fr.row1.fr2.s_iter -from 100 -to 7000 -increment 100 -width 4 \
                                 -textvariable gOpts(Iterations)
     pack .fr.row1.fr2.l_iter .fr.row1.fr2.s_iter -side left
 
     foreach cmd [list "Red" "Green" "Blue"] {
         label .fr.row1.fr2.l_$cmd -text "${cmd}:"
         spinbox .fr.row1.fr2.s_$cmd -from 1 -to 255 -increment 1 -width 3 \
                             -textvariable gOpts($cmd)
         pack .fr.row1.fr2.l_$cmd .fr.row1.fr2.s_$cmd -side left
     }
 
     button .fr.row2.b_Start -text "Start Chaos" -command StartChaos \
                                 -relief groove
     pack .fr.row2.b_Start -side left -padx 2
     button .fr.row2.b_Stop -text "Stop Chaos" -command StopChaos \
                                -relief groove
     pack .fr.row2.b_Stop -side left -padx 2
     if { $gHaveTcl3D } {
         set msg "Found Tcl3D version $gVersion"
     } else {
         set msg "No Tcl3D available, using photo image version"
     }
     label .fr.row2.l_TimeInfo -text $msg
     pack .fr.row2.l_TimeInfo -side left -padx 2
 }
 
 CreateWindow
 PrintGeneralInfo 
 
 if { [file tail [info script]] == [file tail $::argv0] } {
     # If started directly from tclsh or wish, then start animation.
     update
     StartChaos
 }
 bind .fr.toglwin <Configure> "tclReshapeFunc dummy %w %h"

----

[[
[Category Graphics] |
[Category 3D Graphics] |
[Category Tcl3D]
]]