Version 3 of Simple Chaos Theory with Tcl3D

Updated 2008-02-28 22:44:14 by paul

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

 # Filename:       tcl3dChaos.tcl
 # Author:         Paul Obermeier ([email protected])
 #
 # 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