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

proc tmpname {} {return .restart.tmp}

proc get_units {} {
    global units
    case "$units" in {
	English {return e}
	Metric {return m}
	default {warningmsg "Bad units: $units"; return ""}
    }
}

proc get_draft {} {
    global draft
    case "$draft" in {
	"ANSI-82" {return a82}
	DIN {return d}
	default {warningmsg "Bad drafting std: $draft"; return ""}
    }
}

proc get_partform {} {
    global partform
    
    switch $partform {
	ASCII   { return a }
	Binary  { return b }
	default { warningmsg "Bad part format: $partform"; return "" }
    }
}

proc check_dirtree {} {
    global icem_fluent icem_powermesh
    
    if {![file exists mulcad] || ![file exists parts]} {
	if {[query_question .query \
	     "No project or parts directory in [pwd]-- continue?"] \
		 == "*cancel*"} {return 0}
    }
    if ![file exists mulcad] {
	infomsg "Creating project directory (mulcad)"
	cmd_mkdir mulcad
    }
    if ![file exists parts] {
	infomsg "Creating parts directory"
	cmd_mkdir parts
    }
    if ![file exists iges] {
	infomsg "Creating iges directory"
	cmd_mkdir iges
    }
    if {!$icem_fluent && !$icem_powermesh} {
	if ![file exists objects] {
	    infomsg "Creating objects directory"
	    cmd_mkdir objects
	}
    }
    return 1
}

# To get the possible configurations, look in the mulcad directory
# in the current dir, and then extract the names of the directories
# found there.

proc possible_configurations {} {
    set here [pwd]
    if {![file exists mulcad]} then \
	{error "Can't find mulcad directory"}
    cd mulcad
    set files [glob -nocomplain *]
    set configs {}
    foreach file $files {
	if {[file isdirectory $file]} then \
	    {append configs " " $file}
    }
    cd $here
    return [lsort $configs]
}

proc possible_geometries {} {
    global confname
    set here [pwd]
    if {![file exists mulcad]} then \
	{error "Can't find mulcad directory"}
    cd mulcad
    if {![file exists $confname]} then \
	{error "Can't find config directory"}
    cd $confname
    set files [glob -nocomplain *]
    set geos {}
    foreach file $files {
	if {[file isdirectory $file] && ($file != "topology") && \
		($file != "hexa")} {
	    append geos " " $file
	}
    }
    cd $here
    return [lsort $geos]
}

proc check_path_all {path} {
    foreach comp [split $path /] {
	if ![check_path_component $comp Path puts] { return 0 }
    }
    return 1
}

proc check_path_component {string name {puts errormsg}} {
    if {[string length $string] > 27} {
	$puts "$name names may not be longer than 27 characters"
	return 0
    }
    if [string match {* *} $string] {
	$puts "$name names may not contain the space character"
	return 0
    }
    if [string match {*	*} $string] {
	$puts "$name names may not contain the tab character"
	return 0
    }
    if {[string index $string 0] == "-"} {
	$puts "$name names may not begin with a dash (-)"
	return 0
    }
    foreach c {/ = \" $ & \\* \\? ( ) \{ \} \\\[ \\\] \\\\ ' ` ~ | \; < >} {
        if [string match "*$c*" $string] {
	    $puts "$name names may not contain the $c character"
	    return 0
        }
    }
    if 0 {
	if {[regexp \[A-Z\] $string] == 1} {
	    $puts "$name names may not contain upper case characters"
	    return 0
	}
    }
    return 1
}

proc get_ddn_defaults {} {
    global ddnterm env icem_fluent
    
    set args "um=[get_units] ds=[get_draft] pf=[get_partform] hd=y"
    
    switch $ddnterm {
	console -
	native -
	OpenGL {
	    if [string match *OSF1* [cmd_uname_a]] {
		return "tt=xterm $args"
	    } else {
		return "tt $args"
	    }
	}
	xterm -
	x11 {
	    return "tt=xterm $args"
	}
	none {
	    return "tt=none $args"
	}
	default {
	    return "tt=$ddnterm $args"
	}
    }
}

