# $Revision$ on $Date$
# The above revision line needs to be the first line for all techtk files
# Copyright (c) 2006 Ansys Inc
#----------------------------------------------------------------------------
#
# PADT---------------------------------------------------- Phoenix Analysis &
#                                                         Design Technologies
#
#----------------------------------------------------------------------------
#
#       Package: AI-Environment GUI Management
#
#
#          File: object_management.tcl
#
#
#     Developer: Matt Sutton
#
#
#   Description: The procedures in this file are responsible for creating and
#                maintaining the execution environment for the DEZs.  This 
#                includes setting up the namespaces that wrap each DEZ as well
#                as transparently executing client procedures within these
#                namespaces.  Furthermore, all variables referenced by the 
#                widgets within a DEZ are wrapped within the DEZ's namespace
#                and are managed by the procedures within this file.
#   
#
#      05/03/02: File Creation (MGS)
#
#           
#
#-----------------------------------------------------------------------------
# For support: 1-480-813-4884 ext. 125 -or- matt.sutton@padtinc.com
#-----------------------------------------------------------------------------


namespace eval ::AIEnv::GUIManagement {
	
	# TypeList is a list of valid types currently accepted by AIEnv
	variable TypeList
	set TypeList {
		Wizard
		DEZ
		Picker
		NodeMover
		MultiSelect
		ExclusiveGroup
		ColumnMultiSelect
	}
	
	variable TypeArray
	
	# NamespacePrefix is an arbitrary prefix that is prepended to the unique namespace 
	# assigned to each object
	variable NamespacePrefix
	
	# LocalVariables is an array indexed by object name. The entries in the array are
	# lists of variable names local to the corresponding object
	variable LocalVariables
	
	# ObjectList holds a list of all the names of the objects created thus far
	variable ObjectList
	set ObjectList ""
	
	set NamespacePrefix ::AIEnv
	
	# Type stack holds a stack of types.  The top of the stack is the currently active
	# type. Types are pushed onto the stack via a call to BeginTypeDefinition and are
	# popped off of the stack via a call to the function EndTypeDefinition
	::struct::stack TypeStack
	
	# ObjectStack holds a stack of Objects.  The top of the stack is the currently active
	# object. Objects are pushed onto the stack via a call to BeginObjectDefinition and are
	# popped off of the stack via a call to the function EndObjectDefinition
	::struct::stack ObjectStack
}

proc ::AIEnv::GUIManagement::BeginObjectDefinition {Name {Type ""}} {
	variable TypeList
	if { $Type == "" } {
		if { [TypeStack size] != 0 } {
			RegisterObjectImpl $Name [TypeStack peek]
		} else {
			InitError "No available type found for the object named: \"$Name\" during BeginObjectDefinition"
		}
	} elseif { [lsearch $TypeList $Type] != -1} {
		RegisterObjectImpl $Name $Type
	} else {
		InitError "Unknown type: \"$Type\" passed to RegisterObject."
	}
	ObjectStack push $Name
}

proc ::AIEnv::GUIManagement::EndObjectDefinition {} {
	if { [ObjectStack size] != 0 } {
		ObjectStack pop
	}
}

proc ::AIEnv::GUIManagement::BeginPredefinedObject {Name} {
	ObjectStack push $Name
}

proc ::AIEnv::GUIManagement::EndPredefinedObject {} {
	if { [ObjectStack size] != 0 } {
		ObjectStack pop
	}
}

