
# This code creates the user interface for tetra.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc make_display_window {} {
    global display_flag index_min index_max tool_dir
    global guibase_dir background_color
    
    toplevel .e
    wm maxsize .e 2000 2000
    wm title .e "Display functions"
    wm group .e .v
    wm withdraw .e
    
    frame .e.cutter
    make_cutter_window .e.cutter
    pack .e.cutter -side top -fill both -expand 1
}

proc make_cutter_window {w} {
    global display_flag background_color
    
    frame $w.buts -relief ridge -borderwidth 2
    
# points
    checkbutton $w.buts.point -text Points -variable display_flag(point) \
	-command "update_display point" -anchor w

# curves
    checkbutton $w.buts.curve -text Curves -variable display_flag(curve) \
	-command "update_display curve" -anchor w
    menubutton $w.buts.curveopt -text "Opts" \
	    -menu $w.buts.curveopt.m -relief raised -borderwidth 2 \
	    -state disabled

# surfaces
    checkbutton $w.buts.surf -text Surfaces -variable display_flag(surf) \
	-command "update_display surf" -anchor w
    menubutton $w.buts.surfopt  -text "Opts" \
	    -menu $w.buts.surfopt.m -relief raised -borderwidth 2

# material points
    checkbutton $w.buts.mat -text Materials -variable display_flag(mat) \
	-command "update_display mat" -anchor w

# density polyhedra
    checkbutton $w.buts.dens -text Density -variable display_flag(density) \
	-command "update_display density" -anchor w


# line break
    frame $w.buts.line2 -borderwidth 1 -background black -relief raised

# faces
    checkbutton $w.buts.face -text Faces -variable display_flag(face) \
	-command "update_display face" -anchor w
    menubutton $w.buts.faceopt -text "Opts" \
	    -menu $w.buts.faceopt.m -relief raised -borderwidth 2
# edges
    checkbutton $w.buts.edge -text Edges -variable display_flag(edge) \
	-command "update_display edge" -anchor w
    menubutton $w.buts.edgeopt -text "Opts" \
	    -menu $w.buts.edgeopt.m -relief raised -borderwidth 2
# vertices
    checkbutton $w.buts.vert -text Vertices -variable display_flag(vert) \
	-command "update_display vert" -anchor w
    menubutton $w.buts.vertopt -text "Opts" \
	    -menu $w.buts.vertopt.m -relief raised -borderwidth 2



    set ln 5
    blt_table $w.buts $w.buts.point     $ln,1 -columnspan 2 -anchor w
    incr ln
    blt_table $w.buts $w.buts.curve     $ln,1 -columnspan 2 -anchor w
    blt_table $w.buts $w.buts.curveopt  $ln,3 -columnspan 1 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.surf      $ln,1 -columnspan 2 -anchor w
    blt_table $w.buts $w.buts.surfopt   $ln,3 -columnspan 1 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.mat       $ln,1 -columnspan 2 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.dens      $ln,1 -columnspan 2 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.line2     $ln,1 -columnspan 3 \
					    -anchor w -pady 5 -fill x
    incr ln

    blt_table $w.buts $w.buts.vert     $ln,1 -columnspan 2 -anchor w
    blt_table $w.buts $w.buts.vertopt $ln,3 -columnspan 1 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.edge     $ln,1 -columnspan 2 -anchor w
    blt_table $w.buts $w.buts.edgeopt  $ln,3 -columnspan 1 -fill x -anchor w
    incr ln
    blt_table $w.buts $w.buts.face     $ln,1 -columnspan 2 -anchor w
    blt_table $w.buts $w.buts.faceopt  $ln,3 -columnspan 1 -fill x -anchor w

    menu $w.buts.curveopt.m
    menu $w.buts.surfopt.m
    menu $w.buts.faceopt.m
    menu $w.buts.edgeopt.m
    menu $w.buts.vertopt.m
    

    set display_flag(surf_lod) 1

    foreach vv {
	{ "Full"            surf lod 0 }
	{ "Simple"          surf lod 1 }
	{ "Simpler"         surf lod 2 }
	{ "Simpler 2"	    surf lod 3 }
	{ "Params"          surf params }
	{ "Wire Frame"      surf type wire }
	{ "Solid"           surf type solid }
	{ "Triangles"       surf type triangles }
	{ "Names"           surf names }

	{ "Boundary"        face bound }
	{ "Solid"           face solid }
	{ "Added later"     face added }
	{ "Internal"        face internal }

	{ "Single"          edge single }
	{ "Double"          edge double }
	{ "Multiple"        edge multiple }
	{ "Bars"            edge bars }

	{ "spikes"          vert spikes }
    } {
	set m $w.buts.[lindex $vv 1]opt.m
	set v [lindex $vv 1]_[lindex $vv 2]
	set val [lindex $vv 3]
	
	if {$val == ""} {
	    $m add checkbutton -label [lindex $vv 0] \
		-variable display_flag($v) -command "update_display $v"
	} else {
	    $m add radiobutton -label [lindex $vv 0] -value $val \
		-variable display_flag($v) -command "update_display $v"
	    if ![string compare [lindex $vv 4] "1"] {
		set display_flag($v) $val
	    }
	}
    }

    set r 20
    
    blt_table_row $w.buts configure 0 -height 2
    blt_table_column $w.buts configure 0 -width 5
    blt_table_column $w.buts configure 4 -width 5
    blt_table_column $w.buts configure 1 -width 20
    
# this is in the view menu
#    checkbutton $w.buts.depth -text Depthcue -variable display_depthcue \
#	    -command depthcue_update
#    checkbutton $w.buts.axes -text Axes -variable display_axes \
#	    -command axes_update
#    button $w.buts.back -text "Background color" -command set_background
    
#    blt_table $w.buts $w.buts.depth 31,1 -columnspan 3 -anchor w -pady 0
#    blt_table $w.buts $w.buts.axes 32,1 -columnspan 3 -anchor w -pady 0
#    blt_table $w.buts $w.buts.back 33,1 -columnspan 3 -anchor w -pady 0
    
    # ----------------
    
    frame $w.fam -relief ridge -borderwidth 2
    
    label $w.fam.cl -text "CAD families"
    frame $w.fam.c
    
    label $w.fam.ml -text "Mesh families"
    frame $w.fam.m
    
    pack $w.fam.cl $w.fam.c $w.fam.ml $w.fam.m -side top -fill both -expand 1
    
    # ----------------
    
    pack $w.buts $w.fam -side top -fill both -padx 2 -pady 2
    set background_color #000000
}

