minterp create m
m eval {
function [] = fig( interp, id )
str = [ interp, ' figure current ', id ];
eeval(str);
end;
function [] = figi( interp, id )
sid = sprintf('%d', id );
str = [ interp, ' figure current ', sid ];
eeval(str);
end;
}
proc winExists path {
return [ expr ![ catch "wm state $path" err ] ]
}
set lfm_onParamChange 1
set opt_onParamChange 1
proc lfm_demo {} {
if { [ winExists .lfm ] } return
# toplevel
toplevel .lfm
wm title .lfm "Linear FM Demo"
set height 200
set min(freq) 1
set max(freq) 10
set min(mod) 0
set max(mod) 10
set min(specz) 10
set max(specz) 200
set linearfm_func {
function [ t , s , f , h ] = LinearFM( freq , mod , spec_z )
% freq = frequency
% mod = modulation
% spec_z = spectral zoom
% parameters
amp = 0.5;
mPoints = 1024;
% setup signal
t = ( 0 : mPoints-1 ) / mPoints;
s = amp * sin( 2 * pi * freq * ( 1 + mod * t ) .* t );
% compute
% h = abs( _fft ( [ s zeros( 1 , mPoints ) ] ) );
h = abs( _fft ( s ) );
f = 1 : spec_z ;
% 1-based indexing in MathViews
h = h(f);
% zero-based frequency axis
f = f - 1;
}
m eval $linearfm_func
m figure create ts
m figure create fh
# graph widgets
graph .lfm.gts -height $height -figure m ts
graph .lfm.gfh -height $height -figure m fh
# scale widgets
scale .lfm.sc_freq -label "frequency" -command lfm_plot \
-from $min(freq) -to $max(freq) -orient horizontal
scale .lfm.sc_mod -label "modulation" -command lfm_plot \
-from $min(mod) -to $max(mod) -orient horizontal
scale .lfm.sc_specz -label "spectral zoom" -command lfm_plot \
-from $min(specz) -to $max(specz) -orient horizontal
# button widgets
frame .lfm.f
button .lfm.f.b -text "re-plot" -command { lfm_plot 0 }
button .lfm.f.dis -text "Dismiss" -command { destroy .lfm }
checkbutton .lfm.cb -text "plot on every parameter change" \
-variable lfm_onParamChange
# pack
pack .lfm.gts .lfm.gfh \
-side top -in .lfm -fill both -expand 1 -padx 2 -pady 2
pack .lfm.sc_freq .lfm.sc_mod .lfm.sc_specz \
-side top -in .lfm -fill x -expand 1 -padx 2 -pady 2
pack .lfm.f.b .lfm.f.dis -in .lfm.f \
-side left -fill x -expand 1
pack .lfm.cb .lfm.f \
-side top -in .lfm -fill x -expand 1 -padx 2 -pady 2
}
# t = time axis
# s = s(t)
# f = frequency axis
# h = h(f)
proc lfm_plot { newValue } {
global lfm_onParamChange
if { $lfm_onParamChange == 0 && $newValue != 0 } return
set freq [ .lfm.sc_freq get ]
set mod [ .lfm.sc_mod get ]
set specz [ .lfm.sc_specz get ]
set cmd { [ t , s , f , h ] }
lappend cmd "= LinearFM( $freq , $mod , $specz );"
set cmd [ join $cmd ]
m eval $cmd
m eval {
fig('m','ts');
plot(t,s)
fig('m','fh');
plot(f,h)
}
}
set opt_filter_order 11
set opt_spec(f0s) 0.0 ; set opt_spec(h0s) 1.0
set opt_spec(f0e) 0.3 ; set opt_spec(h0e) 1.0
set opt_spec(f1s) 0.5 ; set opt_spec(h1s) 0.0
set opt_spec(f1e) 1.0 ; set opt_spec(h1e) 0.0
proc opt_demo {} {
if { [ winExists .opt ] } return
toplevel .opt
wm title .opt "Optimal FIR Filter Design"
set remez_cmd {
function [] = do_remez( order , f , h )
disp('Designing filter ...');
b = remez( order , f , h );
[ rh , rf ] = freqz( b , 1 , 512 );
rh = abs( rh );
rf = rf / pi;
disp('Done ...');
fig('m','remez');
plot( rf, rh , 'g', f, h, 'r' )
filter_coefficients = b'
}
m eval $remez_cmd
set w 6
frame .opt.f
frame .opt.f.response
frame .opt.f.order
frame .opt.f.buttons
set m .opt.f.response
# titles
label $m.t -text "Response Specification" -background red
grid $m.t -row 0 -col 0 -columnspan 2 -in $m -sticky news
label $m.frq -text "Frequency" -width $w -background green
grid $m.frq -row 1 -col 0 -in $m -sticky news
label $m.mag -text "Magnitue" -width $w -background yellow
grid $m.mag -row 1 -col 1 -in $m -sticky news
# band 0
entry $m.0fs -textvariable opt_spec(f0s) -width $w
grid $m.0fs -row 2 -col 0 -in $m -sticky news
entry $m.0hs -textvariable opt_spec(h0s) -width $w
grid $m.0hs -row 2 -col 1 -in $m -sticky news
entry $m.0fe -textvariable opt_spec(f0e) -width $w
grid $m.0fe -row 3 -col 0 -in $m -sticky news
entry $m.0he -textvariable opt_spec(h0e) -width $w
grid $m.0he -row 3 -col 1 -in $m -sticky news
# band 1
entry $m.1fs -textvariable opt_spec(f1s) -width $w
grid $m.1fs -row 4 -col 0 -in $m -sticky news
entry $m.1hs -textvariable opt_spec(h1s) -width $w
grid $m.1hs -row 4 -col 1 -in $m -sticky news
entry $m.1fe -textvariable opt_spec(f1e) -width $w
grid $m.1fe -row 5 -col 0 -in $m -sticky news
entry $m.1he -textvariable opt_spec(h1e) -width $w
grid $m.1he -row 5 -col 1 -in $m -sticky news
grid columnconfig $m 0 -weight 1 -minsize 0
grid columnconfig $m 1 -weight 1 -minsize 0
for { set i 0 } { $i < 6 } { incr i } {
grid rowconfig $m $i -weight 1 -minsize 0
}
checkbutton .opt.f.cb -text "plot on every change of filter order" \
-variable opt_onParamChange
set m .opt.f.order
scale $m.sc -label "Filter Order:" -variable opt_filter_order \
-from 5 -to 25 -orient horizontal -command opt_plot
pack $m.sc -side left -fill x -expand 1
set m .opt.f.buttons
button $m.design -text "Design" -command { opt_plot 0 }
button $m.quit -text "Dismiss" -command { destroy .opt }
pack $m.design $m.quit -side left -fill both -expand 1
set m .opt.f
pack $m.response $m.order $m.cb $m.buttons -side top -fill both -expand 1
set m .opt
m figure create remez
graph $m.g -figure m remez
pack $m.g $m.f -side left -fill both -expand 1
opt_plot 1
}
proc opt_plot { newValue } {
global opt_onParamChange
if { $opt_onParamChange == 0 && $newValue != 0 } return
global opt_filter_order
global opt_spec
set f "\[ $opt_spec(f0s) $opt_spec(f0e) $opt_spec(f1s) $opt_spec(f1e) \]'"
set h "\[ $opt_spec(h0s) $opt_spec(h0e) $opt_spec(h1s) $opt_spec(h1e) \]'"
set cmd [ join "do_remez( $opt_filter_order , $f , $h )" ]
m eval $cmd
}
proc compute_matrices { mat mat_size } {
# generate a random matrix and assoicated color decompositions
m eval "$mat = rand($mat_size);"
m eval "\[ R$mat, G$mat, B$mat \] = color_mat( $mat, r, g, b );"
# do the same for its inverse
set inv ${mat}inv
m eval "$inv = inv($mat);"
m eval "\[ R$inv, G$inv, B$inv \] = color_mat( $inv, r, g, b );"
# return the name of the inverse matrix
return $inv
}
proc draw_matrix { mat mat_size pixel_size cnvs } {
# extract the r,g,b matrices in column order (the default)
# and two character- wide hexidecimal format.
# assume that the red, green, and blue matrices associated with
# the input matrix 'mat' are R$mat, G$mat, and B$mat
set r [ m var R$mat -format %0.2x ]
set g [ m var G$mat -format %0.2x ]
set b [ m var B$mat -format %0.2x ]
set canv_size [ expr $pixel_size * $mat_size ]
# create two canvases, one for the matrix x and another for its
# inverse
$cnvs configure -height $canv_size -width $canv_size
for { set xp 0; set j 0} { $j < $mat_size } {
incr xp $pixel_size; incr j } {
set r_j [ lindex $r $j ]
set g_j [ lindex $g $j ]
set b_j [ lindex $b $j ]
for { set yp 0; set i 0 } { $i < $mat_size } {
incr yp $pixel_size; incr i } {
set r_color [ lindex $r_j $i ]
set g_color [ lindex $g_j $i ]
set b_color [ lindex $b_j $i ]
set color \#$r_color$g_color$b_color
$cnvs create rectangle $xp $yp [ expr $xp + $pixel_size ] \
[ expr $yp + $pixel_size ] -fill $color -outline ""
}
}
}
set mat_size 40
set pix_size 4
proc inv_plot {} {
global mat_size
global pix_size
if { ![ winExists .inv_canv ] } {
toplevel .inv_canv
set canv_size [ expr $mat_size * $pix_size ]
wm title .inv_canv "$mat_size x $mat_size random matrix and its inverse"
set m .inv_canv
canvas $m.org -height $canv_size -width $canv_size
canvas $m.inv -height $canv_size -width $canv_size
pack $m.org $m.inv -side left -in $m -fill both -expand 1
}
set mat_size [ expr abs($mat_size) ]
puts -nonewline "computing matrices ... "
flush stdout
set etime [ clock seconds ]
set invx [ compute_matrices x $mat_size ]
set etime [ expr [ clock seconds ] - $etime ]
puts "done ($etime seconds)."
puts -nonewline "drawing matrices ..... "
flush stdout
set etime [ clock seconds ]
draw_matrix x $mat_size $pix_size .inv_canv.org
draw_matrix $invx $mat_size $pix_size .inv_canv.inv
set etime [ expr [ clock seconds ] - $etime ]
puts "done ($etime seconds)."
}
proc inv_demo {} {
if { [ winExists .inv_control ] } return
toplevel .inv_control
wm title .inv_control "Matrix Inverse Patterns"
global mat_size
global pix_size
# create the colormap once
m eval {
function [ r , g , b ] = clrmap( num_colors )
% black-red-yellow-white colormap
third_num_colors = floor( num_colors / 3 );
r = ones(num_colors,1);
r(1:third_num_colors+1) = [ 0 : 1/(third_num_colors) : 1 ]';
r = round( r * 255 );
g = r >> third_num_colors;
b = g >> third_num_colors;
end;
function [ cx ] = normat( x, max_int )
% determine range
max_x = max(x(:));
min_x = min(x(:));
range_x = max_x - min_x;
% offset and scale
nx = ( x - min_x ) / range_x;
% map the values of nx into integers in the range [0 max_int]
cx = round( nx * ( max_int - 1 ) ) + 1;
end;
function [ Rx, Gx, Bx ] = color_mat( x, r , g , b )
% transform the matrix
tx = normat( x , length(r) );
Rx = x;
Gx = x;
Bx = x;
% decompose the transformed matrix into color components
Rx(:) = r(tx(:));
Gx(:) = g(tx(:));
Bx(:) = b(tx(:));
end;
}
m eval { [ r, g, b ] = clrmap( 128 ); }
set m .inv_control
entry $m.eMatSize -textvariable mat_size -width 4
entry $m.ePixSize -textvariable pix_size -width 5
label $m.lMatSize -text "Matrix size:"
label $m.lPixSize -text "Pixels per element:"
button $m.comp -text "Compute" -command { inv_plot }
button $m.exit -text "Dismiss" \
-command { destroy .inv_canv; destroy .inv_control }
# arrange them in a 3x2 grid
grid $m.lMatSize -row 0 -column 0 -in $m -sticky nsew
grid $m.eMatSize -row 0 -column 1 -in $m -sticky nsew
grid $m.lPixSize -row 1 -column 0 -in $m -sticky nsew
grid $m.ePixSize -row 1 -column 1 -in $m -sticky nsew
grid $m.comp -row 2 -column 0 -in $m -sticky nsew
grid $m.exit -row 2 -column 1 -in $m -sticky nsew
}
proc gallery_demo {} {
if { [ winExists .gal ] } return
toplevel .gal
wm title .gal "Plot Gallery"
m eval {
function [] = plotgal()
n=8;
x=(0:n)/n;
y=x.*(1.2-x);
y /= max(y);
z=y'*y;
fid = -1;
figi('m',fid++)
fill3d(z)
figi('m',fid++)
surcnt(689,z)
figi('m',fid++)
surcnt(2209,z)
figi('m',fid++)
plot(x,'+',x,y,'g',y/2)
figi('m',fid++)
contour(z)
grid
title('contour')
figi('m',fid++)
mesh(z)
figi('m',fid++)
plot(x,y)
hold on
plot(x,z)
hold off
xlabel('X Axis')
%mesh/contour plot
epsi = 1e-14;
x=(-24:3:24)/3;
y=x';
X=ones(y)*x;
Y=y*ones(x);
R=sqrt(X.^2+Y.^2) + epsi;
Z=sin(R)./R;
figi('m',fid++)
mesh(Z)
figi('m',fid++)
contour(Z)
grid
xlabel('range')
ylabel('doppler')
title('Contour')
% contours with labels
figi('m',fid++)
cntrlb(Z)
grid
xlabel('range')
ylabel('doppler')
title('Contour')
% NOTE: surcnt() (Surface-Contour) and fill3d() syntax and options are
% subject to change in later versions for 4.0 compatibility
%options for surface contours
% 1 - hide surface
% 16 - backfill
% 32 - fill contour
% 64 - line contour
% 128 - frame
% 256 - back frame
% 512 - draw filled surface
% 1024 - draw a single color wire frame
% 2048 - draw multi-colored wires
opt = 1+128+512+1024; % fill3d
figi('m',fid++)
surcnt(opt,Z)
opt=1+32+64+128+256+512+1024;
figi('m',fid++)
surcnt(opt,Z)
}
frame .gal.b; # buttons
frame .gal.p; # all plots
frame .gal.p.s; # 'small' plots
set num_plots 12
for { set i 0 } { $i < $num_plots } { incr i } {
m figure create $i
}
graph .gal.p.0 -figure m 0 -height 300 -bg \#12a
graph .gal.p.s.1 -figure m 1 -height 150 -bg \#a21
graph .gal.p.s.2 -figure m 2 -height 150 -bg \#bce
set w .gal.b
for { set i 0 } { $i < $num_plots } { incr i } {
set p0 [ expr ( $i ) % $num_plots ]
set p1 [ expr ( $i + 1 ) % $num_plots ]
set p2 [ expr ( $i + 2 ) % $num_plots ]
set c0 ".gal.p.0 configure -figure m $p0"
set c1 ".gal.p.s.1 configure -figure m $p1"
set c2 ".gal.p.s.2 configure -figure m $p2"
button $w.b$i -text $i -command "$c0; $c1; $c2"
pack $w.b$i -in $w -side left -expand 1 -fill x
}
button $w.dismiss -text "Dismiss" -command { destroy .gal }
pack $w.dismiss -in $w -side left -expand 1 -fill x
pack .gal.p.s.1 .gal.p.s.2 -in .gal.p.s \
-padx 2 -pady 2 -side top -expand 1 -fill both
pack .gal.p.0 .gal.p.s -in .gal.p \
-padx 2 -pady 2 -side left -expand 1 -fill both
pack .gal.p .gal.b -in .gal \
-padx 2 -pady 2 -side top -expand 1 -fill both
m eval plotgal
}
set pr_line_entered 0
set pr_history(0) ""
set pr_history_cur 0
set pr_history_last 0
proc prState {} {
global pr_history
global pr_history_last
global pr_history_cur
puts "l = $pr_history_last, c = $pr_history_cur"
for { set i 0 } { $i < $pr_history_last } { incr i } {
puts "$i $pr_history($i)\n"
}
}
proc prGet {} {
global mv_line_entered
global pr_history
global pr_history_last
global pr_history_cur
set pr_line_entered 0
.pr.p.e delete 0 end
focus -force .pr.p.e
while { 1 } {
tkwait variable pr_line_entered
set line [ .pr.p.e get ]
if { ![ string match $line "" ] } {
break;
}
}
set pr_history_cur $pr_history_last
set pr_history($pr_history_last) $line
incr pr_history_last
return $line
}
proc prUp {} {
global pr_history
global pr_history_last
global pr_history_cur
.pr.p.e delete 0 end
.pr.p.e insert 0 $pr_history($pr_history_cur)
if { $pr_history_cur > 0 } {
incr pr_history_cur -1; #decrement the history index
}
}
proc prDown {} {
global pr_history
global pr_history_last
global pr_history_cur
if { $pr_history_cur == $pr_history_last - 1 } return
if { $pr_history_cur < $pr_history_last - 1 } {
incr pr_history_cur
}
.pr.p.e delete 0 end
.pr.p.e insert 0 $pr_history($pr_history_cur)
}
proc prompt_demo {} {
if { [ winExists .pr ] } return
m figure create prf
m figure current prf
toplevel .pr
wm title .pr "Interactive Plotting"
graph .pr.g -figure m prf
frame .pr.p
entry .pr.p.e -width 50 -background peachpuff
label .pr.p.l -text "Prompt >> "
pack .pr.p.l .pr.p.e -in .pr.p -side left -fill x -expand 1
frame .pr.b
button .pr.b.d -text "Dismiss" -command {
# "destroy .pr" seems to crash Tk -- oops!
.pr.p.e delete 0 end
.pr.p.e insert end "exit"
set pr_line_entered 1
}
button .pr.b.c -text "Clear Figure" -command { m figure clear prf }
pack .pr.b.c .pr.b.d -in .pr.b -side left
pack .pr.g -in .pr -fill both -expand 1
pack .pr.p -in .pr -fill x -expand 1
pack .pr.b -in .pr -anchor w
tkwait visibility .pr
bind .pr.p.e <KeyPress-Return> { set pr_line_entered 1 }
bind .pr.p.e <Control-p> prUp
bind .pr.p.e <Control-n> prDown
bind .pr.p.e <KeyPress-Up> prUp
bind .pr.p.e <KeyPress-Down> prDown
m configure -getProc prGet
puts "* Type MathViews command at the prompt."
puts "** Hit <Enter> to execute them to execute commands."
puts "** Use C-p, up-arrow, C-n, and down-arrow to scroll through command history."
m eval
destroy .pr
puts "* interactive session ended"
m configure -getProc ""
}
proc invoke { index } {
set line_num [ lindex [ split $index . ] 0 ]
switch $line_num {
3 lfm_demo
4 opt_demo
5 inv_demo
6 gallery_demo
7 prompt_demo
}
if { $line_num >=3 && $line_num <= 7 } {
.t tag add visited "$index linestart" "$index lineend"
}
}
set font {Helvetica 14 bold}
text .t -font $font -width 40 -height 8
button .d -text "Dismiss" -command { destroy . }
.t insert end "MathViews Demonstrations"
.t insert end "\n\n1) Linear Frequency Modulation" { demo }
.t insert end "\n2) Optimal FIR Filter Design" { demo }
.t insert end "\n3) Matrix Inverse Patterns" { demo }
.t insert end "\n4) Plot Gallery" { demo }
.t insert end "\n5) Interactive Session" { demo }
.t tag configure title -font { Helvetica 18 bold }
.t tag configure demo -lmargin1 1c -lmargin2 1c \
-foreground blue -underline 1
.t tag configure visited -lmargin1 1c -lmargin2 1c \
-foreground \#303080 -underline 1
.t tag configure hot -foreground red -underline 1
.t tag bind demo <ButtonRelease-1> {
set index [.t index {@%x,%y}]
invoke $index
}
.t tag bind demo <Enter> {
set lastLine [.t index {@%x,%y linestart}]
.t tag add hot "$lastLine" "$lastLine lineend"
.t config -cursor hand2
}
.t tag bind demo <Leave> {
.t tag remove hot 1.0 end
.t config -cursor xterm
}
.t tag bind demo <Motion> {
set newLine [.t index {@%x,%y linestart}]
if {[string compare $newLine $lastLine] != 0} {
.t tag remove hot 1.0 end
set lastLine $newLine
set tags [.t tag names {@%x,%y}]
set i [lsearch -glob $tags demo-*]
if {$i >= 0} {
.t tag add hot "$lastLine" "$lastLine lineend"
}
}
}
proc run {} {
pack .t .d -side top -fill x
}
run