# Contour plot demo.

proc x09 {{w loopback}} {

    set xpts 35
    set ypts 46

    matrix clevel f 11 = {-1., -.8, -.6, -.4, -.2, 0, .2, .4, .6, .8, 1.}

    matrix mark  i 1 = { 1500 }
    matrix space i 1 = { 1500 }

    matrix zz f $xpts $ypts
    matrix ww f $xpts $ypts

# Calculate the data matrices.

    for {set i 0} {$i < $xpts} {incr i} {
	set xx [expr {($i - ($xpts / 2)) / double($xpts / 2)} ]
	for {set j 0} {$j < $ypts} {incr j} {
	    set yy [expr {($j - ($ypts / 2)) / double($ypts / 2) - 1.0} ]
	    zz $i $j = [expr {$xx * $xx - $yy * $yy} ]
	    ww $i $j = [expr {2. * $xx * $yy} ]
	}
    }

    matrix xg0 f $xpts
    matrix yg0 f $ypts

    matrix xg1 f $xpts
    matrix yg1 f $ypts

    matrix xg2 f $xpts $ypts
    matrix yg2 f $xpts $ypts

    set distort .4

# Build the 1-d coord arrays.

    for {set i 0} {$i < $xpts} {incr i} {
	set xx [expr {-1. + $i * ( 2. / ($xpts-1.) )}]
	xg0 $i = [expr {$xx}]
	xg1 $i = [expr {$xx + $distort * cos( .5 * $::PLPLOT::PL_PI * $xx )} ]
    }

    for {set j 0} {$j < $ypts} {incr j} {
	set yy [expr {-1. + $j * ( 2. / ($ypts-1.) )}]
	yg0 $j = [expr {$yy}]
	yg1 $j = [expr {$yy - $distort * cos( .5 * $::PLPLOT::PL_PI * $yy )} ]
    }

# Build the 2-d coord arrays.

    for {set i 0} {$i < $xpts} {incr i} {
	set xx [expr {-1. + $i * ( 2. / ($xpts-1.) )}]
	for {set j 0} {$j < $ypts} {incr j} {
	    set yy [expr {-1. + $j * ( 2. / ($ypts-1.) )}]

	    set argx [expr .5 * $::PLPLOT::PL_PI * $xx]
	    set argy [expr .5 * $::PLPLOT::PL_PI * $yy]

	    xg2 $i $j = [expr {$xx + $distort * cos($argx) * cos($argy)} ]
	    yg2 $i $j = [expr {$yy - $distort * cos($argx) * cos($argy)} ]
	}
    }

# Plot using scaled identity transformation used to create
# xg0 and yg0.  The implementation is different, but this gives
# the same results as the mypltr transformation for the first
# plots in x09c.

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
#    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
#    $w cmd plcol0 2
#    $w cmd plcont zz clevel pltr1 xg0 yg0
#    $w cmd plstyl 1 mark space
#    $w cmd plcol0 3
#    $w cmd plcont ww clevel pltr1 xg0 yg0
#    $w cmd plstyl 0 mark space
#    $w cmd plcol0 1
#    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

    $w cmd pl_setcontlabelformat 4 3
    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 1
    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
    $w cmd plcol0 2
    $w cmd plcont zz clevel pltr1 xg0 yg0
    $w cmd plstyl 1 mark space
    $w cmd plcol0 3
    $w cmd plcont ww clevel pltr1 xg0 yg0
    $w cmd plstyl 0 mark space
    $w cmd plcol0 1
    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

# Plot using 1d coordinate transform

    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
    $w cmd plcol0 2
    $w cmd plcont zz clevel pltr1 xg1 yg1
    $w cmd plstyl 1 mark space
    $w cmd plcol0 3
    $w cmd plcont ww clevel pltr1 xg1 yg1
    $w cmd plstyl 0 mark space
    $w cmd plcol0 1
    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 1
#    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
#    $w cmd plcol0 2
#    $w cmd plcont zz clevel pltr1 xg1 yg1
#    $w cmd plstyl 1 mark space
#    $w cmd plcol0 3
#    $w cmd plcont ww clevel pltr1 xg1 yg1
#    $w cmd plstyl 0 mark space
#    $w cmd plcol0 1
#    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

# Plot using 2d coordinate transform

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
    $w cmd plcol0 2
    $w cmd plcont zz clevel pltr2 xg2 yg2
    $w cmd plstyl 1 mark space
    $w cmd plcol0 3
    $w cmd plcont ww clevel pltr2 xg2 yg2
    $w cmd plstyl 0 mark space
    $w cmd plcol0 1
    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 1
#    $w cmd plenv -1.0 1.0 -1.0 1.0 0 0
#    $w cmd plcol0 2
#    $w cmd plcont zz clevel pltr2 xg2 yg2
#    $w cmd plstyl 1 mark space
#    $w cmd plcol0 3
#    $w cmd plcont ww clevel pltr2 xg2 yg2
#    $w cmd plstyl 0 mark space
#    $w cmd plcol0 1
#    $w cmd pllab "X Coordinate" "Y Coordinate" "Streamlines of flow"

    #polar contour example.
    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
    x09_polar $w

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 1
#    x09_polar $w

    #potential contour example.
    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
    x09_potential $w

#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 1
#    x09_potential $w

# Restore defaults
    # $w cmd plcol0 1
#    $w cmd pl_setcontlabelparam 0.006 0.3 0.1 0
     $w cmd pllsty 1
}