proc disable_stuff {dis} {
    if $dis {
	.e.cutter.fam.m.blank configure -state normal
	.e.cutter.fam.c.blank configure -state normal
    } else {
	.e.cutter.fam.m.blank configure -state disabled
	.e.cutter.fam.c.blank configure -state disabled
    }
    return
    
    foreach q {curve surf face edge surfopt faceopt edgeopt} {
	set w .e.cutter.buts.$q
	if $dis {
	    $w configure -state disabled
	} else {
	    $w configure -state normal
	}
    }
    foreach w [winfo children .e.cutter.fam.c.c.win.ch] {
	if $dis {
	    $w configure -state disabled
	} else {
	    $w configure -state normal
	}
    }
}

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

proc add_families {} {
    global families family_dims cad_family_active mesh_family_active
    
    get_families
    
    set cfams ""; set mfams ""
    foreach f $families {
	if [info exists cad_family_active($f)] {
	    lappend cfams [list $f -text $f -pady -2 \
		    -command "update_display curve surf point mat"]
	}
	if [info exists mesh_family_active($f)] {
	    lappend mfams [list $f -text $f -pady -2 \
		    -command "update_display face edge"]
	}
    }

    
    set w .e.cutter.fam
    check_box $w.c $cfams 4 cad_family_active 1 \
	"set cad_family_active(0) 0; update_display surf curve"
    check_box $w.m $mfams 4 mesh_family_active 1 \
	"set mesh_family_active(0) 0; update_display face edge"
    
    if 0 {
	if ![winfo exists $w.c.blank] {
	    button $w.c.blank -text "Screen blank" -command "screen_blank cad" \
		-state disabled
	    pack $w.c.blank -before $w.c.buts -side bottom -fill both
	    button $w.m.blank -text "Screen blank" -command "screen_blank mesh" \
		-state disabled
	    pack $w.m.blank -before $w.m.buts -side bottom -fill both
	}
    }
    
    readjust_edit_geometry
}


