
# Form construction routines for individual object types.
# Each object type can have the following routines:

# app_make_form_TYPE $d
# app_clean_up_TYPE $obj
# app_verify_TYPE $obj -- generates an error if the object is messed up

# Also in this file are other object-specific routines.

# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

# ------------------------------------------------------------------------

proc app_make_form_hood {d} {
    form_checkbutton $d.lfs "Fix shapes" model_data(fix_shapes) {0 0}
    form_button $d.details "Edit details" \
	"edit_modify_params; edit_current_shapedata" {0 1} \
	{{model_data(fix_shapes) 0}}
    
    set fix model_data(fix_shapes)
    
    form_label $d.nfl Neck {10 0}
    form_frame $d.nf flat 0 {10 1 -cols - -rows 2}
    set rr 0
    foreach c {x y z} {
	form_label $d.nf.${c}sl ${c}S "$rr 1 -anchor e"
	form_label $d.nf.${c}el ${c}E "$rr 4 -anchor e"
	model_unitentry $d.nf.${c}s model_data(neck_${c}1) length "$rr 2"
	model_unitentry $d.nf.${c}e model_data(neck_${c}2) length "$rr 5"
	incr rr
    }
    form_label $d.cal Canopy {15 0}
    form_frame $d.ca flat 0 {15 1 -cols - -rows 2}
    set rr 0
    foreach c {x y z} {
	set yv canopy_${c}1; if {$c == "y"} { set yv neck_${c}2 }
	form_label $d.ca.${c}sl ${c}S "$rr 1 -anchor e"
	form_label $d.ca.${c}el ${c}E "$rr 4 -anchor e"
	model_unitentry $d.ca.${c}s model_data($yv) length "$rr 2"
	model_unitentry $d.ca.${c}e model_data(canopy_${c}2) length "$rr 5"
	incr rr
    }
    form_label $d.fltl "Flange type" {20 0}
    form_frame $d.flt flat 0 {20 1 -cols -}
    form_radiobutton $d.flt.v Vertical model_data(flange_type) vertical {0 0}
    form_radiobutton $d.flt.h Horizontal model_data(flange_type) horizontal {0 1}
    form_radiobutton $d.flt.n None model_data(flange_type) none {0 2}
    
    form_label $d.flt.htl Height {1 0}
    model_unitentry $d.flt.ht model_data(flange_height) length {1 1} \
	{{model_data(flange_type) vertical horizontal}}
    
    foreach op {1 2} {
	form_checkbutton $d.opl$op "Opening $op" model_data(open${op}_on) \
	    "[expr 20 + $op * 5] 0"
	form_frame $d.op$op flat 0 "[expr 20 + $op * 5] 1 -cols - -rows 2"
	
	set act model_data(open${op}_on)
	set rr 0
	foreach c {x z} {
	    form_label $d.op$op.${c}sl ${c}S "$rr 1 -anchor e" $act
	    form_label $d.op$op.${c}el ${c}E "$rr 4 -anchor e" $act
	    model_unitentry $d.op$op.${c}s model_data(open${op}_${c}1) \
		length "$rr 2" $act
	    model_unitentry $d.op$op.${c}e model_data(open${op}_${c}1) \
		length "$rr 5" $act
	    incr rr
	}
    }
}

proc app_clean_up_hood {obj} {
    global domain

    if ![$obj getval fix_shapes] return
    
    app_clean_up_hood_section $obj "" "" $domain
    
    foreach s {neck canopy flange1 flange2 flange3 flange4 open1 open2} {
	set sh [$obj getval ${s}_shape]
	if {[info commands $sh] != ""} {
	    app_clean_up_hood_section $obj $sh $s $domain
	}
    }
    edit_reset_params 0
}

