#######################################################################
# @(#)main.tcl 1.19 5/9/01
#
# main.tcl: starting rtitcl-based applications
#
# Copyright (C) 2004 Electronic Data Systems Corporation.  All Rights Reserved.
#
#######################################################################

# Generic application startup: set globals, call utlGenericParams

#######################################################################
# Load util.tcl (required functions)

set PVDIR [utlFullPath $PVDIR]
if {[catch {source $PVDIR/lib/util.tcl}]} {
	puts "ERROR: Cannot load util.tcl"
}
if {[utlSysname] == "MSWindows"} {
	if {[catch {source $PVDIR/lib/tcl8.tcl}]} {
		console_puts "ERROR: Cannot load tcl8.tcl"
	}
}


#######################################################################
# Initialize global variables

set COPYRIGHT "Copyright (C) 2004 Electronic Data Systems Corporation.  All Rights Reserved."
set VERSION "(dev)"
set PROGRAM [string tolower [file rootname [file tail $argv0]]]
utlInitGenericGlobals


#######################################################################
# Initialize global constants

# constants for coordinates; 72 dots per inch for PS; HPGL uses PLU == 1/40 mm
set DPI 72
set DPI2PLU [expr {25.4*40/$DPI}]

# different paper sizes in DPIs
set PAPERSIZE(A)  "[expr {8*$DPI+$DPI/2}]  [expr {11*$DPI}]"
set PAPERSIZE(B)  "[expr {11*$DPI}]        [expr {17*$DPI}]"
set PAPERSIZE(C)  "[expr {17*$DPI}]        [expr {22*$DPI}]"
set PAPERSIZE(D)  "[expr {22*$DPI}]        [expr {34*$DPI}]"
set PAPERSIZE(E)  "[expr {34*$DPI}]        [expr {44*$DPI}]"
set PAPERSIZE(J)  "[expr {34*$DPI}]        [expr {92*$DPI}]"
set PAPERSIZE(A4) "[expr {int(21/2.54*$DPI)}]   [expr {int(29.7/2.54*$DPI)}]"
set PAPERSIZE(A3) "[expr {int(29.7/2.54*$DPI)}] [expr {int(42/2.54*$DPI)}]"
set PAPERSIZE(A2) "[expr {int(42/2.54*$DPI)}]   [expr {int(59.4/2.54*$DPI)}]"
set PAPERSIZE(A1) "[expr {int(59.4/2.54*$DPI)}] [expr {int(84.1/2.54*$DPI)}]"
set PAPERSIZE(A0) "[expr {int(84.1/2.54*$DPI)}] [expr {int(129.7/2.54*$DPI)}]"

# ordered by increasing size
set PAPERSIZES {A A4 B A3 C A2 D A1 E A0 J}


#######################################################################
# Product sign-on message

proc mainSignOn {vvname {pvname ""}} {
	global VERSION COPYRIGHT

	utlInfo "$vvname $VERSION"
	utlInfo "$COPYRIGHT"
}


#######################################################################
# General help entry point

proc appHelp {} {
	global PROGRAM

	if {[info proc ${PROGRAM}Help] != ""} {
		${PROGRAM}Help
	} else {
		utlInfo "No help specified for application \"$PROGRAM\""
	}
}


#######################################################################
# General configure entry point

proc appConfigure {} {
	global PROGRAM

	if {[info proc ${PROGRAM}Configure] != ""} {
		${PROGRAM}Configure
	} else {
		if {![utlEditResourceFile]} {
			utlInfo "No configuration method specified for application \"$PROGRAM\""
		}
	}
}


#######################################################################
# Define quit procedures
#
# NOTE: Keep "mainQuit" seperate because the app may want to call it
# from its own quit proc.

proc quit {} {
	appQuit
	exit
}

proc appQuit {} {
	global PROGRAM

	if {[info proc ${PROGRAM}Quit] != ""} {
		${PROGRAM}Quit
	} else {
		mainQuit
	}
}

proc mainQuit {} {

	# Clean up
	utlQuitActions
	ipcCloseAll
	utlRMTempFiles
	
	# Give up control to ensure secondary processes can finish (Windows)
	utlSleep 1
}


#######################################################################
# Define drag and drop, second invocation event, and exit-related 
# procedures.

