OUTPUT BUFFER:
# Copyright: 2007-2010 Paul Obermeier (obermeier@tcl3d.org) # # See the file "Tcl3D_License.txt" for information on # usage and redistribution of this file, and for a # DISCLAIMER OF ALL WARRANTIES. # # Module: Tcl3D -> tcl3dOgl # 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 CreateCallback { 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 ReshapeCallback { toglwin { w -1 } { h -1 } } { global gSett gOpts if { $gOpts(UseTcl3D) } { set w [$toglwin width] set h [$toglwin height] } 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 DisplayCallback { toglwin } { global gSett gOgl glClear GL_COLOR_BUFFER_BIT # Viewport command is not really needed, but has been inserted for # Mac OSX. Presentation framework (Tk) does not send a reshape event, # when switching from one demo to another. glViewport 0 0 [$toglwin width] [$toglwin height] 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 CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback } else { InitPhoto label .fr.toglwin -image CANVAS -borderwidth 0 bind .fr.toglwin