//*****************************************************************************
// $RCSfile: std.tdl,v $
// $Revision: 1.2 $
// $Date: 2002/03/08 15:54:33 $
// Author: Markus Kern
//*****************************************************************************
/*
Contains language independent procedures and templates. These are used by the
language dependent code generators.
See the documentation for a description of these procedures and templates
*/

//------------------------------------------------------------------------------
proc setCount(count)
	[__COUNT__] = [count];
end proc

proc addCount(number)
	[__COUNT__] = add([__COUNT__],[number]);
end proc

proc getCount()
	return [__COUNT__];
end proc

proc setDelim(delim)
	[__DELIM__] = [delim];
end proc

proc delim()
	return [__DELIM__];
end proc

proc setVar(varName, varValue)
	[[varName]] = [varValue];
end proc

//------------------------------------------------------------------------------
proc setString(init)
	[__INIT__] = [init];
	return [init];
end proc

proc getString()
	local txt = [__INIT__];
	[__INIT__] = "";
	return [txt];
end proc

//------------------------------------------------------------------------------
tcl_proc add(num1, num2)
	return [expr $num1 + $num2]
end proc

tcl_proc sub(num1, num2)
	return [expr $num1 - $num2]
end proc

tcl_proc mul(num1, num2)
	return [expr $num1 * $num2]
end proc

tcl_proc div(num1, num2)
	return [expr $num1 / $num2]
end proc

//------------------------------------------------------------------------------
tcl_proc time()
	return [clock format [clock seconds] -format "%X"]
end proc

tcl_proc date()
	return [clock format [clock seconds] -format "%x"]
end proc

//------------------------------------------------------------------------------
tcl_proc hostname()
	return [info hostname]
end proc

//------------------------------------------------------------------------------
tcl_proc replace(str, expr, subSpec)
	set ret "";
	regsub -all $expr $str $subSpec ret;
	return $ret;
end proc

tcl_proc toUpper(str)
	return [string toupper $str];
end proc

tcl_proc toLower(str)
	return [string tolower $str];
end proc

tcl_proc getLength(str)
	return [string length $str];
end proc

tcl_proc lsdir(dir)
	return [file dirname $dir];
end proc

tcl_proc mkdir(dir)
	file mkdir $dir;
end proc

tcl_proc dirName(file)
	set dirName [file dirname $file];
	if { $dirName == "" } {	return "";}
	set delim "/"
	return $dirName$delim;
end proc

tcl_proc fileName(file)
	set fileList [file split $file]
	return [lindex $fileList [ expr [llength $fileList] - 1]]
end proc

tcl_proc regexp(str,reg)
	set ret ""
	regexp $reg $str ret;
	return $ret;
end proc

tcl_proc createString(str,count)
	set x 0
	set ret ""
	while {$x < $count} {
		set ret $ret$str
		incr x
	}
	return $ret
end proc

//------------------------------------------------------------------------------
tcl_proc invIdOrder(list)
	set invList "";
	set li [split $list " "];
	foreach {elem} $li {
		set invList [concat $elem $invList]
	}
	return $invList	
end proc

//------------------------------------------------------------------------------
proc isExternal(MClass)
	loop(MClass->Note->Item
	Where [Item.value] == "True" AND [Item.type] == "UmlClassIsImported")
		return TRUE;
	end loop
	return FALSE;
end proc

//------------------------------------------------------------------------------
proc getStereotype(MSemElement)
	loop(MSemElement->Stereotype)
		return [Stereotype.name];
	end loop
end proc

//------------------------------------------------------------------------------
proc getMultiplicity(multiplicity)

	switch([multiplicity])
	case "":
	case "1":
	case "0..1":
	case "1..0":
	case "0..0":
		return "One";

	case "*":
	case "1..*":
	case "n":
	case "N":
		return "Many";

	case regexp([multiplicity],"[0-9]+"):
		return [multiplicity];

	case regexp([multiplicity],"[0-9]+\.\.[0-9]+"):
		return split([multiplicity],".","T");

	default:
		return "Many";

	end switch
