
# Local coordinate stuff.

proc model_local_coords {} {
    global local_coords
    
    set systems ""
    foreach n [lsort [array names local_coords]] {
	lappend systems [concat [list $n] [lrange $local_coords($n) 0 4]]
    }
    set defl [unit_get_default_choice length]
    
    set cols [list \
		  [list name Name entry "call_function model_local_coords_new_name" string] \
		  [list type Type choice Trans {Trans}] \
		  [list xoff "X offset" unitentry [list 0.0 $defl] length] \
		  [list yoff "Y offset" unitentry [list 0.0 $defl] length] \
		  [list zoff "Z offset" unitentry [list 0.0 $defl] length]]
    
    set res [flexlist .local_coords "Local coord systems" $cols $systems]
    if {$res == "*cancel*"} return
    
    catch {unset local_coords}
    foreach d $res {
	set local_coords([lindex $d 0]) [lrange $d 1 end]
    }
    
    model_local_coords_update_objects ""
}

proc model_local_coords_update_objects {one_cs} {
    global local_coords current_object
    
    set nu 0
    foreach obj [db_list_objects_recursive] {
	if {[$obj getval obtype] == "material"} continue
	incr nu [model_local_coords_update_one_object $obj]
    }
    if $nu {
	mess "Updated offset values for $nu\
 		shape[expr {($nu == 1) ? "" : "s"}]\n"
    }
}

proc model_local_coords_update_one_object {obj} {
    global local_coords current_object app_has_transform
    
    set nu 0
    set cs [$obj getval coord_system ""]
    puts "cs2 $cs"
    if {$cs != ""} {
	if [info exists local_coords($cs)] {
	    app_clean_up_[$obj getval obtype] $obj
	    incr nu [llength [db_shapes $obj]]
	}
	set trans ""
	foreach i {1 2 3} {
	    lappend trans [expr - [eval unit_convert [lindex $local_coords($cs) $i] 0]]
	}
    } else {
	foreach sh [db_shapes $obj] {
	    set cs [$sh getval coord_system]
	    puts "was $cs"
	    if {$cs == ""} continue
	    if [info exists local_coords($cs)] {
		# We don't just set the offset to be the new one
		# since that would move the object.  Subtract the current
		# one first...
		set val ""
		set trans ""
		foreach i {1 2 3} v {x y z} {
		    set cc [lindex $local_coords($cs) $i]
		    set nv [unit_convert [lindex $cc 0] [lindex $cc 1] 0]
		    lappend val $nv
		    lappend trans [expr [$sh si_value ${v}off] - $nv]
		    $sh setunits ${v}off [lindex $cc 1]
		    $sh setval coord_system $cs
		}
		$sh setval offset $val
		$sh translate $trans
		incr nu
	    } else {
		if {$cs != "global"} {
		    mess "Warning: [$obj getval obtype] \"[$obj getval name]\"\
			used coordinate system \"$cs\" which no longer\
		    	exists.  Setting it to global coordinates.\n" red
		}
		$sh setval coord_system ""
		$sh translate [$sh getval offset]
		$sh setval offset "0 0 0"
		set trans "0 0 0"
	    }
	    puts "trans $trans"
	}
    }
    set obtype [$obj getval obtype]
    if [info exists app_has_transform($obtype)] {
	puts "app_transform_$obtype [db_shapes $obj 0] translate $trans"
	app_transform_$obtype [db_shapes $obj 0] translate $trans
	app_clean_up_$obtype $obj
    }
    if {$obj == $current_object} edit_reset_params
    return $nu
}

proc model_local_coords_set_shape {sh cs} {
    global local_coords
    
    $sh setval coord_system $cs
    if {($cs != "") && [info exists local_coords($cs)]} {
	set val ""
	set trans ""
	foreach i {1 2 3} v {x y z} {
	    set cc [lindex $local_coords($cs) $i]
	    set nv [unit_convert [lindex $cc 0] [lindex $cc 1] 0]
	    lappend val $nv
	    $sh setunits ${v}off [lindex $cc 1]
	}
	$sh setval offset $val
    }
}

proc model_local_coords_list {} {
    global local_coords
    
    set ret [list "Create new" "View definition" "Edit definition" "" global]
    foreach n [lsort [array names local_coords]] {
	if [lindex $local_coords($n) 4] { lappend ret $n }
    }
    return $ret
}

proc model_local_coords_new_name {already_there} {
    global local_coords
    
    foreach a $already_there { set used($a) 1 }
    for {set i 0} {[info exists local_coords(local$i)] || [info exists used(local$i)]} {incr i} { }
    return local$i
}