proc get_pcube_defaults {} {
    global ddnterm env icem_fluent

    set args "um=[get_units] ds=[get_draft] pf=[get_partform]"

    switch $ddnterm {
        console -
        native -
	OpenGL {
            return "tt $args"
        }
        xterm -
        x11 {
            return "tt=xterm $args"
        }
        none {
            return "tt=none $args"
        }
        default {
            return "tt=$ddnterm $args"
        }
    }
}

proc build_tetra_param_file {file input output} {
    set fd [open $file w]
    
    puts $fd "SurfaceFile               \"$input\""
    puts $fd "RootTetraFile             \"[file tail $input]/tetra_file\""
    puts $fd "TraceFile                 \"-\""
    puts $fd "DomainOutputFile          \"$output\""
    puts $fd "EatBadEdges               1"
    puts $fd "DebugMalloc               0"
    puts $fd "CheckBalance              0"
    puts $fd "CheckConformality         0"
    puts $fd "CheckConformalityAtEnd    0"
    puts $fd "LookAtInputData           0"
    puts $fd "LookAtSubdivisionOutput   0"
    puts $fd "LookAtConformalOutput     0"
    puts $fd "LookAtSplitOutput         0"
    puts $fd "LookAtThirdPassOutput     0"
    puts $fd "LookAtDisplacementOutput  0"
    puts $fd "LookAtSurfaceOutput       1"
    puts $fd "Delta                     0.200"
    puts $fd "DisplaceByAverage         0"
    puts $fd "DisplaceByProjection      1"
    puts $fd "WindowSize              0.5"
    
    close $fd
}

proc ddn_partname {pn} {
    global is_win
    
    if $is_win {
	set a [regsub -all " " $pn _ pn]
	set b [regsub -all "\t" $pn _ pn]
	if {$a || $b} {
	    mess "Warning: on windows DDN part names can't have spaces.\n" red
	}
	return $pn
    } else {
	return \"$pn\"
    }
}

proc run_ddn_interpreted {name what script libdir extras} {
    global partfile place partname sheetname gui_name
    global ddn_path icem_fluent icem_powermesh
    
    if {$what == "d"} {
	set xx $gui_name(geopart)
    } else {
	set xx $gui_name(meshpart)
    }
    if {($partname == "") && ![pick_part $xx]} return
    
    if { !$icem_fluent && !$icem_powermesh } {
	if {$what == "d"} {
	    if {($partfile != "") && [part_is_mulcad] && \
		[query_question .query \
		 "The current part is in the $gui_name(meshpart) directory: really run $name?"] \
		    == "*cancel*"} return
	}
	if {$what == "m"} {
	    if {($partfile != "") && ![part_is_mulcad] && \
		[query_question .query \
		 "The current part is in the $gui_name(geopart) directory: really run $name?"] \
		    == "*cancel*"} return
	}
    } else {
        if {$what == "d"} { 
            if {($partfile != "")} return 
        }
        if {$what == "m"} { 
            if {($partfile != "")} return
        }
    }

    
    set restart_name [tmpname]
    cmd_rm $restart_name
    set restart [open $restart_name w]
    puts $restart "F.5.13.5.3.$libdir"
    puts $restart "F.5.13.3.$script"
    if {$extras != ""} {puts $restart $extras}
    close $restart
    if {$what == "d"} {
	set db parts
    } else {
	set db $place/parts
    }
    set command "$ddn_path db=$db pn=[ddn_partname $partname] sn=$sheetname\
		i=$restart_name [get_ddn_defaults]"
    runxcom $name $command "" 1 0
    update_partlist d 0
}

