Require menu.tcl
Require Class/basicArrows

if ![winfo exists .mbar.sVector] {
  _menu(Bar) . mbar {_Vector sVector {
    {Check _Normal      _sVector(N)  {_Object NeedsUpdate} checked}
    {Check "Tangent _U" _sVector(Fu) {_Object NeedsUpdate}}
    {Check "Tangent _V" _sVector(Fv) {_Object NeedsUpdate}}
    {Line}
    {Check _Unit _sVector(unit)}
  }}
  pack forget .mbar.sVector
  .mbar.sVector configure -state disabled
}

PackData Subclass sVectorData {
  Var N Fu Fv unit
  ClassVar {default {1 0 0 0}}
  ClassVar {data {N Fu Fv unit}}
  ClassVar {array _sVector}

  Method GetVType {} {
    upvar vType vType
    foreach name [Self get data] {set vType($name) [val $name]}
  }
}

basicArrows Subclass basicSurfaceVectors {
  ClassVar {domain Inherit}
  ClassVar {linkable-types basicSurface}

  ClassVar "save-list {[csObject get save-list] Data}"
  ClassVar "pack-list {[csObject get pack-list] Data}"
  sVectorData Instance Data

  Method Select {} {
    .mbar.sVector configure -state normal
    pack .mbar.sVector -side left
  }
  Method Unselect {} {
    pack forget .mbar.sVector
    .mbar.sVector configure -state disabled
  }

  Method Compute {} {
    Vars arrows domain htype

    Self Data GetVType
    set unit $vType(unit)
    set object [Self Reference Object]
    if {$object == "_NOOP"} return
    set uv [$object get uv]
    upvar [lindex $uv 0] u
    upvar [lindex $uv 1] v

    set addarrow [Self method AddArrow]
    set addarrows {}
    if {$vType(N) || $vType(Fu) || $vType(Fv)} {
      lappend addarrows "set NUV \[uplevel $object nuv \$u \$v\]"
      if $vType(N)  {lappend addarrows "$addarrow \[lindex \$NUV 0\] $unit"}
      if $vType(Fu) {lappend addarrows "$addarrow \[lindex \$NUV 1\] $unit"}
      if $vType(Fv) {lappend addarrows "$addarrow \[lindex \$NUV 2\] $unit"}
    }
    set addarrows [join $addarrows \n]

    set arrows {}
    foreach UV [Self GetDomainList [uplevel [list subst $domain]]] {
      basicSurface GetDomain $UV
      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 P [uplevel $object F $u $v]
          eval $addarrows
        }
      }
    }

    uplevel Parent Compute
  }

  Method AddArrow {V {unit 0}} {
    upvar arrows arrows; upvar P P; upvar htype htype
    if {$unit} {set V [Unit $V]}
    lappend arrows [list [list $P [+ $P $V]] $htype]
  }

  Method GetDomainList {D} {
    set object [Self Reference Object]
    uplevel [list basicSurface InheritSurfaceDomainList $D $object]
  }
}
