'RoseScript
'	Version 4.0
'Description
' This script creates a VOPC Class Diagram that contains
' all the classes that participate in a given use case
'
'	History:
'
'	January 1996 (original)
'   July 1999 (modified by Bill Taylor to remove actors from the diagram 
'              and to add associations where none previously existed)
'   September 2000 (modified by Brian Lyons of Number Six Software to 
'              support multi-select, to OPTIONALLY add associations, and
'              to only create the required navigability for the associations.  
'              Also, various other changes were required to have this
'              make sense with multiple use cases (e.g. default name is
'              no longer "VOPC use-case-name")
' 
' 	March 2001
'		Modifed by Stephen Townsend, IMPACT BLUE
'		The Association changed to a dependency as the weakly implied 
'		associations in an OID do not IMPLY an association. This correction
'		provides for the desired effect in round trip engineering with Java - 
'		an import line may be generated.
' 
' 	March 2001
'		Modifed by Stephen Townsend, IMPACT BLUE
'		Added check for controlled units not modifiable. Prevents miscreation
'		of dependencies.
'
'Author
'	NK
'	Rational Software Corp.
'--------------------------------------------------------------


Dim TheDiagramName As String
Dim addAssociations As Boolean

Sub GetUserPreferences(defaultDiagramName As String)

	Begin Dialog CDNDlg ,,134,75,"VOPC Preferences",,,1
		OKButton 16,56,40,14
		CancelButton 84,56,40,14
		Text 18,8,116,8,"Enter the class diagram name",.Text
		CheckBox 18,41,120,8,"Create Associations",.CreateAssociations
		TextBox 18,21,102,12,.ClassDiagramName
	End Dialog

	Dim MyDialog As CDNDlg

	MyDialog.ClassDiagramName =  defaultDiagramName
	
	' Show the dialog
	result% = Dialog (MyDialog)	

	addAssociations = myDialog.CreateAssociations
	TheDiagramName  = myDialog.ClassDiagramName
End Sub

Function scenarioDiagramsForUc (aUc As UseCase) As ScenarioDiagramCollection
	'Return the scenario diagrams that are to contribute
	'participants. Change here to, e.g. take inheritance 
	'between use cases, into account.

	Set scenarioDiagramsForUc = aUc.ScenarioDiagrams
End Function

Sub AddAssocIfNecessary (theSender As Class, theReceiver As Class)
	On Error GoTo removeDependency
    Dim theAssoc As Association
	Dim theAssocs As AssociationCollection
	Dim theDepend As ClassDependency
	Dim theDepends As ClassDependencyCollection
	found = 0	 
	If theSender.GetUniqueID <> theReceiver.GetUniqueID Then
    	Set theDepends = theSender.GetClassDependencies()
	    For a = 1 To theDepends.Count
	        Set theDepend = theDepends.GetAt(a)
' Debug line....
'			Print "The assoc is contained in the class " & theDepend.GetContext.GetQualifiedName

    		If (theDepend.GetClient.GetUniqueId = theSender.GetUniqueId) Then
			 If theDepend.GetSupplier.GetUniqueId = theReceiver.GetUniqueId Then
				found = 1
	    	    Exit Sub
		    End If
			End If
    	Next a
		If found = 0 Then
	    	Set theAssocs = theSender.GetAssociations
		    For a = 1 To theAssocs.Count
		        Set theAssoc = theAssocs.GetAt(a)
	    		If theAssoc.GetOtherRole(theSender).GetClassName = theReceiver.Name Then
					If Not theAssoc.GetOtherRole(theSender).Navigable Then
						theAssoc.GetOtherRole(theSender).Navigable = True
					End If
		    	    Exit Sub
			    End If
	    	Next a
		End If

		' If we got here, there was no appropriate existing association found
		' need to check if the UNIT is controller or right protected

		If theSender.parentCategory.IsModifiable Then 
	   	    Set theDepend = theSender.AddClassDependency("", theReceiver.GetQualifiedName())
	'		theDepend.GetClient.Navigable = True
			theDepend.Name = "vopc-generated"
			theDepend.Documentation = "This dependency exists because the class required within the setters/getters or manipulators."
		Else