proc update_display {args} {
    global display_flag process_ident current_phase
    global default_misc_colors num_default_misc_colors
    
    if {$args == ""} {
	update_display curve surf face edge
	return
    }
    
    if {$process_ident == "leo"} {
	if {($current_phase != "tri_edit") && 
	    ($current_phase != "quad_edit")} {
	    set vols [mesh_family_string]
	    set shade wire
	    if {!$display_flag(face) || ($vols == "")} {
		set vols ""
	    }
	    if $display_flag(face_solid) {
		set shade flat
	    }
	    set nc ""
	    foreach v $vols {
		set cn [expr {$v % $num_default_misc_colors}]
		set c $default_misc_colors($cn)
		lappend nc "$v $c"
	    }
	    command "show_families \{$nc\} $shade" 0
	}
	set cads [cad_families]
	set opts ""
	append opt " level_of_detail $display_flag(surf_lod)"
	if { $display_flag(surf_type) == "solid" } { 
		append opts " solid" 
	}
		    
	if $display_flag(curve) {
	    command "cad_show \{$cads\} curve $opts" 0
	} else {
	    command "cad_show \{\} curve" 0
	}
	if $display_flag(surf) {
	    command "cad_show \{$cads\} surface $opts" 0
	} else {
	    command "cad_show \{\} surface" 0
	}
	command "show_bars $display_flag(edge)" 0
	return
    }
    
    foreach what $args {
	switch $what {
	    vert {
		if { $display_flag(vert) } {
			if { $display_flag(vert_spikes) } {
				command "display_spikes"
				command "display_nodes erase"
			} elseif { $display_flag(face) } {
				command "display_spikes erase"
				command "display_nodes surface_nodes"
			} elseif { $display_flag(edge) } {
				command "display_spikes erase"
				command "display_nodes curve_nodes"
			} else {
				command "display_spikes erase"
				command "display_nodes erase"
			}
		} else {
			command "display_nodes erase"
			command "display_spikes erase"
		}
	    }
	    density {
		if { !$display_flag(density) } {
			command "display_density_poly erase"
		} else {
			command "display_density_poly"
		}
	    }
	    mat {
		if { !$display_flag(mat) } {
			command "display_materials erase"
		} else {
			command "display_materials"
		}
	    }
	    curve {
		set fams [cad_families]
		if {!$display_flag(curve) || ($fams == "")} {
		    command "display_curves erase" 0
		} else {
		    command "display_curves $fams" 0
		}
	    }
	    surf -
	    surf_lod -
	    surf_type -
	    surf_names -
	    surf_params {
		set fam [cad_families]
		if {!$display_flag(surf) || ($fam == "")} {
		    command "erase_surfaces" 0
		} else {
		    set cmd display_surfaces
		    append cmd " level_of_detail $display_flag(surf_lod)"
		    if $display_flag(surf_params) { append cmd " params" }
		    switch $display_flag(surf_type) {
			    solid {
				append cmd " solid"
			    }
			    triangles {
				append cmd " triangles"
			    }
			    default { }
		    }
		    if $display_flag(surf_names) { append cmd " names" }
		    append cmd " $fam"
		    command $cmd 0
		}
	    }
	    face -
	    face_solid -
	    face_bound -
	    face_root -
	    face_internal -
	    face_added {
		set vols [mesh_family_name_string]
		if {!$display_flag(face) || ($vols == "")} {
		    command "erase_faces" 0
		} else {
		    set opts ""
		    if $display_flag(face_root) {
			lappend opts root
		    }
		    if $display_flag(face_solid) {
			lappend opts solid
		    }
		    if $display_flag(face_bound) {
			lappend opts boundary
		    }
		    if $display_flag(face_internal) {
			lappend opts internal
		    }
		    if $display_flag(face_added) {
			lappend opts added_later
		    }
		    command "display_faces $opts name $vols" 0
		}
	    }
	    edge -
	    edge_single -
	    edge_double -
	    edge_multiple -
	    edge_bars {
		if !$display_flag(edge) {
		    command "erase_edges" 0
		} else {
		    set opts ""
		    if $display_flag(edge_single)   { lappend opts 1 }
		    if $display_flag(edge_double)   { lappend opts 2 }
		    if $display_flag(edge_multiple) { lappend opts m }
		    if $display_flag(edge_bars)     { lappend opts bars }
		    append opts " [mesh_family_name_string]"
		    command "display_edges $opts" 0
		}
	    }
	    point {
		if !$display_flag(point) {
		    command "display_points erase" 0
		} else {
		    command "display_points [cad_family_string]" 0
		}
	    }
	}
    }
}

