Require Class/basicSurface
Require Class/basicCurve

basicSurface Subclass basicSurfaceFromCurve {
  Var P TNB f-u f-v f-setup "uv {[basicSurface get uv]}"
  ClassVar {linkable-types basicCurve}
  ClassVar sf-u sf-v {frame 0}
  ClassVar "domain {{[lindex [basicSurface get domain] 0]} {Inherit}}"

  Method SetValues {} {
    Vars f-u f-v f-setup uv frame sf-u sf-v
    set object [Self Reference Object]
    set point [Self Inherit point]
    set P [var P]
    set t [lindex $uv 1]

    if {$frame && [$object getDimension] != 3} \
      {Error "Frame-based actions only work when '$object' is in 3 dimensions"}

    set f-setup [list "uplevel {upvar \#0 $P $P}"]

    set f-v [list "set $P \[$object F \${$t}\]"]
    if {$frame} {
      set TNB [var TNB]
      lappend f-v \
        "set $TNB \[Transpose \[join \[$object FFrame \${$t}\] { }\]\]"
      lappend f-setup "uplevel {upvar \#0 $TNB $TNB}"
    }
    if {${sf-v} != ""} {lappend f-v ${sf-v}}

    set f-u [list \
      {foreach _i [array names _X] {set _X($_i) 0}} \
      ${sf-u} \
      "set _P \[+ \${$P} \[$point\]\]" \
      {foreach _i [array names _X] {set _X($_i) [lindex $_P $_i]}} \
    ]
    if {$frame} {
      set f-u [lreplace ${f-u} 2 2 \
        "set _P \[+ \${$P} \[* \${$TNB} \[$point\]\]\]"]
    }

    set f-u [join ${f-u} \n]
    set f-v [join ${f-v} \n]
    set f-setup [join ${f-setup} \n]
  }

  Method SetUV {} {
    Vars sf-uv uv
    set t [lindex ${sf-uv} 1]
    if {$t == ""} {
      set object [Self Reference Object]
      if {![catch {set t [$object get param]}]} {
        if {$t == [lindex ${sf-uv} 0]} \
          {Error "Parameter '$t' is already in use by curve '$object'"}
      }
    }
    if {$t == ""} {set t "t"}
    set uv [list [lindex ${sf-uv} 0] $t]
  }

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

  Method Inherit {var} {Self InheritReference $var}
}
