csObject Subclass basicPolyhedron {
  Var F C hasLines lastApp
  ClassVar {colorNormal {[Self FaceNormal $_face]}}

  Method Compute {} {uplevel Self Recolor}

  Method MakeV {vertices} {
    upvar V V; upvar names names
    set V {}
    set d [expr [Self getDimension] - 1]

    set vertices [uplevel 2 [list subst $vertices]]
    set vlen [llength $vertices]
    for {set i 0; set k 0} {$k < $vlen} {incr k} {
      set item [lindex $vertices $k]
      if {[string index $item [expr [string length $item] - 1]] == ":"} {
	set id [string range $item 0 [expr [string length $item] - 2]]
	set names($id) $i
	incr k; set item [lindex $vertices $k]
      }
      while {$k < $vlen && ![_expr(Complete) $item]} \
        {lappend item [lindex $vertices [incr k]]}
      set P [_expr(List) $item 2]
      while {[llength $P] <= $d} {lappend P 0}
      lappend V [lrange $P 0 $d]; incr i
    }
  }

  Method MakeF {faces data getData} {
    upvar F F; set F {}
    uplevel [list Self MakeFlist \
       [uplevel 2 [list subst $faces]] $data $getData]
  }

  Method MakeFlist {faces data getData} {
    upvar F F; upvar V V; upvar names names
    set makeface [Self method MakeFace]

    set flen [llength $faces]
    set vlen [llength $V]

    for {set k 0} {$k < $flen} {incr k} {
      if {[lindex $faces [expr $k + 1]] == "<-"} {
        set list [lindex $faces $k]
        if {[llength [lindex $list 0]] == 1} {set list [list $list]}
        uplevel [list Self MakeFlist $list \
           [Self GetData $data [lindex $faces [expr $k+2]] $getData] $getData]
        incr k 2
      } else {
        set face {}
        set flist [lindex $faces $k]; set len [llength $flist]
        for {set j 0} {$j < $len} {incr j} {
          set id [lindex $flist $j]
          while {$j < $len && ![_expr(Complete) $id]} \
            {lappend $id [lindex $flist [incr j]]}
	  if [info exists names($id)] {
            lappend face [lindex $V $names($id)]
          } else {
            set v [_expr(List) $id 2]
	    if {[llength $v] != 1} {lappend face $v} else {
	      if {$v < 0 || $v >= $vlen} \
		{Error "Vertex index '$id' out of bounds"}
	      lappend face [lindex $V $v]
	    }
          }
        }
        lappend F [eval [list $makeface $face] $data]
      }
    }
  }

  Method GetData {data actions getData} {
    while {$actions != ""} {set actions [$getData $actions]}
    return $data
  }

  Method VFdata {actions} {
    upvar data data; set i 0
    switch [lindex $actions 0] {
      solid {set data [lreplace $data 0 0 s]}
      outline {set data [lreplace $data 0 0 o]}
      normalize {set data [lreplace $data 2 2 {}]}
      noadjust  {set data [lreplace $data 2 2 n]}
      color {
        set c [lindex $actions [incr i]]
        if {$c == ""} {Error "Missing color index after 'color'"}
        set c [_expr(List) $c 4]
        if {[llength $c] != 1 && [llength $c] != 3} \
          {Error "Color '$c' should have 1 or 3 components"}
        set data [lreplace $data 1 1 $c]
      }
      vcolors {
        set C {}
        set colors [lindex $actions [incr i]]
        if {$colors == ""} {Error "Missing color values after 'vcolors'"}
        foreach c [_expr(List) $colors 4] {
          if {[llength $c] == 1} {lappend C " $c"} \
          elseif {[llength $c] == 3} {lappend C $c} \
          else {Error "Color '$c' should have 1 or 3 components"}
        }
        set data [lreplace $data 1 1 $C]
      }
      default {Error "Unknown attribute '[lindex $actions 0]'"}
    }
    return [lrange $actions [incr i] end]
  }

  Method VF2Faces {vertices faces {data {s "" n}}} {
    Self MakeV $vertices
    Self MakeF $faces $data [Self method VFdata]
    return $F
  }

  Method Star {i faces} {
    if {$i == "*"} {return $faces}
    foreach j $i {set include($j) 1}
    set list {}
    set faces [uplevel [list subst $faces]]
    foreach face $faces {
      foreach j $face {
	if {[info exists include($j)]} {
	  lappend list $face
	  break
	}
      }
    }
    return $list
  }

  Method MakeFace {face {type s} {color {}} {normalize {}} {data {}}} {
    if {$data == ""} {
      if {$color == ""} {return [list $face $type]}
      if {$normalize != ""} {set color [list n $color]}
      return [list $face $type $color]
    }
    return [list $face $type $color $data]
  }

  Method FaceCenter {face} {
    set P [Self Inherit zero]
    foreach v $face {set P [+ $P $v]}
    return [/ $P double([llength $face])]
  }

  Method FaceNormal {face} {
    if {[llength [lindex $face 0]] != 3} {return [Self Inherit zero]}
    switch [llength $face] {
      1 {return {0 0 1}}
      2 {let V [>< [- [lindex $face 1] [lindex $face 0]] {1 0 0}]}
      default {
        let V [>< [- [lindex $face 1] [lindex $face 0]] \
                  [- [lindex $face 2] [lindex $face 0]]]
      }
    }
    if {[=== $V {0 0 0}]} {return {0 0 1}} else {return [Unit $V]}
  }

  Method Recolor {} {
    Vars F C; upvar _X _X; upvar _face face; upvar _data f
    Self Color Init
    set FaceCenter [Self method FaceCenter]
    set shading [Self Appearance get shading]
    set X [array names _X]
    set d [Self getDimension]
    set C {}
    foreach f $F {
      set color [lindex $f 2]
      if {$color == ""} {
	set face [lindex $f 0]
	if {$shading == "smooth" || $shading == "csmooth"} {
	  set clist {}
	  foreach v $face {
	    foreach i $X {set _X($i) [lindex $v $i]}
	    set c [$ColorFN]
	    if {[llength $c] == 1} {lappend clist " $c"} else {lappend clist $c}
	  }
	  lappend C $clist
	} else {
	  set center [$FaceCenter $face]
	  foreach i $X {set _X($i) [lindex $center $i]}
	  lappend C [$ColorFN]
	}
      } else {
        if {[lindex $color 0] == "n"} {lappend C $color} \
          else {lappend C [$ComputeMaxMin $color]}
      }
    }
    set C [Self Color Normalize $C]
  }

  Method HandleColor {} {
    if {![val written]} return
    if {[val hasLines]} {Self Color set uncolored 0}
    Parent HandleColor
  }

  Method HandleAppearance {} {
    Vars written lastApp
    if {!$written} return
    set newApp [Self Appearance get shading]
    if {$newApp != $lastApp} {
      set lastApp $newApp
      Self HandleColor
    }
    Parent HandleAppearance
  }

  Method WriteOOGL {file} {
    Vars F C hasLines
    set isColored [Self Color isColored]
    set isSolid   [Self Color isSolid]
    set d [Self getDimension]
    if {$d == 3} {set OFF "OFF"; set SKEL "SKEL"} \
      else {set OFF "nOFF\n$d"; set SKEL "nSKEL\n$d"}

    set n 0
    foreach f $F {
      set i [llength [lindex $f 0]]
      if {$i > $n} {set n $i}
    }
    set N {{}}; for {set i 0} {$i < $n} {incr i} {lappend N $i}

    set hasLines 0
    puts $file "\{ LIST"
    set k 0
    foreach f $F {
      set face [lindex $f 0]; set n [llength $face]
      set type [lindex $f 1]; set color {}
      if {([lindex $f 2] != "" || !$isSolid || ($isColored && $n < 3) || \
          $type == "o")} {set color [lindex $C $k]}
      if {[llength [lindex $color 0]] > 1} {set c "C"} else {set c ""}
      if {$type == "s" || $n <= 2} {set m 1} else {set m $n}
      if {$n > 2 && $type == "s"} {
        puts $file "\{ $c$OFF $n $m 0"
        if {$c != "C"} {puts $file [join $face \n]} else {
          set i 0
          foreach v $face {puts $file "$v  [lindex $color $i]"; incr i}
          set color {}
        }
	puts $file [string trim "$n  [lrange $N 1 $n]  $color"]
        puts $file "\}"
      } else {
        set hasLines 1
        puts $file "\{ $SKEL $n $m"
	puts $file [join $face \n]
        if {$n <= 2} {
          if {$c != ""} {set color [lindex $color 0]}
	  puts $file [string trim "$n  [lrange $N 1 $n]  $color"]
        } else {
          if {$c == ""} {
            for {set i 0; set j 1} {$j < $n} {incr i; incr j} \
              {puts $file [string trim "2  $i $j  $color"]}
            puts $file [string trim "2  $i 0  $color"]
          } else {
            while {[llength $color] < $n} {lappend color $color}
            for {set i 0; set j 1} {$j < $n} {incr i; incr j} \
              {puts $file [string trim "2  $i $j  [lindex $color $i]"]}
            puts $file [string trim "2  $i 0  [lindex $color $i]"]
          }
        }
        puts $file "\}"
      }
      incr k
    }
    puts $file "\}"
  }

  Method ScriptBegin {} {
    Vars colorfn
    Parent ScriptBegin
    set colorfn(Normal) [val colorNormal]
  }

  Method Create {name {data ""}} {
    set name [Parent Create $name $data]
    if {$data == ""} {
      $name set colorfn(Normal) [val colorNormal]
      $name Color set by "_color(Fn) Normal"
    }
    return $name
  }
}