invalid command name "frame"
while executing
"frame .frame0 -borderwidth {2} -height {30} -relief {ridge} -width {30}"
(procedure "ShowWindow." line 7)
invoked from within
"ShowWindow."
(in namespace eval "::request" script line 978)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
#
#!/usr/local/bin/wish -f
# Program: wavelet
# Tcl version: 8.0 (Tcl/Tk/XF)
# Tk version: 8.0
# XF version: 4.0
#
# module inclusion
global env
global xfLoadPath
global xfLoadInfo
set xfLoadInfo 0
if {[info exists env(XF_LOAD_PATH)]} {
if {[string first $env(XF_LOAD_PATH) /usr/local/lib/] == -1} {
set xfLoadPath $env(XF_LOAD_PATH):/usr/local/lib/
} {
set xfLoadPath /usr/local/lib/
}
} {
set xfLoadPath /usr/local/lib/
}
# procedure to show window .
proc ShowWindow. {args} {# xf ignore me 7
# Window manager configurations
# build widget .frame0
frame .frame0 \
-borderwidth {2} \
-height {30} \
-relief {ridge} \
-width {30}
# build widget .frame0.canvas3
canvas .frame0.canvas3 \
-height {200} \
-highlightthickness {0} \
-relief {raised} \
-scrollregion {0 0 200 200} \
-width {200}
# bindings
bind .frame0.canvas3 {CursorMove [.frame0.canvas3
canvasx %x] [.frame0.canvas3 canvasy %y]
SetAlphaBeta}
bind .frame0.canvas3 {CursorMove [.frame0.canvas3 canvasx
%x] [.frame0.canvas3 canvasy %y]
SetAlphaBeta}
bind .frame0.canvas3 {FiltGen}
bind .frame0.canvas3 {focus .frame0.canvas3}
bind .frame0.canvas3 {CursorMove [expr int($curX)] [expr
int($curY) + 1.0]
SetAlphaBeta; FiltGen}
bind .frame0.canvas3 {CursorMove [expr int($curX) - 1.0]
[expr int($curY)]
SetAlphaBeta; FiltGen}
bind .frame0.canvas3 {CursorMove [expr int($curX) + 1.0]
[expr int($curY)]
SetAlphaBeta; FiltGen}
bind .frame0.canvas3 {CursorMove [expr int($curX)] [expr
int($curY) - 1.0]
SetAlphaBeta; FiltGen}
# build widget .frame1
frame .frame1 \
-height {30} \
-width {30}
# build widget .frame1.frame0
frame .frame1.frame0 \
-borderwidth {2} \
-height {30} \
-relief {ridge} \
-width {30}
# build widget .frame1.frame0.frame2
frame .frame1.frame0.frame2 \
-height {30} \
-width {30}
# build widget .frame1.frame0.frame2.label10
label .frame1.frame0.frame2.label10 \
-text {Alpha:}
# build widget .frame1.frame0.frame2.entry17
entry .frame1.frame0.frame2.entry17 \
-textvariable {alpha} \
-width {15}
# bindings
bind .frame1.frame0.frame2.entry17 {if
{[ParseFloatEntry alpha]} {
CursorMove [expr ($alpha / 0.03141592654) + 100.0] [expr 100.0 -
($beta / 0.03141592654)]
FiltGen
}}
# build widget .frame1.frame0.frame18
frame .frame1.frame0.frame18 \
-height {30} \
-width {30}
# build widget .frame1.frame0.frame18.label10
label .frame1.frame0.frame18.label10 \
-text { Beta:}
# build widget .frame1.frame0.frame18.entry17
entry .frame1.frame0.frame18.entry17 \
-textvariable {beta} \
-width {15}
# bindings
bind .frame1.frame0.frame18.entry17 {if
{[ParseFloatEntry beta]} {
CursorMove [expr ($alpha / 0.03141592654) + 100.0] [expr 100.0 -
($beta / 0.03141592654)]
FiltGen
}}
# build widget .frame1.frame0.frame0
frame .frame1.frame0.frame0 \
-height {30} \
-width {30}
# build widget .frame1.frame0.frame0.button2
button .frame1.frame0.frame0.button2 \
-command {CursorMove 100.0 100.0
set alpha 0.0; set beta 0.0; FiltGen} \
-padx {9} \
-pady {3} \
-text {Haar (Order 0)}
# build widget .frame1.frame0.frame0.button5
button .frame1.frame0.frame0.button5 \
-command {CursorMove 135.8394770 88.04855421
set alpha 1.125930376; set beta 0.375465743; FiltGen} \
-padx {9} \
-pady {3} \
-text {Hat}
# build widget .frame1.frame0.frame1
frame .frame1.frame0.frame1 \
-height {30} \
-width {30}
# build widget .frame1.frame0.frame1.button3
button .frame1.frame0.frame1.button3 \
-command {CursorMove 133.3327604 100.0
set alpha 1.047179551; set beta 0.0; FiltGen} \
-padx {9} \
-pady {3} \
-text {Daubechies 4 (Order 1)}
# build widget .frame1.frame0.frame1.button6
button .frame1.frame0.frame1.button6 \
-command {CursorMove 186.3641142 163.4345067
set alpha 2.713208667; set beta -1.992853802; FiltGen} \
-padx {9} \
-pady {3} \
-text {City}
# build widget .frame1.frame0.frame3
frame .frame1.frame0.frame3 \
-height {30} \
-width {30}
# build widget .frame1.frame0.frame3.button4
button .frame1.frame0.frame3.button4 \
-command {CursorMove 143.2838971 124.8952194
set alpha 1.359803732; set beta -0.782106385; FiltGen} \
-padx {9} \
-pady {3} \
-text {Daubechies 6 (Order 2)}
# build widget .frame1.frame0.frame3.button7
button .frame1.frame0.frame3.button7 \
-command {CursorMove 162.1648466 145.9444224
set alpha 1.952966255; set beta -1.443386598; FiltGen} \
-padx {9} \
-pady {3} \
-text {Wall}
# build widget .frame1.frame1
frame .frame1.frame1 \
-borderwidth {2} \
-height {30} \
-relief {ridge} \
-width {30}
# build widget .frame1.frame1.frame12
frame .frame1.frame1.frame12 \
-height {30} \
-width {30}
# build widget .frame1.frame1.frame12.label10
label .frame1.frame1.frame12.label10 \
-anchor {e} \
-text {-2:} \
-width {3}
# build widget .frame1.frame1.frame12.label11
label .frame1.frame1.frame12.label11 \
-anchor {w} \
-text {0.0} \
-textvariable {coeff(0)} \
-width {16}
# build widget .frame1.frame1.frame12.label8
label .frame1.frame1.frame12.label8 \
-anchor {e} \
-text {-1:} \
-width {3}
# build widget .frame1.frame1.frame12.label12
label .frame1.frame1.frame12.label12 \
-anchor {w} \
-text {0.0} \
-textvariable {coeff(1)} \
-width {16}
# build widget .frame1.frame1.frame13
frame .frame1.frame1.frame13 \
-height {30} \
-width {30}
# build widget .frame1.frame1.frame13.label10
label .frame1.frame1.frame13.label10 \
-anchor {e} \
-justify {right} \
-text {0:} \
-width {3}
# build widget .frame1.frame1.frame13.label11
label .frame1.frame1.frame13.label11 \
-anchor {w} \
-text {1.0} \
-textvariable {coeff(2)} \
-width {16}
# build widget .frame1.frame1.frame13.label14
label .frame1.frame1.frame13.label14 \
-anchor {e} \
-text {1:} \
-width {3}
# build widget .frame1.frame1.frame13.label15
label .frame1.frame1.frame13.label15 \
-anchor {w} \
-text {1.0} \
-textvariable {coeff(3)} \
-width {16}
# build widget .frame1.frame1.frame14
frame .frame1.frame1.frame14 \
-height {30} \
-width {30}
# build widget .frame1.frame1.frame14.label10
label .frame1.frame1.frame14.label10 \
-anchor {e} \
-text {2:} \
-width {3}
# build widget .frame1.frame1.frame14.label11
label .frame1.frame1.frame14.label11 \
-anchor {w} \
-text {0.0} \
-textvariable {coeff(4)} \
-width {16}
# build widget .frame1.frame1.frame14.label16
label .frame1.frame1.frame14.label16 \
-anchor {e} \
-text {3:} \
-width {3}
# build widget .frame1.frame1.frame14.label17
label .frame1.frame1.frame14.label17 \
-anchor {w} \
-text {0.0} \
-textvariable {coeff(5)} \
-width {16}
# build widget .frame1.frame1.label18
label .frame1.frame1.label18 \
-borderwidth {0} \
-text {Wavelet Coefficients}
# build widget .frame2
frame .frame2 \
-borderwidth {2} \
-relief {ridge}
# build widget .frame2.canvas19
canvas .frame2.canvas19 \
-height {131} \
-highlightthickness {0} \
-relief {raised} \
-scrollregion {-196 -65 324 65} \
-width {520}
# bindings
bind .frame2.canvas19 {. config -cursor watch;
update
if {$alpha == $beta} {
set dim 0
} elseif {$beta == 0.0} {
set dim 1
} else {
set dim 2
}
MakeWaveletFilters coeff L H $dim RECON
set len [CascadePhiAndPsi L H s w $dim {SCALING SCALING SCALING
SCALING SCALING} 5 ]
set sstr {0 0.0}; set wstr {0 0.0}; incr len -1
foreach i [lrange [lsort -integer [array names s]] 0 $len] {
lappend sstr $i $s($i); lappend wstr $i $w($i)
}
lappend sstr $i 0.0; lappend wstr $i 0.0
eval .frame2.canvas19 coords sline $sstr
eval .frame2.canvas19 coords wline $wstr
.frame2.canvas19 scale fline 0.0 0.0 1.0 -3.0
.frame2.canvas19 move sline 0 0.0
.frame2.canvas19 move wline [expr $dim * -64.0] 0.0
. config -cursor left_ptr}
bind .frame2.canvas19 {focus .frame2.canvas19}
# pack master .frame0
pack configure .frame0.canvas3
# pack master .frame1
pack configure .frame1.frame0 \
-fill both
pack configure .frame1.frame1 \
-expand 1 \
-fill both
# pack master .frame1.frame0
pack configure .frame1.frame0.frame3 \
-fill x \
-side bottom
pack configure .frame1.frame0.frame1 \
-fill x \
-side bottom
pack configure .frame1.frame0.frame0 \
-fill x \
-side bottom
pack configure .frame1.frame0.frame2 \
-fill x \
-side left
pack configure .frame1.frame0.frame18 \
-fill x \
-side right
# pack master .frame1.frame0.frame2
pack configure .frame1.frame0.frame2.label10 \
-side left
pack configure .frame1.frame0.frame2.entry17 \
-fill x
# pack master .frame1.frame0.frame18
pack configure .frame1.frame0.frame18.label10 \
-side left
pack configure .frame1.frame0.frame18.entry17 \
-fill x
# pack master .frame1.frame0.frame0
pack configure .frame1.frame0.frame0.button2 \
-expand 1 \
-fill x \
-side left
pack configure .frame1.frame0.frame0.button5 \
-expand 1 \
-fill x \
-side right
# pack master .frame1.frame0.frame1
pack configure .frame1.frame0.frame1.button3 \
-expand 1 \
-fill x \
-side left
pack configure .frame1.frame0.frame1.button6 \
-expand 1 \
-fill x \
-side right
# pack master .frame1.frame0.frame3
pack configure .frame1.frame0.frame3.button4 \
-expand 1 \
-fill x \
-side left
pack configure .frame1.frame0.frame3.button7 \
-expand 1 \
-fill x \
-side right
# pack master .frame1.frame1
pack configure .frame1.frame1.label18 \
-expand 1 \
-fill x
pack configure .frame1.frame1.frame12 \
-fill x
pack configure .frame1.frame1.frame13 \
-fill x
pack configure .frame1.frame1.frame14 \
-fill x
# pack master .frame1.frame1.frame12
pack configure .frame1.frame1.frame12.label10 \
-side left
pack configure .frame1.frame1.frame12.label11 \
-anchor w \
-expand 1 \
-side left
pack configure .frame1.frame1.frame12.label8 \
-side left
pack configure .frame1.frame1.frame12.label12 \
-anchor w \
-expand 1 \
-side left
# pack master .frame1.frame1.frame13
pack configure .frame1.frame1.frame13.label10 \
-side left
pack configure .frame1.frame1.frame13.label11 \
-anchor w \
-expand 1 \
-side left
pack configure .frame1.frame1.frame13.label14 \
-side left
pack configure .frame1.frame1.frame13.label15 \
-anchor w \
-expand 1 \
-side left
# pack master .frame1.frame1.frame14
pack configure .frame1.frame1.frame14.label10 \
-side left
pack configure .frame1.frame1.frame14.label11 \
-anchor w \
-expand 1 \
-side left
pack configure .frame1.frame1.frame14.label16 \
-side left
pack configure .frame1.frame1.frame14.label17 \
-anchor w \
-expand 1 \
-side left
# pack master .frame2
pack configure .frame2.canvas19
# pack master .
pack configure .frame2 \
-side bottom
pack configure .frame0 \
-side left
pack configure .frame1 \
-expand 1 \
-fill both \
-side left
# build canvas items .frame0.canvas3
set xfTmpTag [.frame0.canvas3 create line 100.0 0.0 100.0 200.0]
.frame0.canvas3 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame0.canvas3 create line 0.0 100.0 200.0 100.0]
.frame0.canvas3 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame0.canvas3 create line 0.0 200.0 200.0 0.0]
.frame0.canvas3 itemconfigure $xfTmpTag \
-fill {blue} \
-joinstyle {miter}
set xfTmpTag [.frame0.canvas3 create line 100.0 100.0 100.0 96.0
100.0 105.0 100.0 100.0 96.0 100.0 105.0 100.0]
.frame0.canvas3 itemconfigure $xfTmpTag \
-fill {red} \
-joinstyle {miter} \
-tags {ptr}
# build canvas items .frame2.canvas19
set xfTmpTag [.frame2.canvas19 create line -196.0 0.0 324.0 0.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 0.0 -65.0 0.0 65.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 64.0 5.0 64.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 128.0 5.0 128.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 192.0 5.0 192.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 256.0 5.0 256.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -64.0 5.0 -64.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -128.0 5.0 -128.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -192.0 5.0 -192.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 320.0 5.0 320.0 -5.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -5.0 23.0 5.0 23.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -5.0 45.0 5.0 45.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -5.0 -23.0 5.0 -23.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line -5.0 -45.0 5.0 -45.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-joinstyle {miter}
set xfTmpTag [.frame2.canvas19 create line 0.0 0.0 0.0 1.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-fill {blue} \
-joinstyle {miter} \
-tags {fline wline}
set xfTmpTag [.frame2.canvas19 create line 0.0 0.0 0.0 1.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-fill {red} \
-joinstyle {miter} \
-tags {fline sline}
set xfTmpTag [.frame2.canvas19 create text -96.0 -60.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-font {-Adobe-Helvetica-Medium-R-Normal--*-100-*-*-*-*-*-*} \
-text {Wavelet Function}
set xfTmpTag [.frame2.canvas19 create text 254.0 -60.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-font {-Adobe-Helvetica-Medium-R-Normal--*-100-*-*-*-*-*-*} \
-text {Scaling Function}
set xfTmpTag [.frame2.canvas19 create line 194.0 -60.0 214.0 -60.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-fill {red} \
-joinstyle {miter} \
-width {4}
set xfTmpTag [.frame2.canvas19 create line -136.0 -60.0 -156.0
-60.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-fill {blue} \
-joinstyle {miter} \
-width {4}
set xfTmpTag [.frame2.canvas19 create text 220.0 60.0]
.frame2.canvas19 itemconfigure $xfTmpTag \
-font {-Adobe-Helvetica-Medium-R-Normal--*-100-*-*-*-*-*-*} \
-text {Click on graph window to display functions.}
if {"[info procs XFEdit]" != ""} {
catch "XFMiscBindWidgetTree ."
after 2 "catch {XFEditSetShowWindows}"
}
}
# User defined procedures
# Procedure: CascadeArraySize
proc CascadeArraySize { dim mag} {
# CascadeArraySize - Determine final size of array after cascade
algorithm.
# Input(s): dim - Dimension of the filter.
# mag - Magnification power; 2^mag.
# Output(s): Size of array.
# Constraints: none.
set len [expr 2 * $dim + 2]; # initial length of cascaded data is
filter length */
for {set i 0} {$i < $mag} {incr i} { # convolutions and
interpolations at each level */
set len [expr 2 * ($len + $dim)]; # of magnification increases
length this amount */
}
return $len;
}
# Procedure: CascadePhiAndPsi
proc CascadePhiAndPsi { hfilt gfilt sfunc wfunc dim ftype mag} {
# CascadePhiAndPsi - Implementation of the cascade algorithm
# Input(s): hfilt - Pointer to storage of wavelet lowpass filter.
# gfilt - Pointer to storage of wavelet highpass filter.
# sfunc - Pointer to final storage of scaling function.
# wfunc - Pointer to final storage of wavelet function.
# dim - Dimension of the filter.
# ftype - Pointer to array of filter types used.
# mag - Magnification power; 2^mag.
# Output(s): short - Length of scaling and wavelet function data
arrays.
# Returns -1 if the set up fails.
# Constraints: none.
upvar $hfilt h $gfilt g $sfunc s $wfunc w
# ssrc, sdst, wsrc, wdst, gmod, and hmod are created next
set len [CascadeSetup h g $dim $mag]
# iterate over all but last filter type
foreach type [lreplace $ftype end end] {
if {$type == "WAVELET"} {
ConvolveIntp ssrc sdst wsrc wdst $len gmod $dim
} else {
ConvolveIntp ssrc sdst wsrc wdst $len hmod $dim
}
set len [expr 2 * ($len + $dim)];
# exchange scaling function source and destination array pointers
array set temp [array get ssrc]
array set ssrc [array get sdst]
array set sdst [array get temp]
# exchange wavelet function source and destination array pointers
array set temp [array get wsrc]
array set wsrc [array get wdst]
array set wdst [array get temp]
}
if {$mag > 0} {
# magnification is one or more times
if {[lindex $ftype end] == "WAVELET"} {
ConvolveIntp ssrc s wsrc w $len gmod $dim
} else {
ConvolveIntp ssrc s wsrc w $len hmod $dim
}
set len [expr 2 * ($len + $dim)];
} else {
# no magnification involved use original filter values
array set s [array get hmod]; array set w [array get gmod]
}
return $len;
}
# Procedure: CascadeSetup
proc CascadeSetup { hfilt gfilt dim mag} {
# CascadeSetup - Set up and initialization of internal arrays for
algorithm
# Input(s): hfilt - Pointer to storage of wavelet lowpass filter.
# gfilt - Pointer to storage of wavelet highpass filter.
# dim - Dimension of the filter.
# mag - Magnification power; 2^mag.
# Output(s): Length of initial data array. Returns -1 if the set up
fails.
# Constraints: none.
upvar $hfilt h $gfilt g; # bring down arrays passed in from higher
levels.
# Arrays created here will reside in next higher level
upvar sdst sd wdst wd ssrc ss wsrc ws gmod gm hmod hm
set len 0;
# magnification > 0 requires source arrays
if {$mag > 0} {
# determine length of magnified functions and create source arrays
set len [CascadeArraySize $dim [expr $mag - 1]]; set i 0
while {$i < $len} {
set ss($i) 0.0; set ws($i) 0.0; incr i
}
}
# magnification > 0 requires destination arrays */
if {$mag > 1} {
# create the destination arrays
set i 0
while {$i < $len} {
set sd($i) 0.0; set wd($i) 0.0; incr i
}
}
# calculate length of the filter arrays
set len [expr 2 * $dim + 2];
if {$mag != 0} {
# for magnifications > 0
array set ss [array get h]
array set ws [array get g]
}
array set hm [array get h]
array set gm [array get g]
return $len;
}
# Procedure: ConvolveIntp
proc ConvolveIntp { sinp sout winp wout len filt dim} {
# ConvolveIntp - Convolution with interpolation of scaling & wavelet
functions
# Input(s): sinp - Pointer to storage of scaling func. input data.
# sout - Pointer to storage of scaling func. output data.
# winp - Pointer to storage of wavelet func. input data.
# wout - Pointer to storage of wavelet func. output data.
# len - length of input data arrays.
# filt - Pointer to storage of wavelet lowpass filter.
# dim - Dimension of the filter.
# Output(s): none.
# Constraints: none.
upvar $sinp si $sout so $winp wi $wout wo $filt f
# first dim iterations slides filter over beginning edges of data
arrays
set i 0
while {$i < $dim} {
DotpIntp si wi $i so wo [expr 2*$i] f 0 $i; incr i
}
# continue sliding complete filter over body of data
while {$i < $len} {
DotpIntp si wi $i so wo [expr 2*$i] f 0 $dim; incr i
}
# last dim iterations slides filter over ending edges of data arrays
set j 1
while {$j <= $dim} {
DotpIntp si wi [expr $i-$j] so wo [expr 2*$i] f [expr 2*$j] [expr
$dim-$j]
incr i; incr j
}
}
# Procedure: CursorMove
proc CursorMove { newX newY} {
global curX curY alpha beta
if {($newX < 200.0) && ($newY < 200.0) && ($newX >= 0.0) && ($newY
> >= 0.0)} {
set difX [expr $newX - $curX]
set difY [expr $newY - $curY]
.frame0.canvas3 move ptr $difX $difY
set curX $newX; set curY $newY
# set alpha [expr ($newX - 100.0) * 0.03141592654]
# set beta [expr (100.0 - $newY) * 0.03141592654]
}
}
# Procedure: DotpIntp
proc DotpIntp { sinp winp iidx sout wout oidx filt fidx dim} {
# DotpIntp - Dot product with interpolation of scaling & wavelet
functions
# Input(s): sinp - Pointer to storage of scaling func. input data.
# sout - Pointer to storage of scaling func. output data.
# winp - Pointer to storage of wavelet func. input data.
# wout - Pointer to storage of wavelet func. output data.
# filt - Pointer to storage of wavelet lowpass filter.
# dim - Dimension of the filter.
# Output(s): none.
# Constraints: none.
upvar $sinp si $sout so $winp wi $wout wo $filt f
# set ssume 0.0; set ssumo 0.0; set wsume 0.0; set wsumo 0.0;
set ssume [expr $si($iidx) * $f($fidx)]; # decreasing input pointers
are moving
set wsume [expr $wi($iidx) * $f($fidx)]; # backward in time;
incrementing filter
incr fidx
set ssumo [expr $si($iidx) * $f($fidx)]; # pointer convolves even
and odd filter
set wsumo [expr $wi($iidx) * $f($fidx)]; # elements with data to
interpolate inputs
incr iidx -1; incr fidx; set i 1
while {$i <= $dim} {
set ssume [expr $ssume + $si($iidx) * $f($fidx)]; # decreasing
input pointers are moving
set wsume [expr $wsume + $wi($iidx) * $f($fidx)]; # backward in
time; incrementing filter
incr fidx
set ssumo [expr $ssumo + $si($iidx) * $f($fidx)]; # pointer
convolves even and odd filter
set wsumo [expr $wsumo + $wi($iidx) * $f($fidx)]; # elements with
data to interpolate inputs
incr iidx -1; incr fidx; incr i
}
# store the even and odd interpolation elements of the scaling and
wavelet function
set so($oidx) $ssume; set wo($oidx) $wsume; incr oidx
set so($oidx) $ssumo; set wo($oidx) $wsumo; incr oidx
}
# Procedure: FiltGen
proc FiltGen {} {
global coeff alpha beta
set ca [expr cos($alpha)]; set sa [expr sin($alpha)]
set cb [expr cos($beta)]; set sb [expr sin($beta)]
set camb [expr cos($alpha - $beta)]; set samb [expr sin($alpha -
$beta)]
set coeff(0) [expr ((1.0 + $ca + $sa) * (1.0 - $cb - $sb) + 2.0 *
$sb * $ca) / 4.0]
set coeff(1) [expr ((1.0 - $ca + $sa) * (1.0 + $cb - $sb) - 2.0 *
$sb * $ca) / 4.0]
set coeff(2) [expr (1.0 + $camb + $samb) / 2.0]
set coeff(3) [expr (1.0 + $camb - $samb) / 2.0]
set coeff(4) [expr 1.0 - $coeff(0) - $coeff(2)]
set coeff(5) [expr 1.0 - $coeff(1) - $coeff(3)]
}
# Procedure: MakeWaveletFilters
proc MakeWaveletFilters { coeff Lfilt Hfilt dim transform} {
# MakeWaveletFilters - Construct filters from orthonormal wavelet
coefficients
#
# Input(s): REAL *coeff - Pointer to coefficient array.
# REAL *Lfilt - Pointer to lowpass filter array.
# REAL *Hfilt - Pointer to highpass filter array.
# short dim - Dimension of wavelet coefficients.
# wavetype transform - Type of filters needed for
transform.
#
# Output(s): none.
#
# Constraints: none.
global ONE_OVER_SQRT_2 SQRT_2
upvar $coeff cc $Lfilt Lf $Hfilt Hf
foreach i {0 1 2 3 4 5} {
set Lf($i) 0.0; set Hf($i) 0.0
}
# Form the decomposition filters h~ and g~ or the reconstruction
filters h and g.
set len [expr 2 * $dim + 2]
for {set i 0; set j [expr 2 - $dim]} {$i < $len} {incr i; incr j} {
set c($i) $cc($j)
}
for {set i 0; set j [expr $len - 1]} {$i < $len} {incr i; incr j -1}
{
if {$transform == "DECOMP"} {
# form the decomopsition filters h~ and g~
set Lf($i) [expr $c($j) * $ONE_OVER_SQRT_2]; # filter h~
set Hf($i) [expr double(((($i & 1) * 2) - 1)) * $c($i) *
$ONE_OVER_SQRT_2]; # filter g~
} else {
# form the reconstruction filters h and g
set Lf($i) [expr $c($i) * $SQRT_2]; # filter h
set Hf($i) [expr double(((($j & 1) * 2) - 1)) * $c($j) *
$SQRT_2]; # filter g
}
}
# End of MakeWaveletFilters
}
# Procedure: ParseFloatEntry
proc ParseFloatEntry { e} {
upvar $e entry
if {[regexp {(^[-]?[0-3]$)|(^[-]?[0-3][.][0-9]*$)} $entry] == 0 } {
return 0
} else {
return 1
}
}
# Procedure: SetAlphaBeta
proc SetAlphaBeta {} {
global curX curY alpha beta
set alpha [expr ($curX - 100.0) * 0.03141592654]
set beta [expr (100.0 - $curY) * 0.03141592654]
}
# User defined images
# Internal procedures
# initialize bindings for all widgets
proc XFInitAllBindings {} {
# bindings
bind all {
tkTraverseToMenu %W %A
}
bind all {
tkFirstMenu %W
}
bind all {focus [tk_focusNext %W]}
bind all {focus [tk_focusPrev %W]}
}
# startup source
proc StartupSrc {args} {
#global tcl_precision
#set tcl_precision 17
}
# end source
proc EndSrc {} {
}
# startup source
StartupSrc
# initialize global variables
proc InitGlobals {} {
global {H}
set {H(0)} {0.0}
set {H(1)} {0.0}
set {H(2)} {0.0}
set {H(3)} {0.0}
set {H(4)} {0.0}
set {H(5)} {0.0}
global {L}
set {L(0)} {0.0}
set {L(1)} {0.0}
set {L(2)} {0.0}
set {L(3)} {0.0}
set {L(4)} {0.0}
set {L(5)} {0.0}
global {ONE_OVER_SQRT_2}
set {ONE_OVER_SQRT_2} {0.7071067814}
global {SQRT_2}
set {SQRT_2} {1.414213562}
global {alpha}
set {alpha} {0.0}
global {beta}
set {beta} {0.0}
global {coeff}
set {coeff(0)} {0.0}
set {coeff(1)} {0.0}
set {coeff(2)} {1.0}
set {coeff(3)} {1.0}
set {coeff(4)} {0.0}
set {coeff(5)} {0.0}
global {curX}
set {curX} {100.0}
global {curY}
set {curY} {100.0}
global {last_alpha}
set {last_alpha} {0.0}
global {last_beta}
set {last_beta} {0.0}
global {result}
set {result} {}
# please don't modify the following
# variables. They are needed by xf.
global {autoLoadList}
set {autoLoadList(wavelet.tcl)} {0}
global {internalAliasList}
set {internalAliasList} {}
global {moduleList}
set {moduleList(wavelet.tcl)} {}
global {preloadList}
set {preloadList(xfInternal)} {}
global {symbolicName}
set {symbolicName(root)} {.}
global {xfWmSetPosition}
set {xfWmSetPosition} {}
global {xfWmSetSize}
set {xfWmSetSize} {}
global {xfAppDefToplevels}
set {xfAppDefToplevels} {}
}
# initialize global variables
InitGlobals
# display/remove toplevel windows.
ShowWindow.
# load default bindings.
if {[info exists env(XF_BIND_FILE)] &&
"[info procs XFShowHelp]" == ""} {
source $env(XF_BIND_FILE)
}
# initialize bindings for all widgets.
XFInitAllBindings
# end source
EndSrc
# eof
#