proc app_initialize_hood {obj sh shname dom} {
    global domain
    if {$sh != ""} { return 1 }
    
    set dbb [[$domain getval body_shape] get_bbox]
    set x [expr ([lindex [lindex $dbb 0] 0] + [lindex [lindex $dbb 1] 0]) /2.0]
    set y [lindex [lindex $dbb 1] 1]
    set z [expr ([lindex [lindex $dbb 0] 2] + [lindex [lindex $dbb 1] 2]) /2.0]
    
    foreach {a b} {
	neck_ 1 neck_ 2 canopy_ 1 canopy_ 2 open1_ 1 open1_ 2 open2_ 1 open2_ 2
    } {
	foreach c {x y z} {
	    set v ${a}${c}${b}
	    if [$obj checkval $v] {
		$obj setval $v [expr [$obj si_value $v] + [set $c]]
	    }
	}
    }
    return 1
}

proc app_clean_up_hood_section {obj sh shname domain} {
    foreach p {
	up_axis flange_type neck_x1 neck_y1 neck_z1 neck_x2 neck_y2 neck_z2
	canopy_x1 canopy_z1 canopy_x2 canopy_y2 canopy_z2 flange_height
	open1_on open2_on open1_x1 open1_z1 open1_x2 open1_z2 open2_x1
	open2_z1 open2_x2 open2_z2
    } {
	set $p [$obj si_value $p]
    }
    switch -glob $shname {
	"" {
	    $obj setval move_sections_together 1
	    $obj setval section_list {neck canopy flange1 flange2 flange3 \
					  flange4 open1 open2}
	}
	neck {
	    $sh setval -noconstr volume_flag 0 \
		point1 "$neck_x1 $neck_y1 $neck_z1" \
		point2 "$neck_x2 $neck_y2 $neck_z2"
	}
	canopy {
	    $sh setval -noconstr plane $up_axis changes 1 nverts 4 \
		volume_flag 0 height [expr $neck_y2 - $canopy_y2]
	    
	    $sh setval -noconstr tvert1 "$neck_x1 $neck_y2 $neck_z1" \
		vert1 "$canopy_x1 $canopy_y2 $canopy_z1"
	    $sh setval -noconstr tvert2 "$neck_x1 $neck_y2 $neck_z2" \
		vert2 "$canopy_x1 $canopy_y2 $canopy_z2"
	    $sh setval -noconstr tvert3 "$neck_x2 $neck_y2 $neck_z2" \
		vert3 "$canopy_x2 $canopy_y2 $canopy_z2"
	    $sh setval -noconstr tvert4 "$neck_x2 $neck_y2 $neck_z1" \
		vert4 "$canopy_x2 $canopy_y2 $canopy_z1"
	}
	flange* {
	    switch $flange_type {
		none {
		    $sh configure -exp_shape none
		    create_shapes $obj "" "" $shname
		}
		vertical {
		    $sh configure -exp_shape quad
		    create_shapes $obj "" "" $shname
		    set sh [$obj getval ${shname}_shape]
		    if {$sh == ""} { return 1 }
		    
		    $sh configure -visible 1
		    
		    set x1 $canopy_x1; set x2 $canopy_x2
		    set z1 $canopy_z1; set z2 $canopy_z2
		    set y1 $canopy_y2; set y2 [expr $y1 - $flange_height]
		    
		    switch $shname {
			flange1 { set pl 2; set z2 $z1 }
			flange2 { set pl 0; set x1 $x2 }
			flange3 { set pl 2; set z1 $z2 }
			flange4 { set pl 0; set x2 $x1 }
		    }
		    $sh setval -noconstr plane $pl point1 "$x1 $y1 $z1" \
			point2 "$x2 $y2 $z2"
		}
		horizontal {
		    $sh configure -exp_shape quad
		    create_shapes $obj "" "" $shname
		    set sh [$obj getval ${shname}_shape]
		    if {$sh == ""} { return 1 }
		    
		    $sh configure -visible 1
		    
		    switch $shname {
			flange1 {
			    set x1 [expr $canopy_x1 - $flange_height]
			    set z1 [expr $canopy_z1 - $flange_height]
			    set x2 [expr $canopy_x2 + $flange_height]
			    set z2 [expr $canopy_z2]
			}
			flange2 {
			    set x1 [expr $canopy_x2]
			    set z1 [expr $canopy_z1]
			    set x2 [expr $canopy_x2 + $flange_height]
			    set z2 [expr $canopy_z2]
			}
			flange3 {
			    set x1 [expr $canopy_x1 - $flange_height]
			    set z1 [expr $canopy_z2]
			    set x2 [expr $canopy_x2 + $flange_height]
			    set z2 [expr $canopy_z2 + $flange_height]
			}
			flange4 {
			    set x1 [expr $canopy_x1 - $flange_height]
			    set z1 [expr $canopy_z1]
			    set x2 [expr $canopy_x1]
			    set z2 [expr $canopy_z2]
			}
		    }
		    $sh setval -noconstr plane 1 \
			    point1 "$x1 $canopy_y2 $z1" \
			    point2 "$x2 $canopy_y2 $z2"
		    
		}
	    }
	}
	open* {
	    if [set ${shname}_on] {
		$sh configure -exp_shape quad
		create_shapes $obj "" "" $shname
		set sh [$obj getval ${shname}_shape]
		if {$sh == ""} { return 1 }
		
		$sh configure -visible 1
		
		$sh setval -noconstr plane 1 \
		    point1 "[set ${shname}_x1] $canopy_y2 [set ${shname}_z1]" \
		    point2 "[set ${shname}_x2] $canopy_y2 [set ${shname}_z2]"
		
	    } else {
		$sh configure -exp_shape none
		create_shapes $obj "" "" $shname
	    }
	}
    }
    return 1
}