proc cad_family_name_string {} {
    global cad_family_active families 
    
    set fams ""
    foreach f $families {
	if {[info exists cad_family_active($f)] && $cad_family_active($f)} {
	    lappend fams $f/*
	}
    }
    return $fams
}

proc cad_families {} {
    global cad_family_active families 
    
    set fams ""
    foreach f $families {
	if {[info exists cad_family_active($f)] && $cad_family_active($f)} {
	    lappend fams $f
	}
    }
    return $fams
}

proc mesh_family_name_string {} {
    global mesh_family_active families 
    
    set fams ""
    foreach f $families {
	if {[info exists mesh_family_active($f)] && $mesh_family_active($f) } {
	    lappend fams $f
	}
    }
    return $fams
}

proc cad_family_string {} {
    global cad_family_active families
    
    set fams ""
    foreach f $families {
	if {[info exists cad_family_active($f)] && $cad_family_active($f)} {
	    lappend fams $f
	}
    }
    return $fams
}

proc mesh_family_string {} {
    global mesh_family_active families
    
    set fams ""
    foreach f $families {
	if {[info exists mesh_family_active($f)] && $mesh_family_active($f)} {
	    lappend fams $f
	}
    }
    return $fams
}

proc get_families {} {
    global all_lines families family_dims cad_family_active last_line
    global mesh_family_active process_ident config_dir
    global family_number cut_domain_in_import tetin_file
    global boco_nfamilies boco_family_number boco_family_name
    global has_tetin family_count
    global tetin_merge_name
    
    set boco $config_dir(mesh)/boco
    if {$tetin_file != ""} {
	if ![catch {exec grep boco_file $config_dir(mesh)/$tetin_file} lines] {
	    foreach line [split $lines \n] {
		if {[lindex $line 0] == "boco_file"} {
		    set boco [lindex $line 1]
		    if {[file dirname $boco] == "."} {
			set boco $config_dir(mesh)/$boco
		    }
		}
	    }
	}
    }
    if {$has_tetin && [file exists $boco]} {
	boco_load $boco
    }
    
    catch {unset family_dims}
    catch {unset cad_family_active}
    catch {unset mesh_family_active}
    catch {unset family_count}
    set families "ORFN"
    set family_dims(ORFN) 3
    set cad_family_active(ORFN) 0
    set mesh_family_active(ORFN) 0
    
    switch $process_ident {
	cutter {
	    command "list" 0
	    foreach line $all_lines {
		if {$line == ""} continue
		set f [lindex $line 0]
		set d 3
		lappend families $f
		set family_dims($f) $d
		set cad_family_active($f) 1
		set mesh_family_active($f) 1
	    }
	}
	leo {
	    command "list_family_numbers_with_counts" 0
	    set nn [llength $last_line]
	    for {set q 0} {$q < $nn} {incr q} {
		set i [lindex $last_line $q]
		set nfound($i) 1
		set family_count($i) [lindex $last_line [incr q]]
	    }
	    
	    if {!$has_tetin || ([array names boco_family_name] == "")} {
		foreach i [lsort -integer [array names nfound]] {
		    if [info exists tetin_merge_name($i)] {
		        set i $tetin_merge_name($i)
		    }
		    if { $i != "ORFN" && $i != 0 }  { lappend families $i }
		    set family_dims($i) 3
		    set cad_family_active($i) 1
		    set mesh_family_active($i) 1
		}
	    } else {
		set nosurf ""
		foreach i [array names boco_family_name] {
		    set i [ string trim $fname ]
		    set fname $boco_family_name($i)
		    
		    if $i { lappend families $i }
		    set family_dims($i) 3
		    set cad_family_active($i) 1
		    if [info exists nfound($i)] {
			set mesh_family_active($i) 1
		    } else {
			set mesh_family_active($i) 0
			lappend nosurf $fname
		    }
		}
		foreach i [array names nfound] {
			lappend families $i
			set family_dims($i) 3
			set cad_family_active($i) 0
			set mesh_family_active($i) 1
		}
		if {$nosurf != ""} {
		    mess "Note: no surface mesh elements\
				in families: $nosurf\n"
		}
	    }
	    if !$has_tetin {
		unset cad_family_active
		set mesh_family_active(0) 1
	    }
	}
    }
    set families [lsort -command "family_name_compare -1" $families]
    mess "sorted families: $families"
}

proc add_one_family {name} {
    global families family_dims mesh_family_active boco_nfamilies
    
    if [info exists boco_nfamilies] {
	set i [boco_add_family $name]
    }
    
    lappend families $name
    set family_dims($name) 3
    set mesh_family_active($name) 1
    
    set mfams ""
    foreach f $families {
	if [info exists mesh_family_active($f)] {
	    lappend mfams [list $f -text $f -pady -2 \
		    -command "update_display face edge"]
	}
    }
    set w .e.cutter.fam
    check_box $w.m $mfams 4 mesh_family_active 1 "update_display face edge"
    
    return $i
}

proc screen_blank {which} {
    global process_ident last_line ${which}_family_active
    
    if {$process_ident != "leo"} {
	mess "Screen blank not available in this mode.\n" red
	return
    }
    banner "Please select the $which families to blank."
    command "select_family $which"
    banner ""
    
    set nb 0
    foreach ll $last_line {
	set ${which}_family_active($ll) 0
	incr nb
    }
    if $nb { update_display }
}
