Require percent.tcl

if ![winfo exists .mbar.sDomain] {
  _menu(Bar) . mbar {
    _Domain sDomain {
      Line
      {Menu Wrap wrap {} {}}
      {Action Percentage... {[_Current] Percentage}}
    }
  }
  pack forget .mbar.sDomain
  .mbar.sDomain configure -state disabled
}

PackData Subclass SurfaceData {
  Var domainType wrapU wrapV percent
  ClassVar {default {sdPatch 0 0 .25}}
  ClassVar {data {domainType wrapU wrapV percent}}
  ClassVar {array _surface}

  Method Restore {} {
    Self Menus
    Parent Restore
  }

  Method Menus {} {
    set uv [Owner get uv]
    foreach menu [SurfaceDomain get uv-menus] \
	{Self uvMenu sDomain [lindex $menu 0] [lindex $menu 1]}
    .mbar.sDomain.menu.wrap delete 0 end
    _menu(Menu) .mbar.sDomain.menu wrap \
	[list \
          [list Check [lindex $uv 0] _surface(wrapU) {[_Current] AutoDomain}] \
          [list Check [lindex $uv 1] _surface(wrapV) {[_Current] AutoDomain}] \
	]
  }

  Method uvMenu {button menu type {v "_surface(domainType)"}} {
    .mbar.$button.menu.$menu delete 0 end
    set uv [Owner get uv]
    _menu(Menu) .mbar.$button.menu $menu \
	[list \
	  [list Radio [lindex $uv 0] $v ${type}U {[_Current] AutoDomain}] \
	  [list Radio [lindex $uv 1] $v ${type}V {[_Current] AutoDomain}] \
	]
  }
}

