# Copyright:    2010-2026 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:       Tcl3DSpecificDemos
# Filename:     catmap.tcl
#
# Author:       Paul Obermeier
#
# Description:  Tcl3D demo generating image sequences according to 
#               Arnold's cat map, a chaotic mapping of the pixels of an image.
#
#               For a detailed description of Arnold's cat map, see
#               http://online.redwoods.cc.ca.us/instruct/darnold/maw/catmap.htm
#
#               Some example image sizes and corresponding periods:
#               Image size  Iterations
#               100         150
#               101          25
#               110          30
#               124          15
#               136          18
#               145          70
#               255         180
#               256         192
#               400         300

package require Img
package require tcl3d

# Determine the directory of this script
set gDemo(scriptDir) [file dirname [info script]]

# Default values for optional parameters.
set gOpts(imgSize)  124
set gOpts(saveImgs) 0

set gDemo(curIter)     0
set gDemo(imgIn)       0
set gDemo(imgOut)      1
set gDemo(animStarted) 0

set gDemo(winWidth)   512
set gDemo(winHeight)  512

set gDemo(stopWatch) [tcl3dNewSwatch]
tcl3dResetSwatch $gDemo(stopWatch)
tcl3dStartSwatch $gDemo(stopWatch)

# 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 label widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

# Save the image stored in tcl3dVector "vec" into file "fileName".
proc SaveImg { fileName vec w h numChans } {
    set ph [image create photo -width $w -height $h]
    tcl3dVectorToPhoto $vec $ph $w $h $numChans
    set fmt [string range [file extension $fileName] 1 end]
    $ph write $fileName -format $fmt
    image delete $ph
}

# Scale the original image stored in dict gDemo(img) to the new size.
# Also copy the scaled images into the ping-pong buffers.
proc ScaleImg {} {
    global gDemo gOpts

    Cleanup true

    set numChans [dict get $gDemo(img) chans]
    set newSize $gOpts(imgSize)

    set gDemo(imgVec) [tcl3dVector GLubyte \
                      [expr $newSize * $newSize * $numChans]]
    set gDemo(imgVec,0) [tcl3dVector GLubyte \
                        [expr $newSize * $newSize * $numChans]]
    set gDemo(imgVec,1) [tcl3dVector GLubyte \
                        [expr $newSize * $newSize * $numChans]]

    gluScaleImage \
                 [dict get $gDemo(img) format] \
                 [dict get $gDemo(img) width] \
                 [dict get $gDemo(img) height] \
                 $::GL_UNSIGNED_BYTE \
                 [dict get $gDemo(img) data] \
                 $newSize $newSize \
                 $::GL_UNSIGNED_BYTE \
                 $gDemo(imgVec)
    tcl3dVectorCopy $gDemo(imgVec) $gDemo(imgVec,0) $newSize $newSize $numChans
    tcl3dVectorCopy $gDemo(imgVec) $gDemo(imgVec,1) $newSize $newSize $numChans
}

# Perform the cat mapping and display the generated image with glDrawPixels.
# Optionally save the generated image into a PNG file.
proc DrawPixels {} {
    global gDemo gOpts

    set in  $gDemo(imgIn)
    set out $gDemo(imgOut)
    set numChans [dict get $gDemo(img) chans]
    set imgSize $gOpts(imgSize)

    if { $gDemo(animStarted) == 0 } {
        glDrawPixels $imgSize $imgSize [dict get $gDemo(img) format] \
                     GL_UNSIGNED_BYTE $gDemo(imgVec,$in)
        return
    }

    set startTime [tcl3dLookupSwatch $gDemo(stopWatch)]

    set inVec  $gDemo(imgVec,$in)
    set outVec $gDemo(imgVec,$out)
    for { set y 0 } { $y < $imgSize } { incr y } {
        for { set x 0 } { $x < $imgSize } { incr x } {
            set nx [expr {($x + $y)   % $imgSize}]
            set ny [expr {($x + 2*$y) % $imgSize}]
            set inOff  [expr {($x  + $y * $imgSize) * $numChans}]
            set outOff [expr {($nx + $ny* $imgSize) * $numChans}]
            set r [GLubyte_getitem $inVec $inOff]
            incr inOff
            set g [GLubyte_getitem $inVec $inOff]
            incr inOff
            set b [GLubyte_getitem $inVec $inOff]
            GLubyte_setrgb $outVec $outOff $r $g $b
        }
    }

    glDrawPixels $imgSize $imgSize [dict get $gDemo(img) format] \
                 GL_UNSIGNED_BYTE $gDemo(imgVec,$out)

    set gDemo(imgIn)  [expr {($gDemo(imgIn)  + 1) % 2}]
    set gDemo(imgOut) [expr {($gDemo(imgOut) + 1) % 2}]
    incr gDemo(curIter)

    set stopTime [tcl3dLookupSwatch $gDemo(stopWatch)]

    if { $gOpts(saveImgs) } {
        # Write out the generated image.
        set fileName [format "catmap-%d.%04d.png" $imgSize $gDemo(curIter)]
        set filePath [file join $gDemo(scriptDir) $fileName]
        # Create a name on the file system, if running from within a Starpack.
        set imgName [tcl3dGenExtName $filePath]
        SaveImg $imgName $gDemo(imgVec,$out) $imgSize $imgSize $numChans
    }

    # If the generated image is identical to the original image, stop the
    # period search.
    if { [tcl3dVectorEqual $gDemo(imgVec) $gDemo(imgVec,$out) \
                         $imgSize $imgSize $numChans] } {
        set msg "Found original image at iteration $gDemo(curIter)."
        .fr.msg configure -text $msg
        StopAnimation
        return
    }

    set msg [format "Calculation time: %.2f secs" [expr $stopTime - $startTime]]
    if { $gOpts(saveImgs) } {
        append msg " (Saving as $imgName)"
    }
    .fr.msg configure -text $msg
}

