
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc setup_display_menu {mb} {
    global background_color view_buttons axes_use_minmax display_axes is_win
    global tcl_console
    
    set background_color #000000
    set display_axes 1
    
    $mb configure -menu $mb.m
    menu $mb.m
    $mb.m add command -label "Set background" -command set_background
    $mb.m add command -label "Distance" -command check_distance
    $mb.m add command -label "Location" -command check_location
    if [llength [info commands tdv_point_im]] {
	$mb.m add command -label "Track mouse" -command track_location
    }
    $mb.m add checkbutton -label Depthcue -variable display_depthcue \
	    -command depthcue_update
    $mb.m add checkbutton -label "Coord. axis display" -variable display_axes \
	-command "axes_update [info exists axes_use_minmax]"
    $mb.m add command -label "Manage coord. systems" -command coordinate_systems
    if $is_win {
	$mb.m add checkbutton -label "Tcl console" -variable tcl_console \
		-command tcl_console_update
	if ![info exists tcl_console] { set tcl_console 0 }
	tcl_console_update
    }
    if [info exists view_buttons] {
	foreach v $view_buttons {
	    eval $mb.m add $v
	}
    }
}

proc tcl_console_update {} {
    global tcl_console is_win
    
    if !$is_win return
    
    if $tcl_console {
	catch {console show}
    } else {
	focus -force .v ; update
	catch {console hide}
    }
}

