Require "Class/basicArrows"

basicArrows Subclass Axes {
  Var arrows

  Method Compute {} {
    Vars length positive htype
    Self InheritVars axes zero
    set head {}; set d [llength $zero]
    set len [uplevel [list subst $length]]
    if {[llength $len] == 1} {set one $len} else {set one 1}
    foreach e $len {lappend head [uplevel [list _expr(Math) $e]]}
    while {[llength $head] < $d} {lappend head $one}
    if {$positive} {set tail $zero} else {set tail [- $head]}
    set arrows {}; set i 0
    foreach x $axes {
      lappend arrows [list \
         [list [lreplace $zero $i $i [lindex $tail $i]] \
               [lreplace $zero $i $i [lindex $head $i]]] \
         $htype \
      ]
      incr i
    }
    uplevel [list Self MakeArrows $arrows]
    uplevel Self Recolor
  }

  Method Create {name {data ""}} {
    set name [Parent Create $name $data]
    if {$data == ""} {
      $name Appearance set lineWidth 3
      $name Appearance set lineW 3
      $name set colorfn(RGB) [val colorRGB]
      $name Color set by "_color(Fn) RGB"
    }
    return $name
  }

  Var length
  Method <Length> {len} {set [var length] $len}
  ClassVar {Length-template 1}

  Var positive
  Method <Positive> {} {set [var positive] 1}
  ClassVar {Positive-template {}}

  ClassVar {script-templates {Length Axes}}

  Method ScriptBegin {} {
    Vars length positive colorfn()
    Parent ScriptBegin
    set length 1
    set positive 0
    Self set colorfn(RGB) [val colorRGB]
  }
  ClassVar {colorRGB 
    {[_color(SgnRGB) [lindex $_Y 0] [lindex $_Y 1] [lindex $_Y 2]]}
  }
}

proc _color(SgnRGB) {r g b} \
  {return [list [expr ($r>0)?1:0] [expr ($g>0)?1:0] [expr ($b>0)?1:0]]}

Axes Register
