#
# Library functions for the scripting library (scrib)
#
# File: scrib/lib/extrude.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2003 ICEM CFD Engineering
#
#--------------------------------------------------------------------
#
# --> if the name of the first proc already exists in interp, return
#
if {"" != [info commands scrib_lib_extrude_offset]} { return }
#
# --> procs in this file depend on the following scrib/lib/ files--source them
#     I guess we could do this by proc, too, not sure waht's best
#
if {"" != [info commands scrib_lib_setup_source_files]} {
    set required_files "catia geo"
    scrib_lib_setup_source_files $required_files
}

## unused as yet

proc scrib_lib_extrude_offset_jka {offset_type thickness {family ""} {dir ""}} {
    
    switch $offset {
	1 { 
	    mess "thickness is $thickness\n"
	    scrib_lib_extrude_offset_surfaces_dir $family $dir [expr $thickness / 2]
	}
	2 {
	    if [llength [ic_geo_get_objects curve ""]] {
		set extrude [scrib_lib_extrude_do_find_curve]
		mess "thickness is $thickness\n"
		if ![ic_uns_check_family $family] {		    
		    mess "scrib_lib_extrude_offset was not able to find offset for model"
		    return 1
		}
	    } else {
		mess "no curves in layers $proc_scrib_data(offset_layers)\n"
		return 1
	    }   
	}
	default {
	    mess "offset $offset not supported\n" red
	    return 1
	}
    }
    return 0
}

## offset the family <em>famname</em> in the direction <em>dir</em>
## with a distance of <em>l</em> units.

proc scrib_lib_extrude_offset_surfaces_dir {famname dir l} {
    
    set pi  [scrib_lib_math_get_val pi]
    set rad [scrib_lib_math_get_val rad]
    
    switch -- $dir {
	"+x" - "+X" - "x+" - "X+" { set v "1 0 0" }
	"-x" - "-X" -" x-" - "X-" { set v "-1 0 0" }
	"+y" - "+Y" - "y+" - "Y+" { set v "0 1 0" }
	"-y" - "-Y" - "y-" - "Y-" { set v "0 -1 0" }
	"+z" - "+Z" - "z+" - "Z+" { set v "0 0 1" }
	"-z" - "-Z" - "z-" - "Z-" { set v "0 0 -1" }
	"NO" - "no"               { set v "0 0 0" }
	default {
	    mess  "direction $dir is not supported\n"  red
	    return 0
	}
    }
    
  set subset [ic_uns_subset_create]
  catch {ic_uns_subset_make_families $subset $famname} res
  if {"" != $res} { mess "$res" red }
    
  set elements [ic_uns_subset_list_elements $subset]
  if ![llength $elements] {
      mess "There are no mesh elements in selected family $famname\n" red
      return 1
  }
  set vertexes [ic_uns_get_element_vertex_positions $subset 1]  
  set OK 0
  foreach el $elements {
    set type [lindex $el 0]
    set verts [lindex $el 2]
    if {($type != "QUAD_4") && ($type != "TRI_3")} {
      set n_verts [llength $verts]
      set vertexes [lreplace $vertexes 0 [expr $n_verts-1]]
      continue
    }
    if {$type == "QUAD_4"} {
      for {set i 0} {$i < 4} {incr i} {
        set ep($i) [lindex $vertexes $i]
      }
      set corners [list "$ep(0)" "$ep(1)" "$ep(2)" "$ep(3)"]
      set vertexes [lreplace $vertexes 0 3]
    } else {
      for {set i 0} {$i < 3} {incr i} {
        set ep($i) [lindex $vertexes $i]
      }
      set corners [list "$ep(0)" "$ep(1)" "$ep(2)"]
      set vertexes [lreplace $vertexes 0 2]
    }
	
    set x [scrib_lib_math_vector_from_points $ep(0) $ep(1)]
    set z [scrib_lib_math_vector_vmult $x [scrib_lib_math_vector_from_points $ep(0) $ep(2)]]
    set a [expr [scrib_lib_math_angle_between_vectors $v $z]/$rad]
    if {[expr abs($a-90)] > 1} {
      set OK 1
      break
    }
  }
  if !$OK {
      mess "All selected elements are normal or almost normal to the selected direction $dir\n" red
      return 1
  }
  ic_uns_subset_delete $subset
    
  set subset [ic_uns_subset_create]
  ic_uns_subset_add_pick_single element $subset [eval scrib_lib_math_center_point $corners] $z all
  if {$a > 90} {ic_uns_reorient $subset flip}
  ic_uns_reorient all consistent $subset
  ic_uns_subset_delete $subset
  
#YK: extrusion, copied from scrib_lib_extrude_offset_surfaces

  set subset [ic_uns_subset_create]
  catch {ic_uns_subset_make_families $subset $famname} res
  if {"" != $res} { mess "$res\n" red }
  ic_uns_uniqify $subset

  if {[lsearch -exact [ic_uns_list_families] JUNK] == -1} {ic_uns_new_family JUNK}
  ic_uns_change_family $subset JUNK
  ic_extrude families JUNK numlayers 1 dir normal space $l volf JUNK \
  sidef JUNK topf $famname del_orig 1
    
  mess "Extrusion done \n" blue
  set subset_junk [ic_uns_subset_create]
  catch {ic_uns_subset_make_families $subset_junk JUNK} res
  if {"" != $res} { mess "$res\n" red }
  ic_delete_elements subset $subset_junk
  display_update unstruct
  return 0
}