if { [info exists tcl_msWindows] } {

	# Send special character keystrokes to a user-keystroke
	# routine, if one exists.
	proc appKey {key} {
		if {[info proc userKey] != ""} {
			userKey $key
		}
	}

	# Send special menu selections to a user-menu
	# routine, if one exists.
	proc appMenu {ID} {
		if {[info proc userMenu] != ""} {
			userMenu $ID
		}
	}

	# This is called directly (by name) from the RTI custom console
	# code when a file is dropped onto the app.
	proc appDrop {file} {
		global PROGRAM
		dbg {appdrop: $file}

		if {[info proc ${PROGRAM}Drop] != ""} {
			${PROGRAM}Drop $file
		} else {
			$PROGRAM $file
		}
	}

	# This is needed to queue commands sent from a slave app.
	# It is called from mainStartup (sometimes, depending on the 
	# circumstances) when a slave is invoked.
	# It only is needed for the version 7 interpreter.
	proc invoke args {
		set program [string tolower [file rootname [file tail [lindex $args 0]]]]

		# Put command in execution queue
		winpost self 1054 0 "!$program [lrange $args 1 end]"

		return "queued"
	}

	# For Windows, this overrides the standard "exit" command
	proc exit {{level 0}} {
		# Standard TCL exit doesn't work correctly for Windows
		winkill self
	}

	# This is used to determine if all secondaries have been
	# processed before quitting.  It can be invoked from any
	# location, but one place is mainStartup for non-interactive
	# mode.
	set CheckTerminateDATA 0
	proc CheckTerminate {cmdid} {
		global CheckTerminateDATA
	
		# check that we processed all queued commands by looking at history count
		debug "CheckTerminate: $cmdid <-> [history nextid]"
		if {$cmdid >= [history nextid]-1} {
			incr CheckTerminateDATA
			if {$CheckTerminateDATA > 1} {
				utlExit
			}
		} else {
			set CheckTerminateDATA 0
		}
		utlSleep 2
		winpost self 1054 0 "!CheckTerminate [history nextid]"
	}

} else { # Unix

}


#######################################################################
# Define routines for basic rtitcl/maintenance mode

proc rtitcl args {
	global PVDIR auto_path argv

	set PVDIR [file dirname [utlFullPath [utlUnixFileName [lindex $argv 0]]]]
	dbg {rtitcl: PVDIR=$PVDIR}
	if {[file isdirectory $PVDIR/lib]} {
		lappend auto_path $PVDIR/lib
		dbg {rtitcl: auto_path=$auto_path}
	}
	eval $args
	return
}

proc rtitclSignOn {} {
	global tcl_prompt1 VERSION
	mainSignOn "VVCP TCL Shell"
	utlInfo ""
	history keep 100
	if {[utlSysname] != "MSWindows"} {
		set tcl_prompt1 {puts stdout "[history nextid]% " non}
	}
}


#######################################################################
# Queue requests and launch single seperate instance of the application
# to process each request one at a time.  Quits when no requests left.
#
# NOTES:
# o QueueServerDelay can be set to remain in queueing mode for the given
# number of seconds before quitting (0 to disable this).
# o AppMaxWait is the time that the seperate instance has to complete 
# processing (0 for no timeout).
# o proc mainQueueClientMessage is used by the client to send info
# back to the server (like "-done" to indicate the next process may
# be started).