csObject Subclass basicSurface {
  Var F C D
  ClassVar {domain {{-1 1 10} {-1 1 10}}}
  ClassVar f-u f-v {uv {u v}} f-setup
  ClassVar {delta .00001}
  ClassVar "save-list {[csObject get save-list] Data}"
  ClassVar "pack-list {[csObject get pack-list] Data}"
  SurfaceData Instance Data

  Method Select {} {
    .mbar.sDomain configure -state normal
    pack .mbar.sDomain -side left
    .mbar.color.menu entryconfigure "by Parameter" -state normal
  }
  Method Unselect {} {
    pack forget .mbar.sDomain
    .mbar.sDomain configure -state disabled
    .mbar.color.menu entryconfigure "by Parameter" -state disabled
  }

  Method F {u {v {}}} {
    Vars uv f-u f-v f-setup
    Self InheritVars point
    if {$v == ""} {
      if {[llength $u] == 1} {return -code error \
          "no value given for parameter \"v\" to \"[Self method F]\""} 
      set v [lindex $u 1]; set u [lindex $u 0]
    }
    upvar [lindex $uv 0] uu
    upvar [lindex $uv 1] vv
    catch {set oldu $uu}; catch {set oldv $vv}
    set uu [uplevel expr double($u)]
    set vv [uplevel expr double($v)]
    eval ${f-setup}
    if {${f-v} != ""} {_script(Run) ${f-v}}
    if {${f-u} != ""} {_script(Run) ${f-u}}
    set P [uplevel $point]
    catch {set uu $oldu}; catch {set vv $oldv}
    return $P
  }

  Method ApplyF {list} {
    Vars f-u f-v f-setup uv
    Self InheritVars point
    upvar [lindex $uv 0] u
    upvar [lindex $uv 1] v
    catch {set oldu $u}; catch {set oldv $v}
    eval ${f-setup}
    if {${f-u} != ""} {set FU {_script(Run) ${f-u}}} else {set FU {}}
    if {${f-v} != ""} {set FV {_script(Run) ${f-v}}} else {set FV {}}
    set results {}
    if {[llength [lindex $list 0]] == 1} {set list [list $list]}
    foreach p $list {
      set u [uplevel expr double([lindex $p 0])]
      set v [uplevel expr double([lindex $p 1])]
      eval $FV; eval $FU
      lappend results [uplevel $point]
    }
    catch {set u $oldu}; catch {set v $oldv}
    return $results
  }

  Method Fu {u {v ""} {d ""}} {
    Vars uv f-u f-v f-setup
    Self InheritVars point
    if {$v == ""} {
      if {[llength $u] == 1} {return -code error \
          "no value given for parameter \"v\" to \"[Self method F]\""} 
      set v [lindex $u 1]; set u [lindex $u 0]
    }
    if {$d == ""} {set d [val delta]}

    global tcl_precision
    set prec $tcl_precision
    set tcl_precision 17

    upvar [lindex $uv 0] uu
    upvar [lindex $uv 1] vv
    catch {set oldu $uu}; catch {set oldv $vv}
    eval ${f-setup}
    if {${f-u} != ""} {set FU {_script(Run) ${f-u}}} else {set FU {}}
    if {${f-v} != ""} {set FV {_script(Run) ${f-v}}} else {set FV {}}

    set uu [uplevel expr double($u)]
    set vv [uplevel expr double($v)]
    eval $FV; eval $FU;
    set P0 [uplevel $point]
    set uu [expr $uu + $d]
    eval $FU;
    set P1 [uplevel $point]
    set V  [/ [- $P1 $P0] $d]
    set tcl_precision $prec
    set v {}; foreach e $V {lappend v [expr $e]}
    catch {set uu $oldu}; catch {set vv $oldv}
    return $v
  }

  Method Fv {u {v ""} {d ""}} {
    Vars uv f-u f-v f-setup
    Self InheritVars point
    if {$v == ""} {
      if {[llength $u] == 1} {return -code error \
          "no value given for parameter \"v\" to \"[Self method F]\""} 
      set v [lindex $u 1]; set u [lindex $u 0]
    }
    if {$d == ""} {set d [val delta]}

    global tcl_precision
    set prec $tcl_precision
    set tcl_precision 17

    upvar [lindex $uv 0] uu
    upvar [lindex $uv 1] vv
    catch {set oldu $uu}; catch {set oldv $vv}
    eval ${f-setup}
    if {${f-u} != ""} {set FU {_script(Run) ${f-u}}} else {set FU {}}
    if {${f-v} != ""} {set FV {_script(Run) ${f-v}}} else {set FV {}}

    set uu [uplevel expr double($u)]
    set vv [uplevel expr double($v)]
    eval $FV; eval $FU;
    set P0 [uplevel $point]
    set vv [expr $vv + $d]
    eval $FV; eval $FU;
    set P1 [uplevel $point]
    set V  [/ [- $P1 $P0] $d]
    set tcl_precision $prec
    set v {}; foreach e $V {lappend v [expr $e]}
    catch {set uu $oldu}; catch {set vv $oldv}
    return $v
  }

  Method nuv {u {v ""} {d ""}} {
    Vars uv f-u f-v f-setup
    Self InheritVars point
    if {$v == ""} {
      if {[llength $u] == 1} {return -code error \
          "no value given for parameter \"v\" to \"[Self method F]\""} 
      set v [lindex $u 1]; set u [lindex $u 0]
    }
    if {$d == ""} {set d [val delta]}

    global tcl_precision
    set prec $tcl_precision
    set tcl_precision 17

    upvar [lindex $uv 0] uu
    upvar [lindex $uv 1] vv
    catch {set oldu $uu}; catch {set oldv $vv}
    eval ${f-setup}
    if {${f-u} != ""} {set FU {_script(Run) ${f-u}}} else {set FU {}}
    if {${f-v} != ""} {set FV {_script(Run) ${f-v}}} else {set FV {}}

    set uu [uplevel expr double($u)]
    set vv [uplevel expr double($v)]
    eval $FV; eval $FU;
    set P0 [uplevel $point]
    set uu [expr $uu + $d]
    eval $FU;
    set P1 [uplevel $point]
    set U  [/ [- $P1 $P0] $d]
    set uu [expr $uu - $d]
    set vv [expr $vv + $d]
    eval $FV; eval $FU;
    set P1 [uplevel $point]
    set V  [/ [- $P1 $P0] $d]
    set tcl_precision $prec
    set u {}; foreach e $U {lappend u [expr $e]}
    set v {}; foreach e $V {lappend v [expr $e]}
    catch {set uu $oldu}; catch {set vv $oldv}
    return [list [>< $u $v] $u $v]
  }

  Method GaussCurvature {u {v ""} {d ""}} {
    Vars uv f-u f-v f-setup
    Self InheritVars point
    if {$v == ""} {
      if {[llength $u] == 1} {return -code error \
          "no value given for parameter \"v\" to \"[Self method F]\""} 
      set v [lindex $u 1]; set u [lindex $u 0]
    }
    if {$d == ""} {set d [val delta]}

    global tcl_precision
    set prec $tcl_precision
    set tcl_precision 17

    upvar [lindex $uv 0] uu
    upvar [lindex $uv 1] vv
    catch {set oldu $uu}; catch {set oldv $vv}
    eval ${f-setup}
    if {${f-u} != ""} {set FU {_script(Run) ${f-u}}} else {set FU {}}
    if {${f-v} != ""} {set FV {_script(Run) ${f-v}}} else {set FV {}}

    set uu [uplevel expr double($u)]
    set vv [uplevel expr double($v)]
    eval $FV; eval $FU;
    set P0 [uplevel $point]

    set uu [expr $uu + $d]; eval $FU;
    set Xu [/ [- [uplevel $point] $P0] $d]

    set uu [expr $uu - $d - $d]; eval $FU;
    set Xuu [/ [- [/ [- $P0 [uplevel $point]] $d] $Xu] $d]

    set uu [expr $uu + $d]
    set vv [expr $vv + $d]
    eval $FV; eval $FU;
    set P1 [uplevel $point]
    set Xv [/ [- $P1 $P0] $d]

    set uu [expr $uu + $d]; eval $FU;
    set Xuv [/ [- [/ [- [uplevel $point] $P1] $d] $Xu] $d]

    set uu [expr $uu - $d]
    set vv [expr $vv - $d - $d]
    eval $FV; eval $FU;
    set Xvv [/ [- [/ [- $P0 [uplevel $point]] $d] $Xv] $d]

    set N [Unit [>< $Xu $Xv]]
    set e [Dot $N $Xuu]; set f [Dot $N $Xuv]; set g [Dot $N $Xvv]
    set E [Dot $Xu $Xu]; set F [Dot $Xu $Xv]; set G [Dot $Xv $Xv]
    
    set tcl_precision $prec
    catch {set uu $oldu}; catch {set vv $oldv}
    return [expr ($e*$g-$f*$f)/($E*$G-$F*$F)]
  }

  Method NUV {u {v ""} {d ""}} {
    set NUV {}
    foreach v [uplevel [list Self nuv $u $v $d]] {lappend NUV [Unit $v]}
    return $NUV
  }

  Method Normal {u {v ""} {d ""}} \
    {return [lindex [uplevel [list Self nuv $u $v $d]] 0]}
  Method UnitNormal {u {v ""} {d ""}} \
    {return [Unit [lindex [uplevel [list Self nuv $u $v $d]] 0]]}
  Method Fx {u {v ""} {d ""}} \
    {return [lrange [uplevel [list Self Fu $u $v $d]] 2 end]}
  Method Fy {u {v ""} {d ""}} \
    {return [lrange [uplevel [list Self Fv $u $v $d]] 2 end]}
  Method Gradient {u {v ""} {d ""}} {
    set nuv [uplevel [list Self nuv $u $v $d]]
    return [list [lrange [lindex $nuv 1] 2 end] [lrange [lindex $nuv 2] 2 end]]
  }
  Method Df {u {v ""} {d ""}} \
    {return [lrange [uplevel [list Self nuv $u $v $d]] 1 2]}

  Method Compute {} {
    Vars F C D domain f-u f-v uv f-setup
    Self InheritVars point

    Self Color Init
    upvar [lindex $uv 0] u
    upvar [lindex $uv 1] v
    set F {}; set C {}; set D {}

    foreach UV [Self GetDomainList [uplevel [list subst $domain]]] {
      Self GetDomain $UV
      lappend D [lreplace $UV 0 1 [list $um $uM $un] [list $vm $vM $vn]]
      set colorfn [lindex $UV 3]
      set _F {}; set _C {}
      eval ${f-setup}
      for {set j 0; set v $vm} {$j <= $vn} {incr j;set v [expr $j*$vd+$vm]} {
	_script(Run) ${f-v}
	for {set i 0; set u $um} {$i <= $un} {incr i;set u [expr $i*$ud+$um]} {
	  _script(Run) ${f-u}
	  lappend _F [uplevel $point]
	  lappend _C [eval [list $ColorFN $colorfn]]
	}
      }
      lappend F $_F
      lappend C $_C
    }
    Self NormalizeColors
  }

  Method Recolor {} {
    Vars uv F C D
    Self Color Init
    upvar [lindex $uv 0] u
    upvar [lindex $uv 1] v
    upvar _X _X

    set C {}; set f 0
    set dim [Self getDimension]
    foreach UV $D {
      Self GetDomain $UV
      set colorfn [lindex $UV 3]
      set _C {}; set _F [lindex $F $f]; set k 0
      for {set j 0; set v $vm} {$j <= $vn} {incr j;set v [expr $j*$vd+$vm]} {
	for {set i 0; set u $um} {$i <= $un} {incr i;set u [expr $i*$ud+$um]} {
	  set xyz [lindex $_F $k]; incr k
	  foreach n [array names _X] {set _X($n) [lindex $xyz $n]}
	  lappend _C [eval [list $ColorFN $colorfn]]
	}
      }
      lappend C $_C
    }
    Self NormalizeColors
  }

  Method NormalizeColors {} {
    uplevel {
      set nC {}
      foreach _C $C {lappend nC [Self Color Normalize $_C]}
      set C $nC
    }
  }

  Method WriteOOGL {file} {
    Vars domain F C D
    set isColored [Self Color isColored]
    set isSolid   [Self Color isSolid]
    set dim [Self getDimension]
    set d [llength $D]
    set t [expr [Self Data get percent]/2.0]
    if {[Self Data get wrapU]} {set U "u"} else {set U ""}
    if {[Self Data get wrapV]} {set V "v"} else {set V ""}

    if {$d > 1} {puts $file "LIST"}
    for {set f 0} {$f < $d} {incr f} {
      Self GetDomain [lindex $D $f]
      if {$un < 1 || $vn < 1} {
	puts $file "{ LIST }"
      } else {
	set un1 [expr $un+1]
	set vn1 [expr $vn+1]
	set _F [lindex $F $f]
	set _C [lindex $C $f]
	set dType "sd[lindex [lindex $D $f] 2]"
	if {$dType == "sd"} {set dType [Self Data get domainType]}
	puts $file "{"; $dType Write $file; puts $file "}"
      }
    }
  }

  Method GetDomainList {D} {
    if {[llength [lindex [lindex $D 0] 0]] == 1} {set D [list $D]}
    return $D
  }

  Method InheritSurfaceDomainList {D object} {
    set DD {}
    foreach domain [basicSurface GetDomainList $D] {
      set v [string tolower [lindex $domain 0]]
      if {$v == "inherit" || $v == ""} {
        set D [uplevel 2 [list subst [$object get domain]]]
        foreach domain [$object GetDomainList $D] {lappend DD $domain}
      } else {lappend DD $domain}
    }
    return $DD
  }

  Method InheritCurveDomainList {D object} {
    set convert(Solid)  Patch
    set convert(Dashes) BandsU
    set convert(Dots)   LinesU

    set DD {}
    foreach domain [basicSurface GetDomainList $D] {
      set v [string tolower [lindex $domain 1]]
      if {$v == "inherit" || $v == ""} {
        set D [uplevel 2 [list subst [$object get domain]]]
        foreach cdomain [$object GetDomainList $D] {
          if {[llength $domain] >= 3} {
            set domain [lreplace $domain 1 1 [lindex $cdomain 0]]
          } else {
            set domain [list [lindex $domain 0] [lindex $cdomain 0]]
            set ctype [lindex $cdomain 1]
            if [info exists convert($ctype)] \
              {lappend domain $convert($ctype)}
          }
          lappend DD $domain
        }
      } else {
        lappend DD $domain
      }
    }
    return $DD
  }

  Method GetDomain {D} {
    set Du [_expr(List) [lindex $D 0] 2]
    set Dv [_expr(List) [lindex $D 1] 2]
    if {[llength $Du] != 3} \
	{Error [join [list "Illegal domain range '$Du';" \
			   "must be of the form 'min max divs'"]]}
    if {[llength $Dv] != 3} \
	{Error [join [list "Illegal domain range '$Dv';" \
			   "must be of the form 'min max divs'"]]}
    uplevel [list set Du $Du]
    uplevel [list set Dv $Dv]
    uplevel {
      _expr(Let) {um uM un} $Du
      if {$un == 0} {set ud 0} else {set ud [expr ($uM-$um)/double($un)]}
      _expr(Let) {vm vM vn} $Dv
      if {$vn == 0} {set vd 0} else {set vd [expr ($vM-$vm)/double($vn)]}
    }
  }

  Method AutoDomain {} {
    global _object
    Self Save
    _File Changed 1
    if {$_object(autoUpdate) && [val computed]} {Self HandleOOGL} \
	else {_Object NeedsUpdate [Self]}
  }

  Method HandleColor {} {
    if ![val written] return
    set dtype [Self Data get domainType]
    if {$dtype == "sdDots" || $dtype == "sdLinesU" ||
	$dtype == "sdLinesV" || $dtype == "sdGrid"} \
	    {Self Color set uncolored 0}
    Parent HandleColor
  }

  Method Percentage {} {
    global _surface
    set percent [expr 100.0*$_surface(percent)]
    _SelectPercent Request "Percentage of grid" $percent "[Self] _Percentage"
  }
  Method _Percentage {percent} {
    global _surface
    set _surface(percent) [expr $percent/100.0]
    Self AutoDomain
  }

  Method ColorMenus {} {
    Vars uv
    global _color
    .mbar.color.menu.parameter delete 0 end
    set u [lindex $uv 0]
    set v [lindex $uv 1]
    set var "_color(by)"
    _menu(Menu) .mbar.color.menu parameter \
	[list \
	  [list Radio $u $var [list set $u] {[_Current] AutoColor}] \
	  [list Radio $v $var [list set $v] {[_Current] AutoColor}] \
	]
    if {$_color(by-old) == "set $u" || $_color(by-old) == "set $v"} \
	{set _color(by) $_color(by-old)}
  }
}

