# Copyright:      2007-2024 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 [tcl3dOglGetInfoString]
    } 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) && [winfo exists .fr.toglwin] } {
        .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 \
                         -createcommand CreateCallback \
                         -reshapecommand ReshapeCallback \
                         -displaycommand DisplayCallback 
    } else {
        InitPhoto
        label .fr.toglwin -image CANVAS -borderwidth 0
        bind .fr.toglwin <Configure> "ReshapeCallback .fr.toglwin %w %h"
    }
    grid .fr.toglwin -row 0 -column 0 -sticky news
}

proc ResetCanvas {} {
    InitCanvas
    PrintGeneralInfo
}

# Cleanup procedure needed only, when this script is used from
# the presentation framework.
proc Cleanup {} {
    StopChaos
}

proc ExitProg {} {
    Cleanup
    exit
}

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 "ExitProg"
    bind . <Key-Escape> "ExitProg"

    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 0 -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]] eq [file tail $::argv0] } {
    # If started directly from tclsh or wish, then start animation.
    update
    StartChaos
}