# Demonstrate plotting of wrapped data.  What is significant to
# understand about this example is that for the common case of
# plotting polar data (or other forms of coordinates that wrap on
# themselves) you can do it from Tcl /without/ having to go to the
# trouble to construct a special data plotting matrix with an extra
# row or column and then copy the data into it, replicating the first
# row/col into the extra row/col.

proc x09_polar {{w loopback}} {

    $w cmd plenv -1 1 -1 1 0 -2
    $w cmd plcol0 1

# Hold perimeter
    matrix px f 100; matrix py f 100

    for {set i 0} {$i < 100} {incr i} {
	set t [expr {2. * $::PLPLOT::PL_PI * $i / 99.}]
	px $i = [expr {cos($t)}]
	py $i = [expr {sin($t)}]
    }

    $w cmd plline 100 px py

    set xpts 40; set ypts 40; set ylim [expr {$ypts - 1}]; set wrap 2
    matrix xg f $xpts $ylim
    matrix yg f $xpts $ylim
    matrix z f $xpts $ylim

    for {set i 0} {$i < $xpts} {incr i} {
	set r [expr {$i / ($xpts - 1.)}]
	for {set j 0} {$j < $ylim} {incr j} {
	    set t [expr {2. * $::PLPLOT::PL_PI * $j / ($ypts - 1.)}]

	    xg $i $j = [expr {$r * cos($t)}]
	    yg $i $j = [expr {$r * sin($t)}]

	    z $i $j = $r
	}
    }

    matrix lev f 10 = { .05, .15, .25, .35, .45, .55, .65, .75, .85, .95 }

    $w cmd plcol0 2
    $w cmd plcont z lev pltr2 xg yg $wrap

    $w cmd plcol0 1
    $w cmd pllab "" "" "Polar Contour Plot"
}