ooRoot Subclass SurfaceDomain {
  ClassVar names uv-menus

  Method Instance {name menu uv {def {}}} {
    Vars names uv-menus
    Parent Instance $name $def
    lappend names $name
    if {$uv == ""} {
      set underline [_menu(Underline) menu]
      eval [list .mbar.sDomain.menu insert [llength $names] radiobutton \
		-label $menu -command {[_Current] AutoDomain} \
		-variable _surface(domainType) -value $name] $underline
    } else {
      regsub {_} [string tolower $menu] {} mname
      set underline [_menu(Underline) menu]
      eval [list .mbar.sDomain.menu insert [llength $names] cascade \
		-label $menu -menu \
		[_menu(Menu) .mbar.sDomain.menu $mname {} -tearoff 0]]\
	  $underline
      proc ${name}U {write file} "uplevel $name \$write U \$file"
      proc ${name}V {write file} "uplevel $name \$write V \$file"
      lappend uv-menus [list $mname $name]
    }
  }

  Method Write {file} {puts $file "LIST"}

  Method getMethod {fn} {
    regsub -all {%F} {
      if {$isSolid} {
	set c ""
	set %F [SurfaceDomain method %F]
      } else {
	set c "C"
	set %F [SurfaceDomain method %FC]
      }
    } $fn script
    uplevel 2 $script
  }

  Method Print {k} {
    upvar _F _F; upvar file file
    puts $file [lindex $_F $k]
  }

  Method PrintC {k} {
    upvar _F _F; upvar _C _C; upvar file file
    puts $file "[lindex $_F $k]  [lindex $_C $k]"
  }

  Method Interp {k1 k2 t} {
    upvar file file; upvar dim dim; upvar _F _F
    set p1 [lindex $_F $k1]
    set p2 [lindex $_F $k2]
    for {set p {}; set k 0} {$k < $dim} {incr k} {
      set x [lindex $p1 $k]; set y [lindex $p2 $k]
      lappend p [expr $x + $t * ($y - $x)]
    }
    puts $file $p
  }

  Method InterpC {k1 k2 t} {
    upvar file file; upvar dim dim; upvar _F _F; upvar _C _C
    set p1 [lindex $_F $k1]
    set p2 [lindex $_F $k2]
    for {set p {}; set k 0} {$k < $dim} {incr k} {
      set x [lindex $p1 $k]; set y [lindex $p2 $k]
      lappend p [expr $x + $t * ($y - $x)]
    }
    puts $file "$p  [lindex $_C $k1]"
  }

  Method Check {k i j t} {
    upvar un un; upvar vn vn; upvar un1 un1
    if {$i < 0} {set i 0} elseif {$i > $un} {set i $un}
    if {$j < 0} {set j 0} elseif {$j > $vn} {set j $vn}
    uplevel SurfaceDomain:Interp $k [expr $i + $j * $un1] $t
  }

  Method CheckC {k i j t} {
    upvar un un; upvar vn vn; upvar un1 un1
    if {$i < 0} {set i 0} elseif {$i > $un} {set i $un}
    if {$j < 0} {set j 0} elseif {$j > $vn} {set j $vn}
    uplevel SurfaceDomain:InterpC $k [expr $i + $j * $un1] $t
  }
}