proc ::AIEnv::GUIManagement::RegisterObjectImpl {Name Type} {
	variable ObjectList
	variable NamespacePrefix
	variable LocalVariables
	variable TypeArray
	# First check to see if an object already exists
	lappend LocalVariables($Name) this
	lappend LocalVariables($Name) type
	
	set ExistingObjectIndex [lsearch $ObjectList $Name]
	if { $ExistingObjectIndex == -1 } {
		if { [string equal [info commands $Name] ""] } {
			# Set up the command routing
			interp alias {} ::${Name} {} ::AIEnv::GUIManagement::${Type}::RouterProc $Name
			# Create the local namespace for the object
			set Namespace [GetNamespace $Type $Name]
			set TypeArray($Name) $Type
			global _Type
			global _Name
			set _Name $Name
			set _Type $Type
			namespace eval $Namespace {
				global _Type
				global _Name
				variable type
				variable this
				set type $_Type
				set this $_Name
			}
			unset _Type
			unset _Name
			# Record the object
			lappend ObjectList $Name
		} else {
			::InitError "A global function named: \"$Name\" already exists. Can't create an object named: \"$Name\"."
		} 
	} else {
		::InitError "An object named: \"$Name\" already exists."
	}
}

proc ::AIEnv::GUIManagement::BeginTypeDefinition {Type} {
	variable TypeList
	if { [lsearch $TypeList $Type] != -1 } {
		TypeStack push $Type
	} else {
		::InitError "Invalid type: \"$Type\" passed to BeginTypeDefinition"
	}
}

proc ::AIEnv::GUIManagement::EndTypeDefinition {} {
	if { [TypeStack size] != 0 } {
		TypeStack pop
	}
}

proc ::AIEnv::GUIManagement::CreateVariable {VariableName {type ""}} {
	if { [ObjectStack size] != 0 } {
		set CurrentObjectName [ObjectStack peek_one]
	} else {
		::InitError "No object available while executing: \"CreateVariable $VariableName\""
	}

	if [string match ::?* $VariableName] {
	   trace variable $VariableName  w "::AIEnv::GUIManagement::DEZ::TraceFunc $CurrentObjectName"
	   return $VariableName
	}

	variable LocalVariables
  
        if {$type != ""} {
           set CurrentType $type
        } elseif { [TypeStack size] != 0 } {
	   set CurrentType [TypeStack peek_one]
	} else {
	   ::InitError "No type available while executing: \"CreateVariable $VariableName\""
	}
	
	if { [array names LocalVariables $CurrentObjectName] != "" } {
		if { [lsearch $LocalVariables($CurrentObjectName) $VariableName] == -1 } {
			lappend LocalVariables($CurrentObjectName) $VariableName
		} else {
			# By commenting this out, we are turning off the check for unique
			# variable names.
			#::InitError "The variable named: \"$VariableName\" already exists in the object named: \"$CurrentObjectName\""
		}
	} else {
		lappend LocalVariables($CurrentObjectName) $VariableName
	}
	
	# Return the properly constructed variable with the full namespace spec
	set Namespace [GetNamespace $CurrentType $CurrentObjectName]
	set FullyQualifiedVariableName ${Namespace}::${VariableName}
	return $FullyQualifiedVariableName
}

proc ::AIEnv::GUIManagement::GetFullyQualifiedVariableName {VariableName} {
	if { [TypeStack size] != 0 } {
		if { [ObjectStack size] != 0 } {
			set Type [TypeStack peek]
			set Object [ObjectStack peek]
			return [GetNamespace $Type $Object]::${VariableName}
		} else {
			::InitError "Object stack empty"
		}
	} else {
		::InitError "Type stack empty"
	}
}
proc ::AIEnv::GUIManagement::GetLocalVariables {ObjectName} {
	variable LocalVariables
	if { [array names LocalVariables $ObjectName] != -1 } {
		return $LocalVariables($ObjectName)
	} else {
		RuntimeError "Could not find local variables for object named: \"$ObjectName\""
	}
	
}

proc ::AIEnv::GUIManagement::GetNamespace {Type Name} {
	variable NamespacePrefix
	return ${NamespacePrefix}::${Type}::${Name}
}

proc ::AIEnv::GUIManagement::GetObject {} {
	if { [ObjectStack size] != 0 } {
		return [ObjectStack peek]
	} else {
		::InitError "Object not available within GetObject"
	}
}