proc app_transform_hood {sh how args} {
    if {[$sh get -name] != "neck"} return
    set obj [$sh get -object]
    switch $how {
	translate {
	    set pos [lindex $args 0]
	    foreach i {0 1 2} {
		set x [lindex {x y z} $i]
		foreach {a b} {
		    neck 1 neck2 canopy 1 canopy 2
		    open1 1 open1 2 open2 1 open2 2
		} {
		    if [$obj checkval $a$x$b] {
			$obj setval $a$x$b [expr [$obj si_value $a$x$b] + \
						[lindex $pos $i]]
		    }
		}
	    }
	}
	default {
	    mess "Warning: not ${how}ing hood object\n"
	}
    }
}

# ------------------------------------------------------------------------

proc app_make_form_person {d} {
    form_checkbutton $d.lfs "Fix shapes" model_data(fix_shapes) {0 0}
    form_button $d.details "Edit details" \
	"edit_modify_params; edit_current_shapedata" {0 1} \
	{{model_data(fix_shapes) 0}}
    
    set fix model_data(fix_shapes)
    
    form_label $d.postl "Posture" {10 0}
    form_frame $d.post flat 0 {10 1 -cols -}
    form_radiobutton $d.post.stand Standing model_data(posture) standing {0 0}
    form_radiobutton $d.post.sit Seated model_data(posture) sitting {0 1}
    
    form_label $d.upl "Up direction" {11 0}
    form_frame $d.up flat 0 {11 1 -cols -}
    form_radiobutton $d.up.x X model_data(up_axis) 0 {0 0}
    form_radiobutton $d.up.y Y model_data(up_axis) 1 {0 1}
    form_radiobutton $d.up.z Z model_data(up_axis) 2 {0 2}
    
    form_label $d.fdl "Facing direction" {12 0}
    form_frame $d.fd flat 0 {12 1 -cols -}
    form_radiobutton $d.fd.x X model_data(facing_dir) 0 {0 0}
    form_radiobutton $d.fd.y Y model_data(facing_dir) 1 {0 1}
    form_radiobutton $d.fd.z Z model_data(facing_dir) 2 {0 2}
    
    form_frame $d.fac flat 0 {13 1 -cols -}
    form_radiobutton $d.fac.f Forward model_data(facing_front) 1 {0 0}
    form_radiobutton $d.fac.b Backward model_data(facing_front) -1 {0 1}
    
    form_label $d.posl "Location" {14 0}
    form_frame $d.pos flat 0 {14 1 -cols -}
    form_label $d.pos.xl "X" {0 0}
    form_label $d.pos.yl "Y" {0 2}
    form_label $d.pos.zl "Z" {0 4}
    form_entry $d.pos.x model_data(bot_x) float {0 1}
    form_entry $d.pos.y model_data(bot_y) float {0 3}
    form_entry $d.pos.z model_data(bot_z) float {0 5}
    
    form_rowheight $d 19 4
    
    form_label $d.heightl "Total height" {20 0}
    form_label $d.widthl "Body width" {21 0}
    form_label $d.depthl "Body depth" {22 0}
    model_unitentry $d.height model_data(height) length {20 1}
    model_unitentry $d.width model_data(width) length {21 1}
    model_unitentry $d.depth model_data(depth) length {22 1}
    
    set sit {{model_data(posture) sitting}}
	 
    form_label $d.headfl "Head fraction" {20 2}
    form_label $d.bodyfl "Body fraction" {21 2}
    #form_label $d.armfl "Arm fraction" {22 2}
    form_label $d.lapfl "Lap fraction" {22 2} $sit
    
    form_entry $d.headf model_data(head_frac) float {20 3}
    form_entry $d.bodyf model_data(body_frac) float {21 3}
    #form_entry $d.armf model_data(arm_frac) float {22 3}
    form_entry $d.lapf model_data(lap_frac) float {22 3} $sit
}