SurfaceDomain Instance sdPatch "_Patch" {} {
  Method Write {file} {
    uplevel {
      if {$isSolid} {
	if {$dim == 3} {puts $file "${U}${V}MESH"} \
           else {puts $file "${U}${V}nMESH\n$dim"}
        if {$U == "" && $V == ""} {
	  puts $file "$un1 $vn1"
	  puts $file [join $_F \n]
        } else {
          if {$U != ""} {incr un1 -1}
          if {$V != ""} {incr vn1 -1}
          puts $file "$un1 $vn1"
          for {set k 0; set v 0} {$v < $vn1} {incr v} {
            puts $file [join [lrange $_F $k [expr $k+$un1-1]] \n]
	    incr k $un; incr k
          }
        }
      } else {
	if {$dim == 3} {puts $file "C${U}${V}MESH"} \
           else {puts $file "C${U}${V}nMESH\n$dim"}
        if {$U == "" && $V == ""} {
	  puts $file "$un1 $vn1"
	  for {set k 0; set n [llength $_F]} {$k < $n} {incr k} \
	      {puts $file "[lindex $_F $k]  [lindex $_C $k]"}
        } else {
          if {$U != ""} {incr un1 -1}
          if {$V != ""} {incr vn1 -1}
          puts $file "$un1 $vn1"
          for {set k 0; set v 0} {$v < $vn1} {incr v} {
            for {set u 0} {$u < $un1} {incr u; incr k} \
              {puts $file "[lindex $_F $k]  [lindex $_C $k]"}
            if {$U != ""} {incr k}
          }
        }
      }
    }
  }
}