proc set_background {} {
    global background_color tdv_default
    
    if {[info commands tdv_changebg] != ""} {
	tdv_changebg current
	return
    }
    
    set background_color [edit_one_color "Please define the color to use\
	    for the background." $background_color 0]
    if {[scan $background_color \#%2x%2x%2x r g b] != 3} {
	mess "Bad background color $background_color\n" red
	return
    }
    if {[info commands set_background_command] != ""} {
	set_background_command $background_color
    } else {
	set glcolor [format %2.2x%2.2x%2.2x $b $g $r]
	command "set_background $glcolor"
    }
}

proc depthcue_update {} {
    global display_depthcue
    
    if {[info commands depthcue_update_command] != ""} {
	depthcue_update_command $display_depthcue
    } else {
	if $display_depthcue {
	    command "depthcue on"
	} else {
	    command "depthcue off"
	}
    }
}

proc length_in_units {val fmt} {
    global unit_default
    
    if {[info command unit_convert] == ""} { return $val }
    set un $unit_default(length)
    return "[format $fmt [unit_convert $val $un 1]] $un"
}

proc coords_in_units {val} {
    global unit_default
    
    if {[info command unit_convert] == ""} { return $val }
    set un $unit_default(length)
    set ret ""
    foreach v $val {
	lappend ret [unit_convert $v $un 1]
    }
    lappend ret ($un)
    return $ret
}

proc check_distance {} {
    global tdv_library tdv_default
    
    set is_tdv [llength [info commands tdv_point_im]]
    
    if [info exists tdv_library] {
	set ocur [set_cursor $tdv_default [list @$tdv_library/pick.cur orange]]
    }
    while 1 {
	set ims ""
	
	banner "Select the first point on the screen with the left button."
	set pt1 [get_graphics_loc]
	banner ""
	if {$pt1 == ""} {
	    if [info exists tdv_library] {
		set_cursor $tdv_default $ocur
	    }
	    return
	}
	mess "$pt1\n" blue
	if $is_tdv {
	    set im [tdv_point_im -color white -size 3 -point $pt1]
	    $tdv_default add_image $im; lappend ims $im
	    set im [tdv_text_im -color white -text " [coords_in_units $pt1]" \
			-point $pt1]
	    $tdv_default add_image $im; lappend ims $im
	}
	banner "Select the second point on the screen with the left button."
	set pt2 [get_graphics_loc]
	banner ""
	if {$pt2 == ""} {
	    if [info exists tdv_library] {
		set_cursor $tdv_default $ocur
	    }
	    foreach im $ims { $im delete }
	    return
	}
	mess "$pt2\n" blue
	
	if $is_tdv {
	    set im [tdv_point_im -color white -size 3 -point $pt2]
	    $tdv_default add_image $im; lappend ims $im
	    set im [tdv_text_im -color white -text " [coords_in_units $pt2]" \
			-point $pt2]
	    $tdv_default add_image $im; lappend ims $im
	    set im [tdv_line_im -color white -point1 $pt1 -point2 $pt2]
	    $tdv_default add_image $im; lappend ims $im
	    update; after 500
	}
	set dist 0
	foreach i {0 1 2} {
	    set p [expr {[lindex $pt2 $i] - [lindex $pt1 $i]}]
	    set d$i [length_in_units $p %e]
	    set dist [expr {$dist + $p * $p}]
	}
	set pdist [length_in_units [expr {sqrt($dist)}] %e]
	mess "Distance is $pdist (dx = $d0, dy = $d1, dz = $d2)\n"
	
	foreach im $ims { $im delete }
    }
    if [info exists tdv_library] {
	set_cursor $tdv_default $ocur
    }
}

proc check_location {} {
    global tdv_library
    global tdv_default
    
    banner "Select the points on the screen with the left button;\
	    middle or right = done."
    if [info exists tdv_library] {
	set ocur [set_cursor $tdv_default [list @$tdv_library/pick.cur orange]]
    }
    set is_tdv [llength [info commands tdv_point_im]]
    
    set ims ""
    while 1 {
	set pt1 [get_graphics_loc]
	if {$pt1 == ""} break
	set pt ""; foreach p $pt1 { lappend pt [format %.6g $p] }
	mess "$pt\n" blue
	
	if $is_tdv {
	    set im [tdv_point_im -color white -size 3 -point $pt]
	    $tdv_default add_image $im; lappend ims $im
	    set im [tdv_text_im -color white -text " [coords_in_units $pt]" \
			-point $pt]
	    $tdv_default add_image $im; lappend ims $im
	    update
	}
    }
    foreach im $ims { $im delete }
    if [info exists tdv_library] {
	set_cursor $tdv_default $ocur
    }
    banner ""
}

proc get_one_location {{mess ""} {only_ep 0}} {
    global tdv_library graphics_loc_button_pressed tdv_default
    global get_only_endpoints
    
    if {$mess == ""} {
	set mess "Select the point on the screen with the left button;\
	    middle = accept, right = cancel."
    }
    banner $mess
    set ocur [set_cursor $tdv_default [list @$tdv_library/pick.cur orange]]
    
    if $only_ep { set get_only_endpoints 1 }
    set got_pt ""
    while 1 {
	set pt [get_graphics_loc]
	if {$pt == ""} {
	    if {$graphics_loc_button_pressed == 3} {
		# Back up or cancel
		if {$got_pt == ""} break
		set got_pt ""
		if [info exists im] { $im delete; unset im }
	    } else {
		break
	    }
	} else {
	    set got_pt ""
	    foreach p $pt { lappend got_pt [format %.4g $p] }
	    if [info exists im] {
		$im configure -point $got_pt
	    } else {
		set im [tdv_point_im -point $got_pt -size 3 -color white]
		$tdv_default add_image $im
	    }
	}
    }
    if $only_ep { unset get_only_endpoints }
    banner ""
    if [info exists im] { $im delete }
    
    set_cursor $tdv_default $ocur
    return $got_pt
}

proc get_one_xy_location {{mess ""}} {
    global tdv_library graphics_loc_button_pressed tdv_default
    global get_only_endpoints graphics_loc_xy
    
    if {$mess == ""} {
	set mess "Select the point on the screen with the left button;\
	    middle = accept, right = cancel."
    }
    banner $mess
    set ocur [set_cursor $tdv_default [list @$tdv_library/pick.cur orange]]
    
    set pt [get_graphics_loc]
    banner ""
    set_cursor $tdv_default $ocur
    if {$pt == ""} {
	return ""
    } else {
	return $graphics_loc_xy
    }
}

proc track_location {} {
    global tdv_library graphics_loc_track_mouse
    global tdv_default
    
    banner "Move the mouse with the left button down."
    if [info exists tdv_library] {
	set ocur [set_cursor $tdv_default [list @$tdv_library/pick.cur orange]]
    }

    set im1 [tdv_point_im -color white -size 3]
    set im2 [tdv_text_im -color white]
    
    set add 0
    set graphics_loc_track_mouse 1
    while 1 {
	set pt [get_graphics_loc]
	if {$pt == ""} break
	$im1 configure -point $pt
	$im2 configure -point $pt -text " $pt"
	if !$add {
	    $tdv_default add_image $im1
	    $tdv_default add_image $im2
	    set add 1
	}
	update idle
    }
    unset graphics_loc_track_mouse
    $im1 delete; $im2 delete
    if [info exists tdv_library] {
	set_cursor $tdv_default $ocur
    }
    banner ""
}

proc get_graphics_loc {} {
    global last_line tdv_waiting_for_motion tdv_waiting_for_click
    global tdv_default
    
    # Just in case we have gotten into this function recursively
    if [info exists tdv_waiting_for_motion($tdv_default)] { return "" }
    if [info exists tdv_waiting_for_click($tdv_default)] { return "" }
    
    if {[info commands graphics_loc_command] != ""} {
	set pt [graphics_loc_command]
	#mess "$pt\n" blue
	return $pt
    } else {
	set cmd graphics_loc
	if { [ info command volume_activename_string ] != "" } {
# this is hexa
		global display_flag
		if $display_flag(edge_vol)     { append cmd " volume" }
		append cmd " [range_string] m [volume_activename_string ] "
	}
		
	command "$cmd"
	return $last_line
    }
}

proc axes_update {{minmax 0} {ask 1}} {
    global display_axes display_axes_pos display_axes_use_pos
    global form_done_flag topform_geo
    
    if {[info commands axes_update_command] != ""} {
	axes_update_command $display_axes
	return
    }
    if $display_axes {
	if { $ask } {
	    set d [form_init .axes "Axes" display accept]
	    if {$d != ""} {
	        set display_axes_use_pos 0
	        foreach i {x y z} { set display_axes_pos($i) 0 }
	    
	        form_frame $d.fr sunken 3 {0 0}; set d $d.fr
	        if $minmax {
		    set display_axes_use_pos 2
		    form_label $d.iminl Ipos {1 1}
		    form_label $d.jminl Jpos {2 1}
		    form_label $d.kminl Kpos {3 1}
		    form_label $d.imaxl Isize {4 1}
		    form_label $d.jmaxl Jsize {5 1}
		    form_label $d.kmaxl Ksize {6 1}
		    form_entry $d.imin display_axes_pos(ipos) float {1 2}
		    form_entry $d.jmin display_axes_pos(jpos) float {2 2}
		    form_entry $d.kmin display_axes_pos(kpos) float {3 2}
		    form_entry $d.imax display_axes_pos(isize) float {4 2}
		    form_entry $d.jmax display_axes_pos(jsize) float {5 2}
		    form_entry $d.kmax display_axes_pos(ksize) float {6 2}
		
		    form_label $d.sell Select {10 1}
		    form_button $d.smin Min "axes_do_select_minmax 0" {10 2}
		    form_button $d.smax Max "axes_do_select_minmax 1" {11 2}
		
		    set pp [info procs axes_minmax_initialize]
		    if {$pp != ""} { $pp }
		
	        } else {
		    form_radiobutton $d.full "Full domain"  \
			display_axes_use_pos 0 {0 0 -cols 3}
		
		    form_radiobutton $d.pos "Position"  \
			display_axes_use_pos 1 {10 0 -cols 3}
		    set act {{display_axes_use_pos 1}}
		    form_label $d.xl X {11 1} $act
		    form_label $d.yl Y {12 1} $act
		    form_label $d.zl Z {13 1} $act
		    form_entry $d.x display_axes_pos(x) float {11 2} $act
		    form_entry $d.y display_axes_pos(y) float {12 2} $act
		    form_entry $d.z display_axes_pos(z) float {13 2} $act
	        }
	        form_colwidth $d 0 2 M
	        form_finish $topform_geo
	    }
	
	    tkwait variable form_done_flag(.axes)
	}
	switch $display_axes_use_pos {
	    0 {
		command "display_axes"
	    }
	    1 {
		command "display_axes $display_axes_pos(x) \
			$display_axes_pos(y) $display_axes_pos(z)"
	    }
	    2 {
		foreach i {i j k} {
		    set ${i}min $display_axes_pos(${i}pos)
		    set ${i}max [expr $display_axes_pos(${i}pos) + \
				     $display_axes_pos(${i}size) + 1]
		}
		command "display_axes $imin $jmin $kmin $imax $jmax $kmax"
	    }
	}
    } else {
	command "erase_axes"
    }
}

proc axes_do_select_minmax {ismax} {
    global display_axes_pos
    
    set pt [axes_select_minmax]
    if {$pt == ""} return
    
    foreach i {0 1 2} {
	set x [lindex {i j k} $i]
	set v [lindex $pt $i]
	set p $display_axes_pos(${x}pos)
	set s $display_axes_pos(${x}size)
	if $ismax {
	    set display_axes_pos(${x}size) [expr $v - $p]
	} else {
	    set display_axes_pos(${x}pos) $v
	    set display_axes_pos(${x}size) [expr $p + $s - $v]
	}
    }
}

proc family_name_compare {ind n1 n2} {
    if {$ind >= 0} {
	set n1 [lindex $n1 $ind]
	set n2 [lindex $n2 $ind]
    }
    foreach k {n1 n2} {
	if [regexp {^([A-za-z_]+)([0-9]+)(.*)$} [set $k] dummy x1 x2 rest] {
	    set x2 [string trimleft $x2 0]; if {$x2 == ""} { set x2 0 }
	    if [catch {set $k [format %s%010d%s $x1 $x2 $rest]}] {
		# this might not be a good number
		set $k [format %s0%s $x1 $rest]
	    }
	} elseif [regexp {^([A-za-z_]+)([0-9]+)/([0-9]+)(.*)$} [set $k] \
		      dummy x1 x2 x3 rest] {
	    set x2 [string trimleft $x2 0]; if {$x2 == ""} { set x2 0 }
	    set x3 [string trimleft $x3 0]; if {$x3 == ""} { set x3 0 }
	    if [catch {set $k [format %s%010d/%010d%s $x1 $x2 $x3 $rest]}] {
		set $k [format %s0%s $x1 $rest]
	    }
	} elseif [regexp {^([A-za-z_]+)/([0-9]+)(.*)$} [set $k] dummy x1 x2 \
		     rest] {
	    set x2 [string trimleft $x2 0]; if {$x2 == ""} { set x2 0 }
	    if [catch {set $k [format %s/%010d%s $x1 $x2 $rest]}] {
		set $k [format %s0%s $x1 $rest]
	    }
	}
    }
    return [string compare $n1 $n2]
}

proc fam_color_compare {f1 f2} {
    return [string compare [lindex $f1 6] [lindex $f2 6]]
}

proc fam_id_compare {f1 f2} {
    set id1 [fam_get_id $f1]; if ![string compare $id1 ?] { set id1 -1 }
    set id2 [fam_get_id $f2]; if ![string compare $id2 ?] { set id2 -1 }
    return [expr $id1 - $id2]
}

proc fam_get_sorted {} {
    global fam_visible fam_sorttype
    
    set allfams [array names fam_visible]
    if {$allfams == "ORFN"} { set allfams "" }
    if ![info exists fam_sorttype] { set fam_sorttype name }
    
    switch $fam_sorttype {
	name {
	    set allfams [lsort -command "family_name_compare -1" $allfams]
	}
	color {
	    set allfams [lsort -command fam_color_compare $allfams]
	}
	id {
	    set allfams [lsort -command fam_id_compare $allfams]
	}
    }
    return $allfams
}

proc fam_get_visible {} {
    global fam_visible
    set ret ""
    foreach f [array names fam_visible] {
	if $fam_visible($f) { lappend ret $f }
    }
    return $ret
}

proc disp_add_marker {} {
    global marker_images marker_new unit_default
    global tdv_default tdv_current_viewer
    
    set d [form_init .marker "Add marker"]
    if {$d != ""} {
	form_label $d.posl Position {0 0}
	form_label $d.textl Text {1 0}
	form_entry $d.pos marker_new(pos) string {0 1}
	$d.pos configure -width 8
	if [info exists unit_default(length)] {
	    form_label_variable $d.posu unit_default(length) {0 2}
	}
	form_entry $d.text marker_new(text) string {1 1 -cols 3}
	form_button $d.selpos "Select" "disp_get_location marker_new(pos) 1 \"the point\" 1" {0 3}
	form_finish +300+300
    }
    if ![form_wait .marker] return
    
    regsub -all , $marker_new(pos) " " marker_new(pos)
    if {[llength $marker_new(pos)] != 3} {
	user_error "Point must be 3 numbers separated by spaces"
	return
    }
    if [info exists unit_default(length)] {
	set val2 ""
	foreach p $marker_new(pos) {
	    lappend val2 [unit_convert $p "default length" 0]
	}
    } else {
	set val2 $marker_new(pos)
    }

    if {![info exist tdv_current_viewer] || ($tdv_current_viewer == $tdv_default)} {
       if {[info command ic_coords_into_global] != ""} {
	  set val2 [ic_coords_into_global $val2]
       }
       set viewer $tdv_default
    } else {
       set viewer $tdv_current_viewer
    }
    
    set im1 [tdv_point_im -point $val2 -size 3 -color white]
    $viewer add_image $im1
    lappend marker_images $im1
    set im2 [tdv_text_im -point $val2 -text " $marker_new(text)"]
    $viewer add_image $im2
    lappend marker_images $im2
}

proc disp_clear_markers {} {
    global marker_images
    
    if [info exists marker_images] {
	foreach im $marker_images { $im delete }
	unset marker_images
    }
}

proc disp_add_ruler {} {
    global ruler_images graphics_loc_xy
    global tdv_default
    
    set pt1 [get_one_location "Select a point on the first object\
		with the left button; middle = accept, right = cancel."]
    if {$pt1 == ""} return
    set xy1 $graphics_loc_xy
    set im [tdv_point_im -color red -size 3 -point $pt1]
    $tdv_default add_image $im
    set pt2 [get_one_location "Select a point on the second object\
		with the left button."]
    $im delete
    if {$pt2 == ""} return
    set xy2 $graphics_loc_xy
    
    set stuff1 [$tdv_default pick [lindex $xy1 0] [lindex $xy1 1] obtype_all "" 10]
    if {$stuff1 == ""} return
    set stuff2 [$tdv_default pick [lindex $xy2 0] [lindex $xy2 1] obtype_all "" 10]
    if {$stuff2 == ""} return
    
    set sh1 [lindex $stuff1 0]
    set sh2 [lindex $stuff2 0]
    puts "sh1 $sh1 sh2 $sh2"
    set b1 ""
    set b2 ""
    set min1 [lindex [$sh1 get_bbox] 0]
    set min2 [lindex [$sh2 get_bbox] 0]
    if {($min1 == "") || ($min2 == "")} {
	user_error "Please pick two model objects."
	return
    }
    foreach i {0 1 2} {
	lappend b1 [expr [lindex $pt1 $i] - [lindex $min1 $i]]
	lappend b2 [expr [lindex $pt2 $i] - [lindex $min2 $i]]
    }
    
    set im [shape_ruler -sh1 $sh1 -sh2 $sh2 -pt1 $b1 -pt2 $b2]
    $tdv_default add_image $im
    lappend ruler_images $im
}

proc disp_clear_rulers {} {
    global ruler_images
    
    if [info exists ruler_images] {
	foreach im $ruler_images { $im delete }
	unset ruler_images
    }
}

proc disp_get_location {{varname ""} {do_exp 1} {what "the point"} {local_sys 0}} {
    global tdv_default explicit_point_was_given
    
    focus $tdv_default 
    tdv_cur $tdv_default pick
    set expmess ""
    if $do_exp {
	tdv_push_key_command e "get_explicit_point 1"
	set expmess "; 'e' = input explicit point"
    }
    catch {unset explicit_point_was_given}
    set ob [banner "Select $what on the screen with the left button;\
	    middle = done$expmess."]
    set pt [get_graphics_loc]
    if {$local_sys && ([info command ic_coords_into_local] != "") &&
	![info exists explicit_point_was_given]} {
	set pt [ic_coords_into_local $pt]
    }
    if {($varname != "") && ($pt != "")} {
	uplevel \#0 set $varname \"$pt\"
    }
    
    if $do_exp {
	tdv_pop_key_command e
    }
    banner $ob
    tdv_cur $tdv_default dynamics
    return $pt
}

proc get_explicit_point {local_sys} {
    global explicit_location_value tdv_waiting_for_click tdv_default
    global explicit_point_was_given
    
    if ![info exists explicit_location_value] {
	set explicit_location_value ""
    }
    set mess "Input the cordinates separated by spaces."
    if {$local_sys && ([info command ic_csystem_get_current] != "")} {
	# This is only relevant for med
	set cc [ic_csystem_get_current]
	if {($cc != "") && ($cc != "global")} {
	    append mess "\nCoords must be in the \"$cc\" system."
	}
    }
    set v [question_box .expl_loc "Explicit location" $mess \
	       $explicit_location_value]
    if {$v == ""} return
    
    # The user will type the explicit point in the LCS.  Don't convert
    # back and forth unnecessarily.
    # if $local_sys { set v [coords_into_global $v] }
    
    set tdv_waiting_for_click($tdv_default) "e $v"
    set explicit_point_was_given 1
}
