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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
# mesh.tk: mesh TCL routines
#
# 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 meshInitialize {} {
global morph
MeshT mesh_src
MeshT mesh_dst
MeshT mesh_twn
set rgba_image_x_size [rgbaImage_src_orig cget -ncols]
set rgba_image_y_size [rgbaImage_src_orig cget -nrows]
verbose "meshInitialize: image size is $rgba_image_x_size $rgba_image_y_size"
set mesh_x_size [ expr $rgba_image_x_size / 40 + 1 ]
set mesh_y_size [ expr $rgba_image_y_size / 40 + 1 ]
verbose "meshInitialize: mesh size is $mesh_x_size $mesh_y_size"
mesh_src alloc $mesh_x_size $mesh_y_size
mesh_src reset $rgba_image_x_size $rgba_image_y_size
mesh_dst alloc $mesh_x_size $mesh_y_size
mesh_dst reset $rgba_image_x_size $rgba_image_y_size
mesh_twn alloc $mesh_x_size $mesh_y_size
mesh_twn reset $rgba_image_x_size $rgba_image_y_size
set morph(src,color) green
set morph(dst,color) red
set morph(twn,color) yellow
}
proc meshLoad { this other matching_image } {
set mesh_file [dirbrowser3 .f -message "Read Mesh" -filemask *.msh ]
if [llength $mesh_file] {
$this read $mesh_file
# Make sure both meshes have the same dimensions
$other match [$this cget -this]
# Make sure that mesh size matches image size.
$this scale [$matching_image cget -ncols] [$matching_image cget -nrows]
meshTweenInterpolate
meshDrawAll
}
}
proc meshSave { this } {
set output_file [dirbrowser3 .f -message "Save Mesh" -filemask *.msh ]
if [llength $output_file] {
$this write $output_file
}
}
proc meshDraw { mesh color canvas } {
# meshDraw: draw a mesh with lines and points
#
$canvas delete $mesh
# Draw horizontal lines
for { set yi 0 } { $yi < [ $mesh cget -ny ] } { incr yi } {
eval [
subst { $canvas create line [ $mesh row $yi ] -fill $color -tag $mesh }
]
}
for { set xi 0 } { $xi < [ $mesh cget -nx ] } { incr xi } {
# Draw vertical lines
eval [
subst { $canvas create line [ $mesh col $xi ] \
-fill $color -tag $mesh }
]
# Draw points
# Note that points have to be draw last to be on top of lines
for { set yi 0 } { $yi < [ $mesh cget -ny ] } { incr yi } {
set xp [ $mesh pointGet $xi $yi 0]
set yp [ $mesh pointGet $xi $yi 1]
set xu [ expr $xp - 2 ]
set xl [ expr $xp + 2 ]
set yu [ expr $yp - 2 ]
set yl [ expr $yp + 2 ]
set loctag $mesh-$xi-$yi
set pointtag $mesh-point
$canvas create oval $xu $yu $xl $yl -fill $color -tag $loctag
$canvas addtag $pointtag withtag $loctag
$canvas addtag $mesh withtag $loctag
}
}
}
proc meshTweenInterpolate { } {
global morph
mesh_twn free
mesh_twn alloc [mesh_src cget -nx] [mesh_src cget -ny]
mesh_twn interpolate [mesh_src cget -this] [mesh_dst cget -this] $morph(warp)
}
proc meshDrawAll { } {
global morph
meshDraw mesh_src $morph(src,color) $morph(canvas,src)
meshDraw mesh_dst $morph(dst,color) $morph(canvas,dst)
meshDraw mesh_twn $morph(twn,color) $morph(canvas,twn)
}
|