SurfaceDomain Instance sdGrid "_Grid" {} {
  Method Write {file} {
    puts $file "LIST {"
    uplevel sdLines Write U $file
    puts $file "} {"
    uplevel sdLines Write V $file
    puts $file "}"
  }
}

SurfaceDomain Instance sdBands _Bands uv {
  Method Write {uv file} {
    Self getMethod Print
    if {$uv == "U"} {
      uplevel {
        if {$U != ""} {incr un1 -1}
	if {$dim == 3} {set mesh "${c}${U}MESH"} \
          else {set mesh "${c}${U}nMESH\n$dim"}
	puts $file "LIST"
	for {set v 0; set k 0} {$v < $vn} {incr v 2} {
	  puts $file "\{ $mesh"
	  puts $file "$un1 2"
          for {set i 0} {$i < 2} {incr i} {
             for {set u 0} {$u < $un1} {incr u; incr k} {$Print $k}
             if {$U != ""} {incr k}
          }
	  puts $file "\}"
	}
      }
    } else {
      uplevel {
        if {$V != ""} {set V {u}; incr vn1 -1}
	if {$dim == 3} {set mesh "${c}${V}MESH"} \
          else {set mesh "${c}${V}nMESH\n$dim"}
	puts $file "LIST"
	for {set u 0; set k 0} {$u < $un} {incr u 2; set k $u} {
	  puts $file "\{ $mesh"
	  puts $file "$vn1 2"
	  for {set v 0} {$v < $vn1} {incr v; incr k $un1} {$Print $k}
	  set k [expr $u + 1]
	  for {set v 0} {$v < $vn1} {incr v; incr k $un1} {$Print $k}
	  puts $file "\}"
	}
      }
    }
  }
}