proc Reset {} {
    global gDemo gOpts

    if { ! [string is integer $gOpts(imgSize)] } {
        set gOpts(imgSize) 101
    }
    if { $gOpts(imgSize) <= 0  } {
        set gOpts(imgSize) 1
    }
    if { $gOpts(imgSize) > 512  } {
        set gOpts(imgSize) 512
    }
    .fr.msg configure -text ""
    StopAnimation
    set gDemo(curIter) 0
    set gDemo(imgIn)   0
    set gDemo(imgOut)  1
    ScaleImg
    DisplayCallback .fr.toglwin
}

proc CreateCallback { toglwin } {    
    glClearColor 0.0 0.0 0.0 0.0
    glShadeModel GL_FLAT
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    global gOpts gDemo

    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glOrtho 0 $gOpts(imgSize) 0 $gOpts(imgSize) -1.0 1.0
    glMatrixMode GL_MODELVIEW
}

proc DisplayCallback { toglwin } {
    global gOpts gDemo

    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]

    glRasterPos2i 0 0
    DrawPixels
    glFlush
    $toglwin swapbuffers
}

proc NextStep {} {
    global gDemo

    set gDemo(animStarted) 1
    DisplayCallback .fr.toglwin
    set gDemo(animStarted) 0
}

proc Animate {} {
    global gDemo

    if { $gDemo(animStarted) == 0 } {
        unset ::animateId
        return
    }
    DisplayCallback .fr.toglwin
    set ::animateId [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    global gDemo

    set gDemo(animStarted) 1
    .fr.frBtns.frCmds.run configure -text "Pause"
    if { ! [info exists ::animateId] } {
        Animate
    }
}

proc StopAnimation {} {
    global gDemo

    if { [info exists ::animateId] } {
        after cancel $::animateId 
        unset ::animateId
    }
    set gDemo(animStarted) 0
    .fr.frBtns.frCmds.run configure -text "Find period"
}

proc StartStopAnimation {} {
    global gDemo

    if { $gDemo(animStarted) == 0 } {
        StartAnimation
    } else {
        StopAnimation
    }
}

proc Cleanup { { imgOnly false } } {
    global gDemo

    if { [info exists gDemo(imgVec)] } {
        $gDemo(imgVec) delete
    }
    if { [info exists gDemo(imgVec,0)] } {
        $gDemo(imgVec,0) delete
    }
    if { [info exists gDemo(imgVec,1)] } {
        $gDemo(imgVec,1) delete
    }
    if { ! $imgOnly } {
        if { [info exists gDemo(img)] } {
            [dict get $gDemo(img) data] delete
        }
        uplevel #0 unset gDemo
        uplevel #0 unset gOpts
    }
}

proc ExitProg {} {
    exit
}

# Create the widgets and bindings.
proc CreateWindow {} {
    global gDemo gOpts

    ttk::frame .fr
    pack .fr -expand 1 -fill both
    # Create the OpenGL widget.
    togl .fr.toglwin -width $gDemo(winWidth) -height $gDemo(winHeight) \
                     -double true -depth false -alpha true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 

    ttk::frame .fr.frBtns
    ttk::label .fr.msg -anchor w
    ttk::label .fr.info
    grid .fr.toglwin  -row 0 -column 0 -sticky news
    grid .fr.frBtns   -row 1 -column 0 -sticky news
    grid .fr.msg      -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: Arnold's Cat Map vs. Paul's Rabbit Map"

    ttk::labelframe .fr.frBtns.frSize -text "Image size"
    pack  .fr.frBtns.frSize -side left -padx 2
    spinbox .fr.frBtns.frSize.size -textvariable gOpts(imgSize) -command Reset \
            -from 1 -to 512 -increment 1 -width 4
    bind .fr.frBtns.frSize.size <Key-Return> "Reset"
    tcl3dToolhelpAddBinding .fr.frBtns.frSize.size \
        "Press Enter to scale image to new size."
    eval pack [winfo children .fr.frBtns.frSize] -side left \
               -anchor w -expand 1 -fill x

    ttk::labelframe .fr.frBtns.frIter -text "Current iteration"
    pack  .fr.frBtns.frIter -side left -padx 2
    ttk::label .fr.frBtns.frIter.curIter -textvariable gDemo(curIter) -width 4
    eval pack [winfo children .fr.frBtns.frIter] -side left \
               -anchor w -expand 1 -fill x

    ttk::labelframe .fr.frBtns.frCmds -text "Commands"
    pack  .fr.frBtns.frCmds -side left -padx 2
    ttk::button .fr.frBtns.frCmds.reset -text "Reset" -command "Reset"
    ttk::button .fr.frBtns.frCmds.next -text "Next" -command "NextStep"
    ttk::button .fr.frBtns.frCmds.run -text "Find period" -command "StartStopAnimation"

    ttk::checkbutton .fr.frBtns.frCmds.save -text "Save images" -variable gOpts(saveImgs)

    eval pack [winfo children .fr.frBtns.frCmds] -side left \
               -anchor w -expand 1 -fill x -padx 1

    bind . <Key-Right> "NextStep"
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
}

CreateWindow

set imgName [file join $gDemo(scriptDir) "rabbit.jpg"]
set gDemo(img) [tcl3dReadImg $imgName]

Reset

PrintInfo [tcl3dOglGetInfoString]