proc mainQueueServer args {
	global mainQueueServerVars PROGRAM PVDIR
	dbg {>mainQueueServer: $args}

	utlInfo "$PROGRAM Queue Server\n"

	# Set up
	set timeout [utlDefault QueueServerDelay "" "" 20]
	set exectimeout [utlDefault AppMaxWait "" "" 300]
	set mainQueueServerVars(commandlist) [list [concat $PROGRAM -queueclient $args]]

	# Redefine the master routine
	proc $PROGRAM args {
		global mainQueueServerVars PROGRAM

		set command [concat $PROGRAM -queueclient $args]
		lappend mainQueueServerVars(commandlist) $command
	}

	# Enter the server loop
	set mainQueueServerVars(processing) 1
	set elapsed 0
	while {1} {

		# Delay quitting for a while after the last command is processed
		if {$elapsed > $timeout || $timeout == 0} {
			break
		} elseif {[llength $mainQueueServerVars(commandlist)] == 0} {
			utlSleep 1
			incr elapsed
		} else {

			# Determine command
			set command [lindex $mainQueueServerVars(commandlist) 0]

			# format the command by wrapping arguments with backslashes
			# in double quotes since curly braces cause the backslashes
			# to be converted to forward slashes in the client
			set newcommand ""
			foreach cpart $command {
				if {[regexp {\\} $cpart]} {
					# wrap parameters with backslashes in double quotes
					append newcommand "\"$cpart\" "
				} elseif {[llength $cpart] > 1} {
					# handle parameters with spaces
					if {[regexp {\"} $cpart]} {
						# use braces if the parameter has a quote in it
						append newcommand "{$cpart} "
					} else {
						# wrap in double quotes
						append newcommand "\"$cpart\" "
					}
				} else {
					append newcommand "$cpart "
				}
			}
			dbg {formatted command ($command) to ($newcommand)}
			set command $newcommand

			# Execute command and wait for completion
			utlInfo "Launching command: $command"
			set mainQueueServerVars(processing) 1
			winexec $PVDIR/$command
			set elapsed 0
			while {$mainQueueServerVars(processing) && ($elapsed < $exectimeout || $exectimeout == 0)} {
				utlSleep 1
				update
				incr elapsed
			}

			# Reset variables
			set mainQueueServerVars(commandlist) [lrange $mainQueueServerVars(commandlist) 1 end]
			set elapsed 0
		}

		update
	}

	dbg {<mainQueueServer}
	utlExit
}
		

proc mainQueueClientMessage {message} {
	global mainQueueServerVars

	utlInfo "Received message from client: $message"

	if {$message == "-done"} {
		set mainQueueServerVars(processing) 0
	}
}


#######################################################################
# Program start-up routines

proc mainStartup {} {
	global argv PROGRAM PVDIR QUIET MASTER HADERROR TMPDIR VERSION
	global tcl_interactive auto_path

	set STANDALONE 0

	# Process generic parameters like -tmpdir and -pvdir
	set argc [llength $argv]
	set args [utlGenericParams [lrange $argv 1 end]]

	# Load any valid tpg from the lib directory
	utlLoadTPG

	# Check if we are in interactive mode (maintenance mode)
	if {[utlIn "-maint" $argv]} {
		rtitclSignOn
		rtitcl
		return
	}

	# Try to load user TCL code, but do not issue an error message
	# if it fails since it is optional.
	if {[catch {UserTCLCode} msg]} { dbg $msg }

	# Start the DDE server for slave routines to connect to
	if {[utlSysname] == "MSWindows" && [utlInterpVersionAt 8] && $MASTER} {

		# Start DDE server
		dde servername ${PROGRAM}:Master

		# Determine if the queue server should be used or not
		set bUseQueueServer 0
		if {[utlIn "-queue" $args]} {
			set index [lsearch $args "-queue"]
			set args [lreplace $args $index $index]
			set bUseQueueServer 1
		}
		if {[utlDefaultBool QueueServer]} {
			set bUseQueueServer 1
		}
		if {$bUseQueueServer} {
			eval [concat mainQueueServer $args]
		}
	}

	# Remove any "-queue" from a slave process (it is only meaningful to 
	# the master process)
	if {[utlIn "-queue" $args]} {
		set index [lsearch $args "-queue"]
		set args [lreplace $args $index $index]
	}

	# Ignore slave routine or "SingleProcess" setting if this parameter is set
	if {[utlIn "-standalone" $args]} {
		set STANDALONE 1
		set index [lsearch $args "-standalone"]
		set args [lreplace $args $index $index]
	}

	# This was launched from the queue server and requires special behavior
	if {[utlIn "-queueclient" $args]} {
		set QUEUECLIENT 1
		set STANDALONE 1
		set index [lsearch $args "-queueclient"]
		set args [lreplace $args $index $index]
	} else {
		set QUEUECLIENT 0
	}

	# Call sign-on routine
	if {!$QUIET} {
		if {[catch ${PROGRAM}SignOn]} {utlError "$PROGRAM $VERSION - Unknown Application (${PROGRAM}SignOn not found)"}
	}

	# For -runproc, execute the given proc with the remaining args
	if {[lindex $args 0] == "-runproc"} {
		set runproc [lindex $args 1]
		set args [lrange $args 2 end]
		set runcmd [concat $runproc $args]
		dbg {-runproc command: $runcmd}
		if [catch {set result [eval $runcmd]} msg] {
			dbg {ERROR in -runproc: $msg}
		}
		dbg {Script result: $result}
		utlExit
	}

	# If it is -help, display it and pop up window
	if {[utlIn "-help" $args]} {
		appHelp
		if { [utlSysname] == "MSWindows"} { utlConsole -open }
		utlExit
	}

	# Determine the appropriate command, taking the windows master/slave issue
	# into account.
	set cmd [concat $PROGRAM $args]
	if {[utlSysname] == "MSWindows" && !$MASTER && !$STANDALONE} {

		# Determine if this is single-process or if it has a slave routine
		set singleprocess 1
		set slave 0
		if {[utlDefault SingleProcess] != ""} {
			set singleprocess [utlDefaultBool SingleProcess]
		} elseif {[utlDefaultBool QueueServer]} {
			set singleprocess 1
		} elseif {[info proc $PROGRAM:Slave] != ""} {
			set singleprocess 0
			set slave 1
		} elseif {[auto_load $PROGRAM:Slave]} {
			set singleprocess 0
			set slave 1
		}

		# If allowing only a single process, send the request to the master to 
		# be queued and then exit.
		if {$singleprocess} {
			dbg {main: single-process active, passing secondary's command to master ($args)}
			if {[utlInterpVersionAt 8]} {
				set error [catch {eval [list dde execute TclEval ${PROGRAM}:Master [concat $PROGRAM $args]]}]
			} else {
				set error [catch {eval [list dde_request pvlink tk_comm -timeout 120000 invoke [concat $PROGRAM $args]]}]
			}

			# Quit now unless there was an error
			if {$error} {
				utlError "Master failed to respond; processing command in stand-alone mode"
			} else {
				utlExit
			}

		# If using a slave routine, set the command to that procedure
		} elseif {$slave} {
			dbg {main: starting the slave routine with $args}
			set cmd [concat $PROGRAM:Slave $args]

		# Do nothing special for multiple processes
		} else {
			dbg {main: secondary running normally (as seperate process)}
		}
	}
	dbg {main: $cmd, TMPDIR=$TMPDIR, auto_path=$auto_path, PVDIR=$PVDIR}

	# Execute program with remaining parameters
	# NOTE: Use utlProcessGenericParamsOn/Off to keep programs that call this
	# themselves from calling it a second time.
	history clear
	history keep 100
	set cont ""
	utlProcessGenericParamsOff
	if {[debugOn *]} {
		set cont [eval $cmd]
	} else {
		if {[catch {set cont [eval $cmd]} msg] && $msg != ""} {utlError $msg}
	}
	utlProcessGenericParamsOn
	utlAppStarted -setdone


	# After program execution: terminate, interactive, or just wait
	set tcl_interactive 1
	dbg {Continue action=$cont}

	# Queue client must tell the server it is done
	if {$QUEUECLIENT} {
		eval [list dde execute TclEval ${PROGRAM}:Master "mainQueueClientMessage -done"]
	}

	# Do not exit if -wait specified
	if {$cont == "-wait" } {
		dbg {Specified action is "-wait": not quitting}

	# Windows: exit in some cases, open the console in others
	} elseif {[utlSysname] == "MSWindows"} {

		# Exit if the app was started with a command to process
		if {$argc > 1} {
			
			# Don't exit when there are errors unless ExitOnErrors is set
			if {$HADERROR && ![utlDefaultBool ExitOnError]} {
				dbg {Windows with arguments: error, not quitting}

			# Quit using a special mechanism that verifies no secondary 
			# processes are still in the command queue.
			} elseif {$MASTER} {
				dbg {Windows with arguments: quitting (master)}
				if {[catch {winpost self 1054 0 "!CheckTerminate 0"}]} {
					dbg {*** could not find "self" window}
					utlExit
				}

			# Always exit at this point
			} else {
				dbg {Windows with arguments: quitting}
				utlExit
			}

		# Pop up the console if not quitting
		} else {
			dbg {Windows: opening console, not quitting}
			utlConsole -open
		}

	# Unix: always exit at this point
	} else {
		dbg {Unix: quitting}
		utlExit
	}

	# Must explicitly return to prevent a return value from displaying
	return
}


#######################################################################
# Execute program start-up code

mainStartup