proc run_ddn_linked {name what script extras} {
    global partfile place partname sheetname
    global ddn_path gui_name env
    
    if {$what == "d"} {
	set xx $gui_name(geopart)
    } else {
	set xx $gui_name(meshpart)
    }
    if {($partname == "") && ![pick_part $xx]} { return 0 }
    
    if {$what == "d"} {
	set q "The current part is in the $gui_name(meshpart) directory: really run $name?"
	if {($partfile != "") && [part_is_mulcad] && \
		[query_question .query $q] == "*cancel*"} {
	    return 0
	}
    }
    if {$what == "m"} {
	set q "The current part is in the $gui_name(geopart) directory: really run $name?"
	if {($partfile != "") && ![part_is_mulcad] && \
		[query_question .query $q] == "*cancel*"} {
	    return 0
	}
    }
    
    set restart_name [tmpname]
    cmd_rm $restart_name
    set restart [open $restart_name w]
    # menus on and off are no longer supported
    #    puts $restart "m"
    puts $restart F.5.13.5.6
    puts $restart $env(ICEM_ACN)/common/gpl
    puts $restart "F.5.13.7.$script"
    if {$extras != ""} { puts $restart $extras }
    close $restart
    if {$partfile == ""} {
	set db parts
    } else {
	set db [file dirname $partfile]
    }
    set command "$ddn_path db=$db pn=[ddn_partname $partname] sn=$sheetname\
		i=$restart_name [get_ddn_defaults]"
    runxcom $name $command "" 1 0
    update_partlist d 0
    return 1
}


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

proc check_license_expiration {} {
    global env icem_fluent features_available is_win
    global icem_starcd
    
    if $is_win {
	infomsg "License file not being checked on Windows."
	return
    }
    
    # Check this subset of features.
    if $icem_fluent {
	set products geomesh
    } else {
	set products {
	    DD AD PADAMM TETRA GLOBAL P-CUBE MULCAD QUAD HEXA LEO OUTPUT COMAK
	    DDX ADX PADAMMX TETRAX GLOBALX MULCADX QUADX HEXAX LEOX
	}
    }
    
    if [info exists env(LM_LICENSE_FILE)] {
	set licenses [split $env(LM_LICENSE_FILE) :]
    } else {
	set licenses $env(ICEM_ACN)/lic/license.dat
    }
    infomsg "Verifying license file(s): \"$licenses\"."
    
    set maxminday 0
    set maxminprod ""
    foreach lic $licenses {
	if [string match *@* $lic] continue
	if ![file exists $lic] {
	    set mess "License file \"$lic\" doesn't exist.  Please check\
		    your ICEM_ACN and/or LM_LICENSE_FILE environment\
		    variables.  Most icemcfd functions will not work\
		    without a valid license file."
	} elseif ![file readable $lic] {
	    set mess "License file \"$lic\" is not readable.  Please check\
		    your ICEM_ACN and/or LM_LICENSE_FILE environment\
		    variables.  Most icemcfd functions will not work\
		    without a valid license file."
	} else {
	    set minday 0
	    set minprod ""
	    set fp [open $lic r]
	    while {![eof $fp]} {
		set line [gets $fp]
		if [catch {lindex $line 0}] {
		    set mess "License file \"$lic\" is corrupted. \
			    Please check the file for lines that have been\
			    split into two, and join them if necessary."
		    break
		}
		if {[lindex $line 0] != "FEATURE"} {
		    #puts "skipping line $line"
		    continue
		}
		set prod [lindex $line 1]
		#puts "feature $prod is available"
		set features_available($prod) 1
		if {[lsearch $products $prod] < 0} continue
		
		set exp [lindex $line 4]
		if ![regexp {^([0-9]+)-([a-zA-Z]+)-([0-9]+)$} \
			$exp dummy day mname year] continue
		scan $day %d day
		set i 0; catch {unset month}
		foreach m {jan feb mar apr may jun jul aug sep oct nov dec} {
		    if [string match $m* [string tolower $mname]] {
			set month $i
			break
		    }
		    incr i
		}
		if ![info exists month] {
		    errormsg "Bad date in license file: $exp"
		    continue
		}
		if {$year < 1900} { set year [expr $year + 1900] }
		set eday [expr {$year * 372 + $month * 31 + $day - 1}]
		if {!$minday || ($minday > $eday)} {
		    set minday $eday
		    set minexp $exp
		    set minprod $prod
		}
	    }
	    close $fp
	    
	    if !$minday {
		set mess "Something is wrong with your license file,\
			\"$lic\" -- none of the expiration dates there\
			could be parsed."
	    } else {
		if {!$maxminday || ($maxminday < $minday)} {
		    set maxminday $minday
		    set maxminprod $minprod
		}
	    }
	}
    }
    if $maxminday {
	set xx ""
	foreach n [exec date {+%Y %m %d}] {
	    lappend xx [string trimleft $n 0]
	}
	set now [expr {[lindex $xx 0] * 372 + ([lindex $xx 1] - 1) * 31 \
			   + [lindex $xx 2] - 1}]
	set d [expr {int($maxminday - $now)}]
	if {$d < 0} {
	    set mess "Your license file, \"$lic\", seems to have expired."
	} elseif {$d == 0} {
	    set mess "Your license file, \"$lic\", expires after today."
	} elseif {$d < 15} {
	    set mess "Your license file, \"$lic\", will expire in\
		    [expr {($d == 1) ? "1 day" : "$d days"}]."
	} else {
	    puts "license expires in $d days"
	}
    }
    if [info exists mess] {
	#tk_dialog .license "License problem" $mess "" 0 Okay
	append mess "  Please contact your distributor to obtain a new\
		    license file.  If you are a customer of ICEM CFD\
		    Engineering you can send email to licensing@icemcfd.com."
	append mess "  (First expiring product was \"$maxminprod\".)"
	append mess "\n(This message is advisory only.)"
	warningmsg $mess
	catch {unset features_available}
    }
    set icem_starcd [info exists features_available(CFD-Star_CD)]
}

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