SurfaceDomain Instance sdStripes "_Stripes" uv {
  Method Write {UV file} {
    Self getMethod Check
    if {$UV == "U"} {
      uplevel {
        set n $un1
        if {$U != ""} {set U {v}; incr n -1}
	if {$dim == 3} {set mesh "${c}${U}MESH\n2 $n"} \
	    else {set mesh "${c}${U}nMESH\n$dim\n2 $n"}

	puts $file "LIST"
	for {set v0 -1; set v1 1; set k 0} {$v1 <= $vn1} {incr v0; incr v1} {
	  puts $file "\{ $mesh"
	  for {set u 0} {$u < $n} {incr u; incr k} {
	     $Check $k $u $v0 $t
	     $Check $k $u $v1 $t
	  }
	  puts $file "\}"
          if {$U != ""} {incr k}
	}
      }
    } else {
      uplevel {
        set n $vn1; if {$V != ""} {incr n -1}
	if {$dim == 3} {set mesh "${c}${V}MESH\n2 $n"} \
	    else {set mesh "${c}${V}nMESH\n$dim\n2 $n"}

	puts $file "LIST"
	for {set u0 -1; set u1 1} {$u1 <= $un1} {incr u0; incr u1} {
	  puts $file "\{ $mesh"
	  for {set v 0; set k [expr $u1-1]} {$v < $n} {incr v; incr k $un1} {
	    $Check $k $u0 $v $t
	    $Check $k $u1 $v $t
	  }
	  puts $file "\}"
          if {$V != ""} {incr k $un1}
	}
      }
    }
  }
}

