
# Move this over to the generic autohexa section ....  But do a diff first ..

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

proc make_polyduct {} {
    global polyduct_data
    
    set wires [db_list_objects pipe]
    if {[llength $wires] < 3} {
	error "You need at least 3 wire objects defined to make a\
		polygonal duct."
    }

    set d [form_init .polyduct "Polygonal ducts" model]
    if {$d != ""} {
	set polyduct_data(end1) 0
	set polyduct_data(end2) 0
	set polyduct_data(name) duct
	set polyduct_data(group) duct
	set polyduct_data(wallfam) IWALL
	
	form_listbox $d.av "Available" "" polyduct_add "" 12x10 {0 0}
	form_listbox $d.us "Used" "" polyduct_remove "" 12x10 {0 1}
	set polyduct_data(avlist) $d.av
	set polyduct_data(uslist) $d.us
	form_checkbutton $d.end1 "Close starting end" polyduct_data(end1) \
	    {1 0 -cols 2}
	form_checkbutton $d.end2 "Close finishing end" polyduct_data(end2) \
	    {2 0 -cols 2}
	
	form_label $d.namel "Name prefix" {3 0}
	form_label $d.groupl "Group name" {4 0}
	form_label $d.faml "Wall family" {5 0}
	form_entry $d.name polyduct_data(name) string {3 1}
	form_entry $d.group polyduct_data(group) string {4 1}
	form_entry $d.fam polyduct_data(wallfam) string {5 1}
	
	form_finish bot
    }
    
    set wnames ""
    foreach w $wires { lappend wnames [$w getval name] }
    
    form_listbox_set $polyduct_data(avlist) $wnames
    form_listbox_set $polyduct_data(uslist) ""
    
    if ![form_wait .polyduct] return
    
    set used [form_listbox_get $polyduct_data(uslist)]
    if {[llength $used] < 3} {
	error "You need at least 3 wire objects selected to make a\
		polygonal duct."
    }
    set wires ""
    foreach u $used { lappend wires [[db_get_name $u] getval body_shape] }
    
    set nw [llength $wires]
    set np 0
    foreach w $wires {
	if !$np {
	    set np [$w getval nverts]
	} elseif {$np != [$w getval nverts]} {
	    error "All wires must be the same length."
	}
    }
    
    for {set i 1} {$i < $np} {incr i} {
	set i2 [expr $i + 1]
	for {set j 0} {$j < $nw} {incr j} {
	    set j2 [expr ($j + 1) % $nw]
	    set pt1 [[lindex $wires $j] getval vert$i]
	    set pt2 [[lindex $wires $j] getval vert$i2]
	    set pt3 [[lindex $wires $j2] getval vert$i2]
	    set pt4 [[lindex $wires $j2] getval vert$i]
	
	    set obj [edit_new polygon [db_new_name $polyduct_data(name)]]
	    edit_modify_object $obj "groups $polyduct_data(group) \
		fam_bot $polyduct_data(wallfam) \
		fam_top $polyduct_data(wallfam) \
		fam_sides $polyduct_data(wallfam)" \
		polygon "nverts 4 height 0 plane -1"
	    edit_modify_shape $obj body \
		[list vert1 $pt1 vert2 $pt2 vert3 $pt3 vert4 $pt4]
	}
    }
    foreach e {1 2} {
	if !$polyduct_data(end$e) continue
	
	set obj [edit_new polygon [db_new_name $polyduct_data(name)]]
	edit_modify_object $obj "groups $polyduct_data(group)" \
	    polygon "nverts $nw height 0 plane -1"
	for {set j 0} {$j < $nw} {incr j} {
	    set pt [[lindex $wires $j] getval vert[expr ($e == 1) ? 1 : $np]]
	    edit_modify_shape $obj body [list vert[expr $j + 1] $pt]
	}
    }
}

proc polyduct_add {name} {
    global polyduct_data
    form_listbox_add $polyduct_data(uslist) $name
}

proc polyduct_remove {name} {
    global polyduct_data
    form_listbox_delete $polyduct_data(uslist) $name
}