proc model_local_coords_set {var ent} {
    global local_coords $var form_entry_datatype futil_menu_prev_value
    global ${var}_units current_object
    
    set cs [set ${var}(coord_system)]
    puts "cs is $cs"
    switch $cs {
	"" { return }
	global {
	    if {$var == "shape_data"} {
		edit_modify_params
		model_local_coords_update_one_object $current_object
	    }
	    
	    foreach x {x y z} {
		set ${var}(${x}off) 0.0
	    }
	    set ${var}(coord_system) ""
	    
	    return
	}
	"View definition" {
	    set ${var}(coord_system) $futil_menu_prev_value
	    model_local_coords_view $futil_menu_prev_value
	    return
	}
	"Edit definition" {
	    set cs [model_local_coords_edit_one $futil_menu_prev_value]
	    if {$cs == ""} return
	    set ${var}(coord_system) $cs
	    
	    # Hack
	    lappend form_entry_datatype($ent.e) $cs
	}
	"Create new" {
	    set cs [model_local_coords_edit_one ""]
	    if {$cs == ""} return
	    set ${var}(coord_system) $cs
	    
	    # Hack
	    lappend form_entry_datatype($ent.e) $cs
	}
    }
    switch $var {
	shape_data - model_data {
	    edit_modify_params
	    model_local_coords_update_one_object $current_object
	}
    }
    if ![info exists local_coords($cs)] {
	user_error "No such coord sys $cs exists"
	return
    }
    foreach x {x y z} i {1 2 3} {
	set cc [lindex $local_coords($cs) $i]
	set ${var}(${x}off) [lindex $cc 0]
	set ${var}_units(${x}off) [lindex $cc 1]
    }
}

proc model_local_coords_edit_one {which} {
    global local_coords_edit local_coords local_coords_edit_units
    global futil_menu_prev_value
    
    if {$which == ""} {
	array set local_coords_edit {
	    type Trans
	    xoff 0.0
	    yoff 0.0
	    zoff 0.0
	}
	set defl [unit_get_default_choice length]
	foreach i {x y z} {
	    set local_coords_edit_units(${i}off) $defl
	}
	for {set i 0} {[info exists local_coords(local$i)]} {incr i} { }
	set local_coords_edit(name) local$i
	
    } else {
	set vals $local_coords($which)
	set local_coords_edit(name) $which
	set local_coords_edit(type) [lindex $vals 0]
	set local_coords_edit(xoff) [lindex [lindex $vals 1] 0]
	set local_coords_edit(yoff) [lindex [lindex $vals 2] 0]
	set local_coords_edit(zoff) [lindex [lindex $vals 3] 0]
	set local_coords_edit_units(xoff) [lindex [lindex $vals 1] 1]
	set local_coords_edit_units(yoff) [lindex [lindex $vals 2] 1]
	set local_coords_edit_units(zoff) [lindex [lindex $vals 3] 1]
    }
    
    set d [form_init .local_coords_edit "Local coords" "" "" "" 1 1 1]
    if {$d != ""} {
	form_label $d.namel Name {0 0}
	form_label $d.typel Type {1 0}
	form_label $d.xoffl "X offset" {2 0}
	form_label $d.yoffl "Y offset" {3 0}
	form_label $d.zoffl "Z offset" {4 0}
	
	form_entry $d.name local_coords_edit(name) string {0 1}
	form_optionmenu $d.type local_coords_edit(type) Trans {1 1}
	model_unitentry $d.xoff local_coords_edit(xoff) length {2 1}
	model_unitentry $d.yoff local_coords_edit(yoff) length {3 1}
	model_unitentry $d.zoff local_coords_edit(zoff) length {4 1}
	
	form_finish bot
    }
    if ![form_wait .local_coords_edit] { return $futil_menu_prev_value }
    
    set local_coords($local_coords_edit(name)) \
	[list $local_coords_edit(type) \
	     [list $local_coords_edit(xoff) $local_coords_edit_units(xoff)] \
	     [list $local_coords_edit(yoff) $local_coords_edit_units(yoff)] \
	     [list $local_coords_edit(zoff) $local_coords_edit_units(zoff)] 1]
    
    return $local_coords_edit(name)
}

proc model_local_coords_view {name} {
    global local_coords
    if ![info exists local_coords($name)] {
	mess "No such coordinate system \"$name\"\n"
    } else {
	set cs $local_coords($name)
	mess "Coord system \"$name\": [lindex $cs 0] X = [lindex $cs 1], Y = [lindex $cs 2], Z = [lindex $cs 3]\n"
    }
}

proc model_local_coords_from_shape {sh} {
    global local_coords
    
    set obj [$sh get -object]
    set obname "[$obj getval obtype] \"[$obj getval name]\""
    
    # See if we already have one.
    foreach x {x y z} {
	set sh$x [lindex [$sh get_value_with_units ${x}off] 0]
	set shu$x [lindex [$sh get_value_with_units ${x}off] 1]
    }
    foreach name [array names local_coords] {
	set cc $local_coords($name)
	foreach i {1 2 3} x {x y z} {
	    set lc$x [lindex [lindex $cc $i] 0]
	    set lcu$x [lindex [lindex $cc $i] 1]
	}
	if {($lcx == $shx) && ($lcy == $shy) && ($lcz == $shz) && 
	    ($lcux == $shux) && ($lcuy == $shuy) && ($lcuz == $shuz)} {
	    $sh setval coord_system $name
	    mess "Assigned $obname to local coordinate system $name\n"
	    return
	}
    }
    set name [model_local_coords_new_name ""]
    $sh setval coord_system $name
    set local_coords($name) [list Trans [list $shx $shux] [list $shy $shuy] \
				 [list $shz $shuz] 1]
    mess "Created new local coordinate system $name for $obname\n"
}