## needs doc

proc scrib_lib_extrude_offset {offset {fam MESH} thickness {dir ""} } {    
    global proc_scrib_data
    
    if {0 == $offset} { return }   
    switch $offset {
	1 { 
	    	mess "thickness is $proc_scrib_data(thickness), direction is $proc_scrib_data(offset_dir)\n"
		set half_thickness [expr $thickness / 2]
		scrib_lib_extrude_offset_surfaces_dir $fam $dir $half_thickness
	}
	2 {	
     		ic_unload_tetin
    		set thisextrude_tetin $proc_scrib_data(name)\_extrude.tin
    		set stat 0
    		switch $proc_scrib_data(cadsys) {
			catia {
	   		 set stat [scrib_lib_catia_import $proc_scrib_data(cadfile) \
		    		$thisextrude_tetin $proc_scrib_data(offset_layers) 1]
			}
			default {
	    		mess "does not support cad system $cadsys"
	    		set stat 1
			}
    		}
    		if $stat { return }
	        ic_load_tetin [list "$thisextrude_tetin"]
	    	if [llength [ic_geo_get_objects curve ""]] {
			set extrude [scrib_lib_extrude_do_find_curve $fam]
			mess "proc_scrib_data(thickness) is $proc_scrib_data(thickness)\n"
		} else {
			mess "no curves in layers $proc_scrib_data(offset_layers)\n"
	    	}   
	}
	default {
	    mess "offset $offset not supported\n"
	}
    }
}

## needs doc

proc scrib_lib_extrude_do_find_curve {{fam MESH}} {
    global proc_scrib_data
    
    #global rad
    set rad [scrib_lib_math_get_val rad]
    
    set min_length 5.0
    set tol 1e-3
    
    set curves [ic_geo_get_objects curve ""]
    foreach curve $curves {
	set pnts [ic_geo_crv_data $curve cps]
	set ends($curve) [list [lindex $pnts 0] [lindex $pnts end]]
	if {[ic_geo_crv_length $curve] < $min_length} {
	    lappend short_curves $curve
	}  
    }
    
    if ![info exists short_curves] return
    
    set pairs ""
    foreach s_curve $short_curves {
	set p(1) [lindex $ends($s_curve) 0]
	set p(2) [lindex $ends($s_curve) 1]
	set OK 0
	set OK_1 0
	foreach curve $curves {
	    if {[lsearch $short_curves $curve] != -1} continue
	    set pp1 [lindex $ends($curve) 0]
	    set pp2 [lindex $ends($curve) 1]
	    if {([scrib_lib_math_distance $p(1) $pp1] <= $tol) || ([scrib_lib_math_distance $p(1) $pp2] <= $tol)} {
		incr OK
		set near_c($OK) $curve
		set near_p($OK) 1
	    } elseif {([scrib_lib_math_distance $p(2) $pp1] <= $tol) || ([scrib_lib_math_distance $p(2) $pp2] <= $tol)} {
		incr OK
		set near_c($OK) $curve
		set near_p($OK) 2
	    }
	}
	if {$OK == 1} { 
	    set corner $p($near_p(1))
	    set end $p([expr 3-$near_p(1)])
	    lappend pairs [list $s_curve $near_c(1) $corner $end] 
	}
	if {$OK != 2} continue
	
	set v [scrib_lib_math_vector_from_points $p(1) $p(2)]
	set OK_1 0
	foreach i {1 2} {
	    set curve $near_c($i)
	    set param_a [expr 2.0/[ic_geo_crv_length $curve]]
	    set param_b [expr 1-$param_a]
	    set pnt [ic_geo_cre_pnt_on_crv_at_par $fam $fam/0 0 $curve]
	    set p_loc [ic_geo_get_point_location $pnt]
	    if {[scrib_lib_math_distance $p_loc $p($near_p($i))] <= $tol} {
		set p_near [ic_geo_cre_pnt_on_crv_at_par $fam $fam/0 $param_a $curve]
	    } else {
		set p_near [ic_geo_cre_pnt_on_crv_at_par $fam $fam/0 $param_b $curve]
	    }
	    set p_near_loc [ic_geo_get_point_location $p_near]
	    set v1($i) [scrib_lib_math_vector_from_points $p($near_p($i)) $p_near_loc]
	    set angle [expr [scrib_lib_math_angle_between_vectors $v $v1($i)]/$rad]
	    if {($angle > 105) || ($angle < 75)} break
	    incr OK_1
	}
	if {$OK_1 != 2} continue
	if { [expr [scrib_lib_math_angle_between_vectors $v1(1) $v1(2)]/$rad] > 30 } continue
	
	ic_delete_geometry point families $fam
	
	mess "Side curve recognized as $s_curve \n" blue
	set proc_scrib_data(thickness) [ic_geo_crv_length $s_curve]
	if [scrib_lib_extrude_main $p(1) $p(2) 0 $fam] {     
	    set OK 0
	} else {
	    break
	}
    }
    
    if !$OK {
	mess "Side curve not found \n" red
	return
    }
}