SurfaceDomain Instance sdLines "_Lines" uv {
  Method Write {uv file} {
    if {$uv == "U"} {
      uplevel {
	if {$dim == 3 || $dim == 4} {
	  if {$dim == 3} {puts $file "VECT"} else {puts $file "4VECT"}
	  if $isColored {puts $file "$vn1 [expr $un1*$vn1] [expr $un1*$vn1]"} \
	      else {puts $file "$vn1 [expr $un1*$vn1] 0"}
	  set line ""
	  for {set v 0} {$v < $vn1} {incr v} {
	    set line "$line $un1"
	    if {$v % 15 == 14} {set line "$line \n"}
	  }
	  puts $file $line; puts $file ""
	  if $isColored {puts $file $line} else {
	    for {set v 0} {$v < $vn1} {incr v} {
	      puts -nonewline $file "0 "
	      if {$v %15 == 14} {puts $file ""}
	    }
	  }
	  puts $file ""
	  puts $file [join $_F \n]
	  if $isColored {puts $file ""; puts $file [join $_C \n]}
	} else {
	  if {$isColored} {
	    puts $file "CnOFF\n$dim"
	    puts $file "[expr $un1*$vn1] [expr $un*$vn1] 0"
	    for {set k 0; set n [llength $_F]} {$k < $n} {incr k} \
		{puts $file "[lindex $_F $k]  [lindex $_C $k]"}
	  } else {
	    puts $file "nOFF\n$dim"
	    puts $file "[expr $un1*$vn1] [expr $un*$vn1] 0"
	    puts $file [join $_F \n]
	  }
	  for {set v 0; set k 0} {$v < $vn1} {incr v; incr k} {
	    for {set u 0} {$u < $un} {incr u} {puts $file "2  $k [incr k]"}
	  }
	}
      }
    } else {
      uplevel {
	if {$dim == 3 || $dim == 4} {
	  if {$dim == 3} {puts $file "VECT"} else {puts $file "4VECT"}
	  if $isColored {puts $file "$un1 [expr $un1*$vn1] [expr $un1*$vn1]"} \
	      else {puts $file "$un1 [expr $un1*$vn1] 0"}
	  set line ""
	  for {set u 0} {$u < $un1} {incr u} {
	    set line "$line $vn1"
	    if {$u % 15 == 14} {set line "$line \n"}
	  }
	  puts $file $line; puts $file ""
	  if $isColored {puts $file $line} else {
	    for {set u 0} {$u < $un1} {incr u} {
	      puts -nonewline $file "0 "
	      if {$u %15 == 14} {puts $file ""}
	    }
	  }
	  puts $file ""
	  for {set u 0; set k 0} {$u < $un1} {incr u; set k $u} {
	    for {set v 0} {$v < $vn1} {incr v; incr k $un1} \
		{puts $file [lindex $_F $k]}
	  }
	  if $isColored {
	    for {set u 0; set k 0} {$u < $un1} {incr u; set k $u} {
	      for {set v 0} {$v < $vn1} {incr v; incr k $un1} \
		  {puts $file [lindex $_C $k]}
	    }
	  }
	} else {
	  if {$isColored} {
	    puts $file "CnOFF\n$dim"
	    puts $file "[expr $un1*$vn1] [expr $un1*$vn] 0"
	    for {set k 0; set n [llength $_F]} {$k < $n} {incr k} \
		{puts $file "[lindex $_F $k]  [lindex $_C $k]"}
	  } else {
	    puts $file "nOFF\n$dim"
	    puts $file "[expr $un1*$vn1] [expr $un1*$vn] 0"
	    puts $file [join $_F \n]
	  }
	  for {set u 0; set k 0} {$u < $un1} {incr u; set k $u} {
	    for {set v 0} {$v < $vn} {incr v} \
		{puts $file "2  $k [incr k $un1]"}
	  }
	}
      }
    }
  }
}


