Require menu.tcl
Require Class/basicArrows

if ![winfo exists .mbar.cVector] {
  _menu(Bar) . mbar {_Vector cVector {
    {Check _Tangent         _cvector(T)   {_Object NeedsUpdate} checked}
    {Check _Normal          _cvector(N)   {_Object NeedsUpdate}}
    {Check _Binormal        _cvector(B)   {_Object NeedsUpdate}}
    {Check _Velocity        _cvector(V)   {_Object NeedsUpdate}}
    {Check _Acceleration    _cvector(A)   {_Object NeedsUpdate}}
    {Check "Surface Normal" _cvector(SN)  {_Object NeedsUpdate}}
    {Check "Surface Fu"     _cvector(SFu) {_Object NeedsUpdate}}
    {Check "Surface Fv"     _cvector(SFv) {_Object NeedsUpdate}}
    {Line}
    {Check _Unit _cvector(unit)}
  }}
  pack forget .mbar.cVector
  .mbar.cVector configure -state disabled
}

PackData Subclass cVectorData {
  Var T N B V A SN SFu SFv unit
  ClassVar {default {1 0 0 0 0 0 0 0 0}}
  ClassVar {data {T N B V A SN SFu SFv unit}}
  ClassVar {array _cvector}

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

basicArrows Subclass basicCurveVectors {
  ClassVar {domain Inherit}
  ClassVar {linkable-types basicCurve}

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

  Method Select {} {
    .mbar.cVector configure -state normal
    pack .mbar.cVector -side left
  }
  Method Unselect {} {
    pack forget .mbar.cVector
    .mbar.cVector 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
    upvar [$object get param] t

    set addarrow [Self method AddArrow]
    set addarrows {}
    if {$vType(T) || $vType(N) || $vType(B)} {
      lappend addarrows "set TNB \[uplevel $object FFrame \$t\]"
      if $vType(T) {lappend addarrows "$addarrow \[lindex \$TNB 0\]"}
      if $vType(N) {lappend addarrows "$addarrow \[lindex \$TNB 1\]"}
      if $vType(B) {lappend addarrows "$addarrow \[lindex \$TNB 2\]"}
    } 
    if {$vType(SN) || $vType(SFu) || $vType(SFv)} {
      if {![$object TypeMatch basicCurveOnSurface]} \
        {Error "Surface vectors can only be used with curves on surfaces"}
      set sobject [$object Reference Object]
      lappend addarrows \
         "set NUV \[uplevel $sobject nuv \[uplevel $object Fuv \$t\]\]"
      if $vType(SN)  {lappend addarrows "$addarrow \[lindex \$NUV 0\] $unit"}
      if $vType(SFu) {lappend addarrows "$addarrow \[lindex \$NUV 1\] $unit"}
      if $vType(SFv) {lappend addarrows "$addarrow \[lindex \$NUV 2\] $unit"}
    }
    if $vType(V) {lappend addarrows "$addarrow \[$object Df  \$t\] $unit"}
    if $vType(A) {lappend addarrows "$addarrow \[$object D2f \$t\] $unit"}
    set addarrows [join $addarrows \n]

    set arrows {}
    foreach T [Self GetDomainList [uplevel [list subst $domain]]] {
      basicCurve GetDomain $T
      for {set i 0; set t $tm} {$i <= $tn} {incr i; set t [expr $t + $td]} {
        set P [uplevel $object F $t]
        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 basicCurve InheritCurveDomainList $D $object]
  }
}