## needs doc

proc scrib_lib_extrude_main {p1 p2 {l 0} {fam MESH}} {
    global proc_scrib_data
    
    #global rad
    set rad [scrib_lib_math_get_val rad]
    
    set tol 0.5
    #
    # put elements near position "p1" in "subset"
    #
    set subset [ic_uns_subset_create]
    set e_num [ic_uns_subset_add_near_pos $subset $p1]
    if !$e_num {
	mess "No elements near selected curve \r " red
	ic_uns_subset_delete $subset
	return 1
    }
    #
    #
    #
    set elements [ic_uns_subset_list_elements $subset]
    set vertexes [ic_uns_get_element_vertex_positions $subset 1]
    foreach el $elements {
	set type [lindex $el 0]
	set verts [lindex $el 2]
	if {($type != "QUAD_4") && ($type != "TRI_3")} {
	    set n_verts [llength $verts]
	    set vertexes [lreplace $vertexes 0 [expr $n_verts-1]]
	    continue
	}
	#if {$type == "Quad_4"} commented by JKA for
	if {$type == "QUAD_4"} {
	    for {set i 0} {$i < 4} {incr i} {
		set ep($i) [lindex $vertexes $i]
	    }
	    set OK 0
	    foreach {ep1 ep2} {0 1  0 2  0 3  1 2  1 3  2 3} { 
		if [scrib_lib_math_is_point_on_segment $ep($ep1) $ep($ep2) $p1 $tol] {
		    set OK 1
		    break
		}
	    }
	    if !$OK {
		foreach {ep1 ep2} {0 1  0 2  0 3  1 2  1 3  2 3} { 
		    if [scrib_lib_math_is_point_on_segment $ep($ep1) $ep($ep2) $p2 $tol] {
			set OK 2
			break
		    }
		}
	    }
	    if $OK {
		set corners [list "$ep(0)" "$ep(1)" "$ep(2)" "$ep(3)"]
		break
	    } else {
		set vertexes [lreplace $vertexes 0 3]
	    }
	} else {
	    for {set i 0} {$i < 3} {incr i} {
		set ep($i) [lindex $vertexes $i]
	    }
	    set OK 0
	    foreach {ep1 ep2} {0 1  0 2  1 2} { 
		if [scrib_lib_math_is_point_on_segment $ep($ep1) $ep($ep2) $p1 $tol] {
		    set OK 1
		    break
		}
	    }
	    if !$OK {
		foreach {ep1 ep2} {0 1  0 2 1 2} { 
		    if [scrib_lib_math_is_point_on_segment $ep($ep1) $ep($ep2) $p2 $tol] {
			set OK 2
			break
		    }
		}
	    }
	    if $OK {
		set corners [list "$ep(0)" "$ep(1)" "$ep(2)"]
		break
	    } else {
		set vertexes [lreplace $vertexes 0 2]
	    }
	}
    }
    if ![info exists OK] { set OK 0 }
    if !$OK {
	mess "Can't find appropriate mesh element \n" red
	ic_uns_subset_delete $subset
	return 2
    }
    
    if {$OK == 1} {
	set v [scrib_lib_math_vector_from_points $p1 $p2]
    } else {
	set v [scrib_lib_math_vector_from_points $p2 $p1]
    }
    set x [scrib_lib_math_vector_nrm [scrib_lib_math_vector_from_points $ep(0) $ep(1)]]
    set z [scrib_lib_math_vector_vmult $x [scrib_lib_math_vector_from_points $ep(0) $ep(2)]]
    set a [expr [scrib_lib_math_angle_between_vectors $v $z]/$rad]
    ic_uns_subset_delete $subset
    
    #set subset [ic_uns_create_selection_subset 0]
    set subset [ic_uns_subset_create]
    ic_uns_subset_add_pick_single element $subset [eval scrib_lib_math_center_point $corners] $z all
    if {$a > 90} {ic_uns_reorient $subset flip}
    ic_uns_reorient all consistent $subset
    ic_uns_subset_delete $subset
    
    #set subset [ic_uns_create_selection_subset 0]
    set subset [ic_uns_subset_create]
    catch {ic_uns_subset_make_families $subset $fam} res
    if {"" != $res} { mess "$res\n" red }
    ic_uns_uniqify $subset
    if {$l <= 0 } {
	set l [expr [scrib_lib_math_distance $p1 $p2]/2.0]
    }
    #
    # note that the topf is hard-code to FAM_$proc_scrib_data(name) xxxxxxxxxxxxxxxx
    #JASON---THE ABOVE COMMENT IS NOT TRUE ANYMORE
    if {[lsearch -exact [ic_uns_list_families] JUNK] == -1} {ic_uns_new_family JUNK}
    ic_uns_change_family $subset JUNK
    ic_extrude families JUNK numlayers 1 dir normal space $l volf JUNK \
	    sidef JUNK topf $fam del_orig 1
    #ic_uns_subset_delete $subset
    
    mess "Extrusion done \n" blue
    #ic_delete_elements subset $subset
    #ic_uns_delete_family JUNK
    set subset_junk [ic_uns_subset_create]
    catch {ic_uns_subset_make_families $subset_junk JUNK} res
    if {"" != $res} { mess "$res\n" red }
    ic_delete_elements subset $subset_junk
    #I think this needs to be commented now----Ben
    #foreach dfam [ic_uns_list_families] {
	#if {($dfam != "FAM_$proc_scrib_data(name)") && ($dfam != "ORFN")} {
	#    ic_uns_delete_family $dfam
	#}
    #}
    
    display_update unstruct
    return 0
}

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