'			MsgBox "Class not modifiable: " & theSender.getQualifiedName
			Print "Error: " & theSender.getQualifiedName & " dependency not created, control unit Not modifiable!" 
		End If
	End If
	Exit Sub
	removeDependency:
			MsgBox "Error '" & Err & "' - '" & Error$ & " - has occurred." & " The dependency on '" & theSender.GetQualifiedName & "' may be miscreated."
			Err = 999
End Sub

Sub addParticipatingClasses	(aUseCase As UseCase, answer As ClassCollection)
	'Add the classes participating in aUseCase to parameter answer.
	'Participation is defined as occuring in any of a set of 
	'diagrams defined through the function scenarioDiagramsForUc.

	Dim sDiaList As ScenarioDiagramCollection
	Dim diagramObjects As ObjectInstanceCollection
'	Dim diagramClasses As New ClassCollection
	Dim aClass As Class

	Set sDiaList = scenarioDiagramsForUc (aUseCase)
	For dia% = 1 to sDiaList.Count
		Set diagramObjects = sDiaList.GetAt(dia%).GetObjects
		For obj% = 1 to diagramObjects.count
			If diagramObjects.getAt(obj%).isClass Then
				Set aClass = diagramObjects.getAt(obj%).GetClass()
				If aClass.Stereotype <> "Actor" Then
					If Not answer.Exists(aClass) Then
					    answer.Add aClass
					End If
				End If	
			End If
		Next obj%	
    Next dia%	

	'now add associations between classes
	If addAssociations Then
		Dim diagramMessages As MessageCollection
		Dim theSender As ObjectInstance
		Dim theReceiver As ObjectInstance
		For d = 1 To sDiaList.Count
		    Set diagramMessages = sDiaList.GetAt(d).GetMessages()
			For m = 1 To diagramMessages.count
	    		Set theSender = diagramMessages.GetAt(m).GetSenderObject()
    			Set theReceiver = diagramMessages.GetAt(m).GetReceiverObject()
				If theSender.IsClass And theReceiver.IsClass Then
				    If theSender.GetClass().Stereotype <> "Actor" Then
'						If theSender.GetClass().Stereotype <> "Interface" Then
	    	 			    AddAssocIfNecessary theSender.GetClass(), theReceiver.GetClass()
'					End If
				    End If
				End If
			Next m
		Next d
	End If
End Sub

Sub BuildClassDiagram(TheUseCase As UseCase, TheDiagramName As String)

	Dim TheClasses As ClassCollection
	Set TheClasses = New ClassCollection
	addParticipatingClasses theUseCase, TheClasses
	If TheClasses.Count = 0 Then
		Print "The use case " + theUseCase.name + " has no participating classes."
		Exit Sub
	End If

	Dim TheClassDiagram As ClassDiagram
	Dim Found As Boolean
	Found = False

	For i% = 1 To TheUseCase.ClassDiagrams.Count
		Set TheClassDiagram = TheUseCase.ClassDiagrams.GetAt(i%)
		If TheClassDiagram.Name = TheDiagramName Then
			Found = True
			Exit For
		End If
	Next i%

	If Not Found Then
		Set TheClassDiagram = TheUseCase.AddClassDiagram(TheDiagramName)
	End If

	Dim ExistingClasses As ClassCollection
	Set ExistingClasses = TheClassDiagram.GetClasses()
	
	Dim aClass As Class
	For i% = 1 To TheClasses.Count
		Set aClass = TheClasses.GetAt(i%)
		If Not ExistingClasses.Exists(aClass) Then
			Added = TheClassDiagram.AddClass (aClass)
		End If
	Next i%

	TheClassDiagram.Layout
	MsgBox TheDiagramName & " built under use Case " & TheUseCase.Name
End Sub

Sub Main ()
	Dim ucList As UseCaseCollection
	Set ucList = RoseApp.CurrentModel.GetSelectedUseCases

	If ucList.Count = 0 Then
		MsgBox "No use case is selected", ebOkOnly, "VOPC"
	Else
		GetUserPreferences "VOPC"

		Viewport.Open
		Viewport.Clear

		For i% = 1 To ucList.Count
			BuildClassDiagram ucList.getAt(i%), TheDiagramName
		Next i%
	End If
End Sub