proc app_clean_up_person {obj} {
    global domain

    if ![$obj getval fix_shapes] return
    
    app_clean_up_person_section $obj "" "" $domain
    
    foreach s {head face body larm rarm lleg rleg lthigh rthigh} {
	set sh [$obj getval ${s}_shape]
	if {[info commands $sh] != ""} {
	    app_clean_up_person_section $obj $sh $s $domain
	}
    }
    edit_reset_params 0
}

proc app_initialize_person {obj sh shname dom} {
    global domain
    if {$sh != ""} { return 1 }
    
    set dbb [[$domain getval body_shape] get_bbox]
    $obj setval bot_x [expr ([lindex [lindex $dbb 0] 0] + \
				 [lindex [lindex $dbb 1] 0]) / 2.0]
    $obj setval bot_y [lindex [lindex $dbb 0] 1]
    $obj setval bot_z [expr ([lindex [lindex $dbb 0] 2] + \
				 [lindex [lindex $dbb 1] 2]) / 2.0]
    
    return 1
}

proc app_clean_up_person_section {obj sh shname domain} {
    foreach p {
	posture bot_x bot_y bot_z up_axis facing_dir height width depth
	head_frac body_frac lap_frac facing_front
    } {
	set $p [$obj si_value $p]
    }
    set stand [expr {$posture == "standing"}]
    set side_dir [expr ($up_axis + 1) % 3]
    if {$side_dir == $facing_dir} { set side_dir [expr ($side_dir + 1) % 3] }
    foreach {i x} {0 x 1 y 2 z} { set bot($i) [set bot_$x] }
    
    set bheight $height
    set lheight [expr $height * (1 - $body_frac - $head_frac)]
    
    set legw [expr $depth * .5]
		
    if !$stand {
	# Decrease the height by the lap%
	set bheight [expr $bheight * (1 - $lap_frac)]
	set lheight [expr $lheight - $height * $lap_frac]
	set lapl [expr $lap_frac * $height + $depth - $legw * 1.5]
    }
    
    switch -glob $shname {
	"" {
	    $obj setval move_sections_together 1
	    $obj setval section_list \
		{head face body larm rarm lleg rleg lthigh rthigh}
	}
	head {
	    person_head_location $obj p1 p2 plane dir
	    
	    $sh setval -noconstr volume_flag 0 \
		point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)" 
	}
	face {
	    person_head_location $obj p1 p2 plane dir
	    if {$dir > 0} {
		set p1($plane) $p2($plane)
	    } else {
		set p2($plane) $p1($plane)
	    }
	    set h [expr $p2($up_axis) - $p1($up_axis)]
	    set p1($up_axis) [expr $p1($up_axis) + $h / 4.0]
	    $sh setval -noconstr plane $plane \
		point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)"
	}
	body {
	    set hh [expr $height * $body_frac]
	    set hw [expr $depth * 0.8]
	    
	    set p1($up_axis) [expr $bot($up_axis) + $lheight]
	    set p2($up_axis) [expr $p1($up_axis) + $hh]
	    set p1($side_dir) [expr $bot($side_dir) - $width / 2.0]
	    set p2($side_dir) [expr $bot($side_dir) + $width / 2.0]
	    set p1($facing_dir) [expr $bot($facing_dir) - $depth / 2.0]
	    set p2($facing_dir) [expr $bot($facing_dir) + $depth / 2.0]
	    
	    $sh setval -noconstr volume_flag 0 \
		point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)" 
	}
	larm - rarm {
	    set hh [expr $height * $body_frac]
	    set hw [expr $depth * 0.5]
	    
	    set offs [expr ($width + $hw) / 2.0]
	    if {$shname == "rarm"} { set offs [expr -$offs] }
	    
	    set p2($up_axis) [expr $bot($up_axis) + $lheight + \
				  $height * $body_frac]
	    #set p1($up_axis) [expr $p2($up_axis) - $height * $arm_frac]
	    set p1($up_axis) [expr $bot($up_axis) + $lheight + $legw]
	    set p1($side_dir) [expr $bot($side_dir) - $hw / 2.0 + $offs]
	    set p2($side_dir) [expr $bot($side_dir) + $hw / 2.0 + $offs]
	    set p1($facing_dir) [expr $bot($facing_dir) - $hw / 2.0]
	    set p2($facing_dir) [expr $bot($facing_dir) + $hw / 2.0]
	    
	    $sh setval -noconstr volume_flag 0 \
		point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)" 
	}
	lleg - rleg {
	    if $stand {
		set hh [expr $height * (1 - $head_frac - $body_frac)]
		
		set offs [expr $width / 2.0 - $legw / 2.0]
		if {$shname == "rleg"} { set offs [expr -$offs] }
		
		set p1($up_axis) [expr $bot($up_axis)]
		set p2($up_axis) [expr $p1($up_axis) + $lheight]
		set p1($side_dir) [expr $bot($side_dir) - $legw / 2.0 + $offs]
		set p2($side_dir) [expr $bot($side_dir) + $legw / 2.0 + $offs]
		set p1($facing_dir) [expr $bot($facing_dir) - $legw / 2.0]
		set p2($facing_dir) [expr $bot($facing_dir) + $legw / 2.0]
	    } else {
		set hh [expr $height * (1 - $head_frac - $body_frac - $lap_frac)]

		set offs [expr $width / 2.0 - $legw / 2.0]
		if {$shname == "rleg"} { set offs [expr -$offs] }
		
		set p1($up_axis) [expr $bot($up_axis)]
		set p2($up_axis) [expr $p1($up_axis) + $lheight]
		set p1($side_dir) [expr $bot($side_dir) - $legw / 2.0 + $offs]
		set p2($side_dir) [expr $bot($side_dir) + $legw / 2.0 + $offs]
		set p1($facing_dir) [expr $bot($facing_dir) - $legw / 2.0 + \
					 $lapl * $facing_front]
		set p2($facing_dir) [expr $bot($facing_dir) + $legw / 2.0 + \
					 $lapl * $facing_front]		
	    }
	    $sh setval -noconstr volume_flag 0 \
		point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)" 
	}
	lthigh - rthigh {
	    if $stand {
		$sh configure -exp_shape none
		create_shapes $obj "" "" $shname
	    } else {
		$sh configure -exp_shape hexa
		create_shapes $obj "" "" $shname
		set sh [$obj getval ${shname}_shape]
		if {$sh == ""} { return 1 }
		$sh configure -visible 1
		
		set hh [expr $height * (1 - $head_frac - $body_frac - $lap_frac)]

		set offs [expr $width / 2.0 - $legw / 2.0]
		if {$shname == "rthigh"} { set offs [expr -$offs] }
		
		set p1($up_axis) [expr $bot($up_axis) + $lheight]
		set p2($up_axis) [expr $p1($up_axis) + $legw]
		set p1($side_dir) [expr $bot($side_dir) - $legw / 2.0 + $offs]
		set p2($side_dir) [expr $bot($side_dir) + $legw / 2.0 + $offs]
		set p1($facing_dir) [expr $bot($facing_dir) + \
					 $depth / 2.0 * $facing_front]
		set p2($facing_dir) [expr $bot($facing_dir) + ($legw / 2.0 + \
								   $lapl) * $facing_front]		
		
		$sh setval -noconstr volume_flag 0 \
		    point1 "$p1(0) $p1(1) $p1(2)" point2 "$p2(0) $p2(1) $p2(2)"
		$sh configure -visible 1 
	    }
	}
    }
    return 1
}