## needs doc

proc scrib_lib_extrude_offset_surfaces {famname build_topo_tol offset \
	imeshname igeomname \
	omeshname ogeomname} {    
    global proc_scrib_data
    
    
    ic_load_unstruct $imeshname
    if {0 >= [ic_count_nodes]} {
	mess "Error mesh $imeshname has no nodes...stopping.\n" red
	return
    }
    if {"" == [ic_uns_lookup_family_pid $famname]} {
	set famname2 ""
	mess "Warning: could not find family: $famname in mesh $imeshname\n"
    } else {
	set famname2 $famname
    }
    #$proc_scrib_data(name)_offset.uns
    ic_save_unstruct $omeshname 0 {} {TRI_3 QUAD_4} $famname2 {} 0
    
    ic_unload_mesh
    ic_unload_tetin
    ic_load_tetin [list "$igeomname"]
    #
    #
    set surfs [ic_geo_get_objects surface]
    foreach surf $surfs {
	ic_facetize_geometry surface $surf
    }
    ic_delete_geometry surface names $surfs
    ic_geo_fixup 1
    
    ic_build_topo $build_topo_tol
    ic_geo_delete_unattached
    ic_geo_export_to_mesh 1
    ic_unload_tetin
    ic_uns_new_family MESH
    foreach fam [ic_uns_list_families] {
	if {($fam == "ORFN") || ($fam == "MESH") } { continue }
	ic_uns_rename_family $fam MESH
    }
    #
    # THIS SHOULDN"T BE NECESSARY
    #
    ic_save_unstruct temp.uns
    ic_unload_mesh
    ic_load_unstruct temp.uns
    ic_rm temp.uns
    scrib_lib_extrude_offset $offset
    ic_unload_tetin
    #
    #
    ic_geo_import_mesh {} 1 1
    #
    #
    ic_save_tetin $ogeomname
    ic_unload_mesh
    ic_unload_tetin    
    #
    # 
    #
    ic_load_tetin [list "$ogeomname"]
    ic_load_unstruct $omeshname
    ic_uns_set_node_dimension all reset
    #
    #this should not have to be here, but a bug in ic_uns_set_nodes seems to hose things.  
    #This problem is also found in proc quad_clean.xxxxxxxxxxxxxxxxxxxxxx
    #
    ic_save_unstruct $omeshname
    ic_unload_mesh
    ic_load_unstruct $omeshname
}