proc x09_potential {{w loopback}} {
# Shielded potential contour plot example

    set xpts 40; set ypts 64; set ylim [expr {$ypts - 1}]; set wrap 2;
    set perimeterpts 100; set nlevel 20

    # Create data to be contoured.
    matrix xg f $xpts $ylim
    matrix yg f $xpts $ylim
    matrix z f $xpts $ylim

    for {set i 0} {$i < $xpts} {incr i} {
	set r [expr {0.5 + $i}]
	for {set j 0} {$j < $ylim} {incr j} {
	    set theta [expr {(2. * $::PLPLOT::PL_PI  / ($ypts - 1.))*(0.5 + $j)}]

	    xg $i $j = [expr {$r * cos($theta)}]
	    yg $i $j = [expr {$r * sin($theta)}]
	}
    }

    set rmax $r
    set xmin [xg 0 0]
    set xmax $xmin
    set ymin [yg 0 0]
    set ymax $ymin
    for {set i 0} {$i < $xpts} {incr i} {
       for {set j 0} {$j < $ylim} {incr j} {
	  if {[xg $i $j] < $xmin} { set xmin [xg $i $j] }
	  if {[xg $i $j] > $xmax} { set xmax [xg $i $j] }
	  if {[yg $i $j] < $ymin} { set ymin [yg $i $j] }
	  if {[yg $i $j] > $ymax} { set ymax [yg $i $j] }
       }
    }
    set x0 [expr {($xmin + $xmax)/2.}]
    set y0 [expr {($ymin + $ymax)/2.}]

    # Expanded limits.

    set peps 0.05
    set xpmin [expr {$xmin - abs($xmin)*$peps}]
    set xpmax [expr {$xmax + abs($xmax)*$peps}]
    set ypmin [expr {$ymin - abs($ymin)*$peps}]
    set ypmax [expr {$ymax + abs($ymax)*$peps}]

    # Potential inside a conducting cylinder (or sphere) by method of images.
    # Charge 1 is placed at (d1, d1), with image charge at (d2, d2).
    # Charge 2 is placed at (d1, -d1), with image charge at (d2, -d2).
    # Also put in smoothing term at small distances.

    set eps 2.

    set q1 1.
    set d1 [expr {$rmax/4.}]

    set q1i [expr {- $q1*$rmax/$d1}]
    set d1i [expr {pow($rmax,2)/$d1}]

    set q2 -1.
    set d2 [expr {$rmax/4.}]

    set q2i [expr {- $q2*$rmax/$d2}]
    set d2i [expr {pow($rmax,2)/$d2}]

    for {set i 0} {$i < $xpts} {incr i} {
	for {set j 0} {$j < $ylim} {incr j} {
  	   set div1 [expr {sqrt(pow([xg $i $j]-$d1,2) + pow([yg $i $j]-$d1,2) + pow($eps,2))}]
  	   set div1i [expr {sqrt(pow([xg $i $j]-$d1i,2) + pow([yg $i $j]-$d1i,2) + pow($eps,2))}]
  	   set div2 [expr {sqrt(pow([xg $i $j]-$d2,2) + pow([yg $i $j]+$d2,2) + pow($eps,2))}]
  	   set div2i [expr {sqrt(pow([xg $i $j]-$d2i,2) + pow([yg $i $j]+$d2i,2) + pow($eps,2))}]
	   z $i $j = [expr {$q1/$div1 + $q1i/$div1i + $q2/$div2 + $q2i/$div2i}]
	}
     }

    set zmin [z 0 0]
    set zmax $zmin
    for {set i 0} {$i < $xpts} {incr i} {
	for {set j 0} {$j < $ylim} {incr j} {
	    if {[z $i $j] < $zmin} { set zmin [z $i $j] }
	    if {[z $i $j] > $zmax} { set zmax [z $i $j] }
	}
    }

    # Positive and negative contour levels.
    set dz [expr {($zmax-$zmin)/$nlevel}]
    set nlevelneg 0
    set nlevelpos 0
    matrix clevelneg f $nlevel
    matrix clevelpos f $nlevel
    for {set i 0} {$i < $nlevel} {incr i} {
       set clevel [expr {$zmin + ($i + 0.5)*$dz}]
       if {$clevel <= 0.} {
     	  clevelneg $nlevelneg = $clevel; incr nlevelneg
       } else {
	  clevelpos $nlevelpos = $clevel; incr nlevelpos
       }
     }

     # Colours!
     set ncollin 11
     set ncolbox 1
     set ncollab 2

     # Finally start plotting this page!
     $w cmd pladv 0
     $w cmd plcol0 $ncolbox

     $w cmd plvpas 0.1 0.9 0.1 0.9 1.0
     $w cmd plwind $xpmin $xpmax $ypmin $ypmax
     $w cmd plbox "" 0. 0 "" 0. 0

     $w cmd plcol0 $ncollin
     if {$nlevelneg >0} {
	# Negative contours
	# copy partially full clevelneg to full levneg required by plcont
	matrix levneg f $nlevelneg
    	for {set i 0} {$i < $nlevelneg} {incr i} {
	   levneg $i = [clevelneg $i]
	}
	$w cmd pllsty 2
    	$w cmd plcont z levneg pltr2 xg yg $wrap
     }

     if {$nlevelpos >0} {
	# Positive contours
	# copy partially full clevelpos to full levpos required by plcont
	matrix levpos f $nlevelpos
    	for {set i 0} {$i < $nlevelpos} {incr i} {
	   levpos $i = [clevelpos $i]
	}
	$w cmd pllsty 1
    	$w cmd plcont z levpos pltr2 xg yg $wrap
     }

    #Draw outer boundary
    matrix px f $perimeterpts
    matrix py f $perimeterpts
    for {set i 0} {$i < $perimeterpts} {incr i} {
       set t [expr {(2.*$::PLPLOT::PL_PI/($perimeterpts-1))*$i}]
	px $i = [expr {$x0 + $rmax*cos($t)}]
	py $i = [expr {$y0 + $rmax*sin($t)}]
    }

    $w cmd plcol0 $ncolbox
    $w cmd plline $perimeterpts px py

    $w cmd plcol0 $ncollab
    $w cmd pllab "" "" "Shielded potential of charges in a conducting sphere"
}