proc person_head_location {obj p1x p2x planex dirx} {
    foreach v {p1 p2 plane dir} { upvar 1 [set ${v}x] $v }
    
    foreach p {
	posture bot_x bot_y bot_z up_axis facing_dir height depth head_frac
	lap_frac facing_front body_frac
    } {
	set $p [$obj si_value $p]
    }
    set stand [expr {$posture == "standing"}]
    set side_dir [expr ($up_axis + 1) % 3]
    if {$side_dir == $facing_dir} { set side_dir [expr ($side_dir + 1) % 3] }
    foreach {i x} {0 x 1 y 2 z} { set bot($i) [set bot_$x] }
    
    set bheight $height
    set lheight [expr $height * (1 - $body_frac - $head_frac)]
    if !$stand {
	# Decrease the height by the lap%
	set bheight [expr $bheight * (1 - $lap_frac)]
	set lheight [expr $lheight - $height * $lap_frac]
    }
    
    set hh [expr $height * $head_frac]
    set hw [expr $depth * 0.8]
    
    set p1($up_axis) [expr $bot($up_axis) + $bheight - $hh]
    set p2($up_axis) [expr $p1($up_axis) + $hh]
    set p1($side_dir) [expr $bot($side_dir) - $hw / 2.0]
    set p2($side_dir) [expr $bot($side_dir) + $hw / 2.0]
    set p1($facing_dir) [expr $bot($facing_dir) - $hw / 2.0]
    set p2($facing_dir) [expr $bot($facing_dir) + $hw / 2.0]
    set plane $facing_dir
    set dir $facing_front
}