end proc

//------------------------------------------------------------------------------
tcl_proc split(str,delim,pos)

	set li [split $str $delim];
	switch $pos { 
		"L"	{
			return [lindex $li 0]
		} 

		"T"	{
			return  [lindex $li [ expr [llength $li] - 1]]
		} 

		default {
			return [lindex $li $pos]
		} 	
	}
end proc

//------------------------------------------------------------------------------
proc setText(init)
	[__INIT__] = [init];
	return [init];
end proc

proc getText()
	local txt = [__INIT__];
	[__INIT__] = "";
	return [txt];
end proc

//------------------------------------------------------------------------------
proc outText(text,delim1,delim2)
	local ret;
	loop(Instances->TokenSet([text]);setString([delim1]);setString("\n" [delim2]))
	[ret] = [ret] getString()[TokenSet.line];
	end loop
	return [ret];
end proc

//------------------------------------------------------------------------------
proc safeOutput(fileName)
	mkdir(lsdir([fileName]));
	setOutput([fileName]);

	// This comes last, so that it holds the correct value during the insert/mark fixup process
	[ACT_OUTPUT_FILE] = [fileName];
end proc

//------------------------------------------------------------------------------
proc output(fileName)
	mkdir(lsdir([fileName]));
	setOutput(dirName([fileName])"_"fileName([fileName]));
	appendMergeFile([fileName]);
	
	// This comes last, so that it holds the correct value during the insert/mark fixup process
	[ACT_OUTPUT_FILE] = [fileName];
end proc


proc getOutput()
	return [ACT_OUTPUT_FILE];
end proc

//------------------------------------------------------------------------------
proc setLanguage(language)
	[ACT_LANGUAGE] = [language];
end proc

// Generate the id list for the class(es) with specified name.
// Note that we normally expect a single MClass in the list.
// This was introduced to improve the code generator performance.
proc MClass_ids_by_name (name)

   local x = "MClass_by_name_Cache_For_" [name];
   
   if ([[x]] == "")
      loop(Instances -> MClass where [MClass.name] == [name])
         [[x]] = [[x]] " " [MClass.id];
//T info = "MClass_ids_by_name #" [x]" -> "[[x]]"\n";  
      end loop
   end if

//T info = "MClass_ids_by_name :" [x]" -> "[[x]]"\n";   
   return [[x]];
end proc

proc getDataType(type)
	loop(Instances->MClass(MClass_ids_by_name ([type]))->MDataType->TaggedValue
	Where [TaggedValue.tag] == [ACT_LANGUAGE])
		return [TaggedValue.value];
	end loop
//info = "MClass_ids_by_name #" [ACT_LANGUAGE] "\n";  
	return [type];
end proc

//------------------------------------------------------------------------------
template genLines(Lines)
[loop(Instances->TokenSet([Lines]))]
[TokenSet.line]
[end loop]
end template

//------------------------------------------------------------------------------
proc getUniqueId(MElement)
     loop (MElement->MSemElement where [MSemElement.guid] != "")
         return [MSemElement.guid];
     end loop
     return [MElement.id];
end proc

//------------------------------------------------------------------------------
tcl_proc appendMergeFile(fileName)
    catch {
        set file [open "_acdGeneratedFiles.mrg"  "a"];
        puts $file $fileName;
        close $file
    }
end proc

//------------------------------------------------------------------------------
tcl_proc delMergeFile()
    catch {
        file delete "_acdGeneratedFiles.mrg"
    }
end proc

// ECR 5664 begin

tcl_proc substring(text, first, last)
    return [string range $text $first $last];
end proc

tcl_proc searchstr(text, str, start)
    variable res
    set res [string first $str [string range $text $start end]]
    if {$res == -1} {
        return -1
    } else {
        return [expr $start + $res]
    }
end proc

// ECR 5664 end