SurfaceDomain Instance sdDots "_Dots" {} {
  Method Write {file} {
    uplevel {
      set n [expr $un1*$vn1]
      if {$dim == 3} {puts $file "SKEL"} else {puts $file "nSKEL\n$dim"}
      puts $file "$n $n"
      puts $file [join $_F \n]
      puts $file ""
      if {$isColored} {
	set i 0; foreach p $_C {puts $file "1  $i  $p"; incr i}
      } else {
	set len [llength $_F]
	for {set i 0} {$i < $len} {incr i} {puts $file "1  $i"}
      }
    }
  }
}

SurfaceDomain Instance sdChecks "_Checks" {} {
  Method Write {file} {
    Self getMethod Print
    uplevel {
      if {$dim == 3} {set mesh "${c}MESH\n2 2"} \
	  else {set mesh "${c}nMESH\n$dim\n2 2"}

      puts $file "LIST"
      for {set v 0} {$v < $vn} {incr v 2} {
	set k0 [expr $v * $un1];  set k1 [expr $k0 + 1]
	set k2 [expr $k0 + $un1]; set k3 [expr $k2 + 1]
	for {set u 0} {$u < $un} {incr u 2} {
	  puts $file "\{ $mesh"
	  $Print $k0; $Print $k1; $Print $k2; $Print $k3
	  puts $file "\}"
	  incr k0 2; incr k1 2; incr k2 2; incr k3 2
	}
      }
      for {set v 1} {$v < $vn} {incr v 2} {
	set k0 [expr $v * $un1 + 1]; set k1 [expr $k0 + 1]
	set k2 [expr $k0 + $un1]; set k3 [expr $k2 + 1]
	for {set u 1} {$u < $un} {incr u 2} {
	  puts $file "\{ $mesh"
	  $Print $k0; $Print $k1; $Print $k2; $Print $k3
	  puts $file "\}"
	  incr k0 2; incr k1 2; incr k2 2; incr k3 2
	}
      }
    }
  }
}

SurfaceDomain Instance sdSpots "Sp_ots" {} {
  Method Write {file} {
    Self getMethod Interp
    uplevel {
      if {$dim == 3} {set mesh "${c}MESH\n2 2"} \
	  else {set mesh "${c}nMESH\n$dim\n2 2"}

      puts $file "LIST"
      set k0 0; set k1 1; set k2 $un1; set k3 [expr $k2+1]
      for {set v 0} {$v < $vn} {incr v} {
	for {set u 0} {$u < $un} {incr u} {
	  puts $file "\{ $mesh"
	  $Interp $k0 $k3 $t
	  $Interp $k2 $k1 $t
	  $Interp $k1 $k2 $t
	  $Interp $k3 $k0 $t
	  puts $file "\}"
	  incr k0; incr k1; incr k2; incr k3
	}
	incr k0; incr k1; incr k2; incr k3
      }
    }
  }
}

SurfaceDomain Instance sdWeave "_Weave" {} {
  Method Write {file} {
    Self getMethod Check
    uplevel {
      if {$dim == 3} {set mesh "${c}MESH"} else {set mesh "${c}nMESH\n$dim"}

      puts $file "LIST"
      for {set v0 -1; set v1 1; set k 0} {$v1 <= $vn1} {incr v0; incr v1} {
	puts $file "\{ $mesh\n2 [expr 2*$un1]"
	for {set u0 -1; set u1 1} {$u1 <= $un1} {incr k; incr u0; incr u1} {
	  $Check $k $u0 $v1  $t
	  $Check $k $u0 $v0  $t
	  $Check $k $u1 $v1  $t
	  $Check $k $u1 $v0  $t
	}
	puts $file "\}"
	if {$v1 == $vn1} break
	incr k -$un1; set v [expr $v0 + 1]
	puts $file "\{ LIST"
	for {set u0 -1; set u1 1} {$u1 <= $un1} {incr u0; incr u1; incr k} {
	  puts $file "\{ $mesh\n2 2"
	  $Check $k $u0 $v1  $t
	  $Check $k $u1 $v1  $t; incr k $un1
	  $Check $k $u0 $v   $t
	  $Check $k $u1 $v   $t; incr k -$un1
	  puts $file "\}"
	}
	puts $file "\}"
      }
    }
  }
}

proc _sDomain(Border) {u v {color ""}} {
  let {um uM un} [uplevel [list subst $u]]
  let {vm vM vn} [uplevel [list subst $v]]
  return [list \
    [list [list $um $uM $un] [list $vm $vM $vn]] \
    [list [list $um $uM $un] [list $vm $vM 1] LinesU $color] \
    [list [list $um $uM 1] [list $vm $vM $vn] LinesV $color] \
  ]
}