proc app_transform_person {sh how args} {
    if {[$sh get -name] != "head"} return
    set obj [$sh get -object]
    switch $how {
	translate {
	    set pos [lindex $args 0]
	    foreach i {0 1 2} {
		set x [lindex {x y z} $i]
		$obj setval bot_$x [expr [$obj si_value bot_$x] + \
					[lindex $pos $i]]
	    }
	}
	default {
	    mess "Warning: not ${how}ing person object\n"
	}
    }
}

proc app_decorate_person {sh section obj stuff} {
    global dont_reconfigure_decoration tdv_default
    
    if {$section != "face"} { return "" }
    
    set updir [$sh transform_axis [$obj getval up_axis]]
    set plane [$sh transform_axis [$sh getval plane]]
    set sdir [expr ($updir + 1) % 3]
    if {$sdir == $plane} { set sdir [expr ($sdir + 1) % 3] }
    set fac [$obj getval facing_front]
    
    set bbox [$sh get_bbox]
    set min [lindex $bbox 0]; set max [lindex $bbox 1]
    foreach i {0 1 2} {
	set p1($i) [lindex $min $i]
	set p2($i) [lindex $max $i]
	set fc($i) [expr ($p1($i) + $p2($i)) / 2.0]
	set df($i) [expr $p2($i) - $p1($i)]
    }
    set p1($plane) [expr $p1($plane) + $df($updir) * 0.01 * $fac]
    set p2($plane) [expr $p2($plane) + $df($updir) * 0.01 * $fac]
    
    if {$stuff == ""} {
	lappend stuff [tdv_quad_geo] [tdv_poly_line_im] [tdv_cyl_geo] \
	    [tdv_cyl_geo] [tdv_poly_im] [tdv_poly_im]
	foreach im $stuff {
	    $tdv_default add_image $im
	    set dont_reconfigure_decoration($im) 1
	}
    }
    
    # -------
    # face
    
    [lindex $stuff 0] configure -point1 "$p1(0) $p1(1) $p1(2)" \
	-point2 "$p1(0) $p1(1) $p1(2)" -plane $plane \
	-shade solid -color bisque
    
    set p1($plane) [expr $p1($plane) + $df($updir) * 0.01 * $fac]
    set p2($plane) [expr $p2($plane) + $df($updir) * 0.01 * $fac]
    set fc($plane) [expr $fc($plane) + $df($updir) * 0.01 * $fac]
    
    # -------
    # mouth
    
    foreach i {0 1 2} { set mc($i) $fc($i) }
    [lindex $stuff 1] clear_points
    set mp($plane) $p1($plane)
    
    for {set a -45} {$a <= 45} {incr a 5} {
	set a2 [expr $a * 3.14159 / 180.0]
	switch -- [$obj getval happy] {
	    1 {
		set mp($updir) [expr $mc($updir) - $df($updir) * 0.35*cos($a2)]
		set mp($sdir) [expr $mc($sdir) - $df($updir) * 0.35 * sin($a2)]
	    }
	    0 {
		set mp($updir) [expr $mc($updir) - $df($updir) * 0.30]
		set mp($sdir) [expr $mc($sdir) - $df($updir) * 0.35 * sin($a2)]
	    }
	    -1 {
		set mp($updir) [expr $mc($updir) - $df($updir) * (0.65 - 0.35*cos($a2))]
		set mp($sdir) [expr $mc($sdir) - $df($updir) * 0.35 * sin($a2)]
	    }
	}
	[lindex $stuff 1] add_point "$mp(0) $mp(1) $mp(2)"
    }
    [lindex $stuff 1] configure -color red -width 2 -draw_dots 0
    
    # -------
    # eyes
    
    set ep($plane) $p1($plane)
    set ep($updir) [expr $p1($updir) + ($p2($updir) - $p1($updir)) * .75]
    
    set ep($sdir) [expr $p1($sdir) * .66 + $p2($sdir) * .34]
    [lindex $stuff 2] configure -center "$ep(0) $ep(1) $ep(2)" -plane $plane \
	-radius [expr $df($updir) * .05] -shade solid -color blue

    set ep($sdir) [expr $p1($sdir) * .34 + $p2($sdir) * .66]
    [lindex $stuff 3] configure -center "$ep(0) $ep(1) $ep(2)" -plane $plane \
	-radius [expr $df($updir) * .05] -shade solid -color blue
    
    # -------
    # nose
    
    [lindex $stuff 4] clear_points
    [lindex $stuff 5] clear_points
    [lindex $stuff 4] set_point 0 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    [lindex $stuff 5] set_point 0 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    set fc($plane) [expr $fc($plane) + $df($updir) * $fac * 0.1]
    set fc($updir) [expr $fc($updir) - $df($updir) * 0.2]
    [lindex $stuff 4] set_point 1 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    [lindex $stuff 5] set_point 1 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    set fc($plane) $p1($plane)
    set fc($sdir) [expr $fc($sdir) - $df($updir) * 0.05]
    [lindex $stuff 4] set_point 2 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    set fc($sdir) [expr $fc($sdir) + $df($updir) * 0.1]
    [lindex $stuff 5] set_point 2 "$fc(0) $fc(1) $fc(2)" "0 0 0" "0 0 0"
    [lindex $stuff 4] configure -shade solid -color bisque
    [lindex $stuff 5] configure -shade solid -color bisque
    
    # -------
    
    return $stuff
}