foreach ks {
    { { } space }
    { {!} 1 Shift }
    { {"} ' Shift }
    { {#} 3 Shift }
    { {$} 4 Shift }
    { {%} 5 Shift }
    { {&} 7 Shift }
    { {'} apostrophe }
    { {(} 9 Shift }
    { {)} 0 Shift }
    { {*} 8 Shift }
    { {+} equal Shift }
    { {,} comma }
    { {-} minus }
    { {.} period }
    { {/} slash }
    { {:} semicolon Shift}
    { {;} semicolon }
    { {<} comma Shift }
    { {=} equal }
    { {>} period Shift }
    { {?} slash Shift }
    { {@} 2 Shift }
    { {[} bracketleft }
    { {/} backslash }
    { {]} bracketright }
    { {^} 6 Shift }
    { {_} minus Shift }
    { {`} grave }
    { \{  bracketleft Shift }
    { {|} backslash Shift }
    { \}  bracketright Shift }
    { {~} grave Shift }
} {
    set ks_names([lindex $ks 0]) [lrange $ks 1 end]
}

proc send_keyboard_events {name wait string} {
    global ks_names env
    
    set fp [open keyboard.csh w]
    puts $fp "while ( 1 )"
    puts $fp "    set win = `xlswins | grep \"$name\" | sed 's/(.*\$//'`"
    puts $fp "    if ( \$win != \"\" ) break"
    puts $fp "    sleep 1"
    puts $fp "end"
    puts $fp "sleep $wait"
    set i 0
    foreach c [split $string ""] {
	if {!($i % 5)} {
	    puts $fp ""
	    puts $fp "if ( ! -e keyboard.csh ) exit 0"
	    puts $fp ""
	    puts $fp "$env(ICEM_ACN)/bin/xse -win \$win" nonewline
	}
	incr i
	set s ""
	if [info exists ks_names($c)] {
	    set s [lindex $ks_names($c) 1]
	    set c [lindex $ks_names($c) 0]
	}
	puts $fp " '$s<KeyPress>$c' '$s<KeyRelease>$c'" nonewline
    }
    puts $fp ""
    close $fp
    exec /bin/csh -f keyboard.csh &
    return keyboard.csh
}
