Demo 3 of 15 in category Tcl3DSpecificDemos
 |
# Copyright: 2010-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: 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]
|
