1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
# warp.tk: warp image
#
# This file is part of the tkmorph package.
#
# Written and Copyright (C) 1996,1997 by Michael J. Gourlay
#
# Provided as is. No warrenties, express or implied.
proc doWarp {} {
global morph
verbose "doWarp: Warping image..."
# Warp the src and dst images
set src_warp [ rgbaImage_src_warp warp [rgbaImage_src_orig cget -this] \
[mesh_src cget -this] [mesh_dst cget -this] $morph(warp) ]
set dst_warp [ rgbaImage_dst_warp warp [rgbaImage_dst_orig cget -this] \
[mesh_dst cget -this] [mesh_src cget -this] [expr 1.0 - $morph(warp)] ]
verbose "doWarp: Dissolving warped image..."
# Dissolve these two warped images and store in hidden spaces
rgbaImage_twn_orig free
rgbaImage_twn_orig dissolve [rgbaImage_src_warp cget -this] \
[rgbaImage_dst_warp cget -this] $morph(dissolve)
# Display the warped image
verbose "doWarp: Displaying warped image..."
# Dissolve these two warped images and store in hidden spaces
rgbaImage_twn_orig toPhoto $morph(image,twn,display)
}
|
