View this PageEdit this PageAttachments to this PageHistory of this PageHomeRecent ChangesSearch the SwikiHelp Guide
Hotspots: Admin Pages | Turn-in Site |
Current Links: Cases Final Project Summer 2007

Scott M1

Object subclass: #Family
	instanceVariableNames: 'father mother children '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm1'!
!Family commentStamp: 'tss 9/5/2002 06:11' prior: 0!
Family represents a family of two parents and their natural children.

The parents are kept in instance variables and the children in a collection.!


!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:49'!
addChild: child
	"This adds a child to the family
	expects Person"
	children ifNil: [children _ IdentitySet new.].
	children add: child.! !

!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:49'!
addParent: parent
	"adds a parent to the family.  
	Father or mother is discovered through the parents gender."
	(parent isFemaleGender) ifTrue: [self mother: parent] ifFalse: [self father: parent].! !

!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:49'!
addParent: parent1 and: parent2
	"This adds both the parents to a family.  
	Mother father is determined by the parent's gender."
	(parent1 isFemaleGender) ifTrue: [self mother: parent1. self father: parent2] ifFalse: [self father: parent1. self mother: parent2.].! !

!Family methodsFor: 'accessors' stamp: 'tss 9/1/2002 18:44'!
children
	^ children.! !

!Family methodsFor: 'accessors' stamp: 'tss 9/1/2002 18:41'!
father
	^ father.! !

!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:50'!
father: newFather
	"assigns the father.  
	Takes a person object."
	father _ newFather.! !

!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:50'!
hasParent: parent
	"returns true if the passed in parent is a 
	parent in this famiyl object."
	^ ( (father == parent) or: [mother == parent] ).! !

!Family methodsFor: 'accessors' stamp: 'tss 9/1/2002 18:42'!
mother
	^ mother.! !

!Family methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:50'!
mother: newMother
	"assigns the mother.  
	Takes in a Person object."
	mother _ newMother.! !


!Family methodsFor: 'familySelectors' stamp: 'tss 9/5/2002 06:50'!
hasChild: child
	"returns weather this family has this child in it.
	Expects Person"

	children ifNil: [^ false.] ifNotNil:[^children includes: child.].! !

!Family methodsFor: 'familySelectors' stamp: 'tss 9/5/2002 06:51'!
mergeWith: family
	"merges the information in the given family into me.
	Expects a Family object."

	father ifNil: [father _ family father].
	mother ifNil: [mother _ family mother].
	children addAll: family children.! !


!Family methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:51'!
fixGender
	"examines the genders of the mother and father 
	and assuers the mother is female."

	| realMom |
	mother isFemaleGender ifFalse: [ realMom _ father. father _ mother. mother _ realMom]! !


Object subclass: #Marriage
	instanceVariableNames: 'man woman marriedDate divorcedDate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm1'!
!Marriage commentStamp: 'tss 9/5/2002 06:12' prior: 0!
Marriage keeps track of the information for a single marriage between a man and a woman.

It keeps track of the date they were married and the date they were divorced and the people objects to whom they reference.!


!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 20:06'!
divorcedOn
	^ divorcedDate.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:48'!
divorcedOn: date
	"assigns the divorce date.  
	Takes in a Date object"
	divorcedDate _ date.
	^ divorcedDate.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:48'!
fixGender
	"This examines the man and woman in the 
	marriage to make sure their gender is correct."
	| realWoman |
	woman isFemaleGender ifFalse: [ realWoman _ man. man _ woman. woman _ realWoman]! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:49'!
hasSpouse: spouse
	"returns true if the passed in person object is 
	present as the man or woman in this marriage"
	^ (spouse == man) or: [spouse == man].! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:49'!
hasSpouses: spouse1 and: spouse2 on: date
	"works like and = predicate.  Returns true if the 
	data passes in is = to the data in the marriage"
	^ ( (spouse1 == man) or: [spouse2 == man] ) and: [ (spouse1 == woman) or: [spouse2 == woman] ] 
		and: [ date = marriedDate ].! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 19:46'!
man
	^man.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:49'!
man: newMan
	"Assigns the man.  
	Takes in a Person object."
	man _ newMan.
	^newMan.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 20:06'!
marriedOn
	^ marriedDate.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:49'!
marriedOn: date
	"Sets the date the marriage took place on.  
	accepts a Date object"
	marriedDate _ date.
	^ marriedDate.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 19:47'!
woman
	^woman.! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 9/5/2002 06:49'!
woman: newWoman
	"Sets the woman object.  
	Accepts a Person object."
	woman _ newWoman.
	^newWoman.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Marriage class
	instanceVariableNames: ''!

!Marriage class methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 21:28'!
marry: person1 with: person2 on: date
	| marriage |
	marriage _ Marriage new.
	marriage marriedOn: date.
	(person1 isFemaleGender) ifTrue: [marriage woman: person1. marriage man: person2.]
		ifFalse: [marriage woman: person2. marriage man: person1.].
	^ marriage.! !

!Marriage class methodsFor: 'as yet unclassified' stamp: 'tss 9/3/2002 21:28'!
marry: person1 with: person2 on: date divorcedOn: divorceDate
	| marriage |
	marriage _ Marriage new.
	marriage marriedOn: date.
	marriage divorcedOn: divorceDate.
	(person1 isFemaleGender) ifTrue: [marriage woman: person1. marriage man: person2.]
		ifFalse: [marriage woman: person2. marriage man: person1.].
	^ marriage.! !


Object subclass: #Person
	instanceVariableNames: 'givenName surName isFemale aliases familialRelationships marriageRelationships bornDate bornLocation deathDate miscRecords '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm1'!
!Person commentStamp: 'tss 9/5/2002 06:16' prior: 0!
Person keeps the following information for a person:
given name, surname, gender, any aliases the person may have,
relationships between siblings and parents through a collection
of fmaily objects, marriages through a collection of marriage objects,
Birthdate, birth location, death date, and misc information in the form
of a key and an assosicated value like social security number is 123-45-6789.

A person can also visualize themself using the visualize command.   This is
done through a morphicRectangle.!


!Person methodsFor: 'init' stamp: 'tss 9/2/2002 00:19'!
initialize
	"***NOT CURRENTLY USED***
	initializes collections with new bag objects"
	familialRelationships = IdentitySet new.! !


!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:23'!
addAlias: alias
	"Adds an alias to this person.
	The alias is stored an idenity set.
	Accepts a String."
	aliases ifNil: [aliases _ IdentitySet new.].
	aliases add: alias.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:24'!
addFamilialRelationships: family
	"Adds a family relationship.
	Accepts a Family object.
	The inputed family is added to the collection."
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].
	familialRelationships add: family.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:25'!
addFamily: family
	"Adds a family relationship.
	Accepts a Family object.
	The inputed family is added to the collection."
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].
	familialRelationships add: family.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:25'!
addMarriage: marriage
	"Adds a marriage relationship.
	Accepts a Marriage object.
	The inputed marriage is added to the collection."
	marriageRelationships ifNil: [marriageRelationships _ IdentitySet new.].
	marriageRelationships add: marriage.
	^ Marriage.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:40'!
aliases
	^ aliases.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:26'!
born: date location: location
	"sets the date and location born for me.
	accepts a Date for the date.
	accepts a string for the location."
	self bornDate: date.
	self bornLocation: location.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:44'!
bornDate
	^ bornDate.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:26'!
bornDate: date
	"assings the date born.
	expects a Date object."
	bornDate _ date.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:44'!
bornLocation
	^ bornLocation.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:26'!
bornLocation: location
	"assigns the location of birth.
	Expects a String."
	bornLocation _ location.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:45'!
deathDate
	^ deathDate.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:27'!
deathDate: date
	"Assigns the date I died.
	Expects a Date."
	deathDate _ date.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:27'!
died: date
	"Same as deathDate.
	Assigns the deathDate.
	Expects a Date."
	self deathDate: date.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:31'!
drawOn: aForm at: aPoint
	"Draws a representation of the person on the given form at the given point.
	It uses the graphics classes from MCV.
	Mostly utilizes Pen and Strings display methods."

	| pen drawColor yOffset aliasesString|
	pen _ Pen newOnForm: aForm.

	"Get the right color for my gender"
	self isFemaleGender ifTrue: [drawColor _ Color red] ifFalse: [drawColor _ Color blue].

	"'Put the pen where I am supposed to be"
	pen location: aPoint direction: 90 penDown: true; color: drawColor.

	"Display given name"
	"givenName displayOn: aForm at: aPoint textColor: drawColor."
	((givenName asDisplayText) foregroundColor: drawColor backgroundColor: Color black)
		displayOn: aForm at: (aPoint x + 2)@(aPoint y).

	"display sur name"
	((surName asDisplayText) foregroundColor: drawColor backgroundColor: Color black)
		displayOn: aForm at: (aPoint x + 2)@((aPoint y)+14).
	
	"set up the vertical offset counter."
	yOffset _ 28.

	"display any aliases"
	aliases ifNotNil: [aliasesString _ 'AKA: '. aliases do: [: alias | aliasesString _ aliasesString,alias,' '.].
		((aliasesString asDisplayText) foregroundColor: drawColor backgroundColor: Color black) 
		displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset). yOffset _ yOffset + 14].

	"display my birth information"
	bornDate ifNotNil: [((('Born: ',bornDate asString) asDisplayText) foregroundColor: drawColor 
		backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset).
		yOffset _ yOffset + 14].
	bornLocation ifNotNil: [ ((bornLocation asDisplayText) foregroundColor: drawColor 
		backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset).
		yOffset _ yOffset + 14].

	"display death information"
	deathDate ifNotNil: [((('Died: ',deathDate asString) asDisplayText) foregroundColor: drawColor 
		backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset).
		yOffset _ yOffset + 14].

	"display marriage information"
	marriageRelationships ifNotNil: [marriageRelationships do: [: marriage | (((marriage man givenName,' ',marriage man surName,' married ') asDisplayText) foregroundColor: drawColor backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset).(((' ',marriage woman givenName,' ',marriage woman surName) asDisplayText) foregroundColor: drawColor backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset+14). yOffset _ yOffset + 28. marriage marriedOn ifNotNil: [(((' on ',marriage marriedOn asString) asDisplayText) foregroundColor: drawColor backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset). yOffset _ yOffset + 14]. marriage divorcedOn ifNotNil: [(((' ended on ',marriage divorcedOn asString) asDisplayText) foregroundColor: drawColor backgroundColor: Color black) displayOn: aForm at: (aPoint x + 2)@((aPoint y)+yOffset). yOffset _ yOffset + 14]]].
	

	"Draw my border box"
	pen go: 100; turn: -90.
	pen go: 140; turn: -90.
	pen go: 100; turn: -90.
	pen go: 140; turn: -90.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/2/2002 01:14'!
familialRelationships
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].
	^ familialRelationships.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:36'!
givenName
	^ givenName.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:31'!
givenName: newGivenName
	"Assign the given name.
	accepts a String."
	givenName _ newGivenName.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:32'!
hasChild: child with: partner
	"Sets up family information for having a child with this partner.
	accepts two Person objects."
	| familyChild familyParents |
	
	"if not initalized, initalize family container"
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].

	"Get refrence to any family that child is a child in"
	familyChild _ (child familialRelationships) detect: [:elem| elem hasChild: child.] ifNone: [familyChild _ nil.].
	"Get refrence to any family that parents are parents together in"
	familyParents _ familialRelationships detect: [:elem| (elem hasParent:self) and: [elem hasParent:partner]]
		ifNone: [familyParents _ nil.].

	"if child is not a child in a family and the parents are not parents together"
	( (familyChild isNil) and: [familyParents isNil] ) ifTrue:
		[familyChild _ Family new.
		familyChild addChild: child.
		familyChild addParent: self and: partner.
		self addFamily: familyChild.
		partner addFamily: familyChild.
		child addFamily: familyChild.
		^ familyChild.].

	"if child is a child in a family but parents are not"
	( ((familyChild isNil) not) and: [familyParents isNil] ) ifTrue:
		[familyChild addParent: self and: partner. self addFamily: familyChild.
			partner addFamily: familyChild. ^ familyChild.].

	"if child is not a child in a family and the parents are parents together"
	( ((familyParents isNil) not) and: [familyChild isNil] ) ifTrue:
		[familyParents addChild: child. child addFamily: familyParents. ^ familyParents.].
	
	"If child is a child in a family and parents are parents together in a family"
	( ((familyChild isNil) not) and: [(familyParents isNil) not] ) ifTrue:
		[(familyChild == familyParents)
			ifTrue: [^familyChild] "Nothing to do... Family object already had the data"
			ifFalse: 
				[familyParents mergeWith: familyChild.
				(familyChild children) do:
					[: childElem | 
					childElem removeFamilialRelationship: familyChild.
					childElem addFamily: familyParents].
				^ familyParents.]
		].! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:33'!
hasFather: dad
	"Assigns father.
	accepts a person object."

"***WARNING***
If I already have a father, I will change my father to dad but my old father
will still have a renfrence to my family object!!"

	| familySelf familyParents mom |

	"if not initalized, initalize family container"
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].
	
	"Get refrence to childs/selfs family"
	familySelf _ familialRelationships detect: [:elem| elem hasChild: self.] ifNone: [familySelf _ nil.].

	"if I have no family"
	familySelf ifNil: [familySelf _ Family new. familySelf addChild: self.  familySelf father: dad.
		self addFamily: familySelf.  dad addFamily: familySelf. ^ familySelf.].

	"If i don't know who my mother is"
	(familySelf mother) ifNil: [familySelf father: dad.  dad addFamily: familySelf. ^ familySelf].

	"get a reference to my parents other family"
	mom _ (familySelf mother). "for efficiency"
	familyParents _ (dad familialRelationships) detect: 
		[:elem| (elem hasParent:mom) and: [elem hasParent: dad]] ifNone: [familyParents _ nil.].

	"If my parents don't have anyother families defined"
	familyParents ifNil: [familySelf father: dad.  dad addFamily: familySelf. ^ familySelf].

	"If my parents do have another family"
	familyParents mergeWith: familySelf.
	self addFamily: familyParents.
	self removeFamilialRelationship: familySelf.
	mom removeFamilialRelationship: familySelf.
	^ familyParents.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:33'!
hasMother: mom
	"assigns mother.
	expects person object."
 
"***WARNING***
If I already have a mother, I will change my mother to mom but my old mother
will still have a renfrence to my family object!!"

	| familySelf familyParents dad |

	"if not initalized, initalize family container"
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].
	
	"Get refrence to childs/selfs family"
	familySelf _ familialRelationships detect: [:elem| elem hasChild: self.] ifNone: [familySelf _ nil.].

	"if I have no family"
	familySelf ifNil: [familySelf _ Family new. familySelf addChild: self.  familySelf mother: mom.
		self addFamily: familySelf.  mom addFamily: familySelf. ^ familySelf.].

	"If i don't know who my father is"
	(familySelf father) ifNil: [familySelf mother: mom.  mom addFamily: familySelf. ^ familySelf].

	"get a reference to my parents other family"
	dad _ (familySelf father). "for efficiency"
	familyParents _ (mom familialRelationships) detect: 
		[:elem| (elem hasParent:mom) and: [elem hasParent: dad]] ifNone: [familyParents _ nil.].

	"If my parents don't have anyother families defined"
	familyParents ifNil: [familySelf mother: mom.  mom addFamily: familySelf. ^ familySelf].

	"If my parents do have another family"
	familyParents mergeWith: familySelf.
	self addFamily: familyParents.
	self removeFamilialRelationship: familySelf.
	dad removeFamilialRelationship: familySelf.
	^ familyParents.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:34'!
hasSibling: sibling
	"Sets up family information for havein given person as my sibling.
	expects a Person object"

	| familySelf familySibling |

	"Make sure family container is initalized"
	familialRelationships ifNil: [familialRelationships _ IdentitySet new.].

	"get refrences to the families that these two are children in"
	familySelf _ familialRelationships detect: [:elem| elem hasChild: self.] ifNone: [familySelf _ nil.].
	familySibling _ (sibling familialRelationships) detect: [:elem| elem hasChild: sibling.] 
		ifNone: [familySibling _ nil.].

	"if neither person is a child in a family"
	( (familySelf isNil) and: [familySibling isNil] ) ifTrue:
		[familySelf _ Family new.
		familySelf addChild: self.
		familySelf addChild: sibling.
		self addFamily: familySelf.
		sibling addFamily: familySelf.
		^ familySelf.].

	"if i have a family but my sibling doesn't"
	( ((familySelf isNil) not) and: [familySibling isNil] ) ifTrue:
		[familySelf addChild: sibling. sibling addFamily: familySelf. ^ familySelf.].

	"if my sibling has a family but i don't"
	( ((familySibling isNil) not) and: [familySelf isNil] ) ifTrue:
		[familySibling addChild: self. self addFamily: familySibling. ^ familySibling.].
	
	"If we are both children in families"
	( ((familySibling isNil) not) and: [(familySelf isNil) not] ) ifTrue:
		[(familySibling == familySelf)
			ifTrue: [^familySelf]
			ifFalse: 
				[familySelf mergeWith: familySibling.
				(familySibling children) do:
					[: child | 
					child removeFamilialRelationship: familySibling.
					child addFamily: familySelf].
				(familySibling father) ifNotNil: 
					[(familySibling father) removeFamilialRelationship: familySibling. 
					(familySibling father) addFamily: familySelf.].
				(familySibling mother) ifNotNil: 
					[(familySibling mother) removeFamilialRelationship: familySibling. 
					(familySibling mother) addFamily: familySelf.].
				^ familySelf.]
		].
	! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:34'!
isFemale
	"*ASSIGNES* gender to female.
	for testing for gender see isFemaleGender message."

	isFemale _ true.
	marriageRelationships ifNotNil: [ marriageRelationships do: [:marriage| marriage fixGender]].
	familialRelationships ifNotNil: [ familialRelationships do: [:family| (family hasParent: self) ifTrue: 
		[family fixGender]]].! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:35'!
isFemaleGender
	"returns true if person is female.
	returns false if unknown."
	isFemale ifNil: [isFemale _ false].
	^ isFemale.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:36'!
isMale
	"*ASSIGNES* gender to male.
	for testing for gender see isFemaleGender message."

	isFemale _ false.
	marriageRelationships ifNotNil: [ marriageRelationships do: [:marriage| marriage fixGender]].
	familialRelationships ifNotNil: [ familialRelationships do: [:family| (family hasParent: self) ifTrue: 
		[family fixGender]]].! !

!Person methodsFor: 'accessors' stamp: 'tss 9/3/2002 19:38'!
marriageRelationships
	marriageRelationships ifNil: [marriageRelationships _ IdentitySet new.].
	^ marriageRelationships.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:37'!
married: spouse on: marriageDate
	"sets up a marriage between me and the given spouse in the given day.
	expects a Person and a Date.
	It is assumed that I will not marry the same person twice in the same day"
	
	| existingMarriage newMarriage|

	"See if this marriage already exists"
	existingMarriage _ (self marriageRelationships) detect: 
		[:marriage | marriage hasSpouses: self and: spouse on: marriageDate] ifNone: [existingMarriage _ nil].
		
	"If this marriage already exists"
	existingMarriage ifNotNil: [^ existingMarriage].

	"If this is a new marriage"
	newMarriage _ Marriage marry: self with: spouse on: marriageDate.
	self addMarriage: newMarriage.
	spouse addMarriage: newMarriage.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:38'!
married: spouse on: marriageDate divorced: divorcedDate
	"sets up a marriage between me and the given spouse in the given day.
	and our divorce day.
	expects a Person and a Date and a date.
	It is assumed that I will not marry the same person twice in the same day"
	
	| existingMarriage newMarriage|

	"See if this marriage already exists"
	existingMarriage _ (self marriageRelationships) detect: 
		[:marriage | marriage hasSpouses: self and: spouse on: marriageDate] ifNone: [existingMarriage _ nil].
		
	"If this marriage already exists"
	existingMarriage ifNotNil: [existingMarriage divorcedOn: divorcedDate. ^ existingMarriage].

	"If this is a new marriage"
	newMarriage _ Marriage marry: self with: spouse on: marriageDate divorcedOn: divorcedDate.
	self addMarriage: newMarriage.
	spouse addMarriage: newMarriage.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:45'!
miscRecords
	^ miscRecords.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:39'!
record: objKey as: objValue
	"records misc data in the form of a key and a value.
	common usage is two strings, but any pair of objects will do."

	miscRecords ifNil:[miscRecords _ Dictionary new].
	miscRecords add: (Association key: objKey value: objValue).! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:39'!
removeFamilialRelationship: family
	"remove the family relationship that is == to the one specified.
	expects a Family object."
	familialRelationships ifNotNil: [familialRelationships remove: family ifAbsent: [^false]].! !

!Person methodsFor: 'accessors' stamp: 'tss 9/1/2002 16:37'!
surName
	^ surName.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:40'!
surName: newSurName
	"assigns my sur name.
	expects a string."

	surName _ newSurName.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/5/2002 06:45'!
visualize
	"Visualizes all of my ancestors, descendants and spouses
	returns debugging object
	displays information in a morphic rectangle"

	| imageMorph form deepUp deepDown generations xOffset genCount totalGen myChildren spouseSet locationDict pen|

	"determine the total height of the familly tree."
	deepUp _ self howDeepUp.
	deepDown _ self howDeepDown.

	"get generation collection init"
	generations _ OrderedCollection new.
	totalGen _ deepUp + deepDown - 1.
	totalGen timesRepeat: [generations add: OrderedCollection new].

	"go up and down the family tree adding in the appropriate people to
	their respective generations"
	self addToGenUp: generations depth: deepDown.
	myChildren _ IdentitySet new.
	familialRelationships do: [:elem| ((elem hasParent: self) and: [(elem children isNil) not]) 
		ifTrue: [myChildren addAll: elem children]].
	myChildren do:[: child | child addToGenDown: generations depth: deepDown - 1].

	"Get all spouses and partners with whom i have children into my generation"
	spouseSet _ IdentitySet new.
	familialRelationships ifNotNil: [familialRelationships do: [:elem| (elem hasParent:self) ifTrue: 
		[self isFemaleGender ifTrue: [elem father ifNotNil: [spouseSet add: elem father]] 
		ifFalse:[elem mother ifNotNil: [spouseSet add: elem mother]]]]].
	marriageRelationships ifNotNil: [marriageRelationships do: [:elem| (elem hasSpouse: self) ifTrue: 
		[self isFemaleGender ifTrue: [elem man ifNotNil: [spouseSet add: elem man]] 
		ifFalse:[elem woman ifNotNil: [spouseSet add: elem woman]]]]].
	(generations at:deepDown) addAll: spouseSet.

	"init the form to draw on"
	form _ Form extent: 800@600 depth: Display depth.
	form fillBlack"; displayAt:0@0".

	"Put the key at the bottom of the form."
	(('Key:' asDisplayText) foregroundColor: Color black backgroundColor: Color white)
		displayOn: form at: (400)@(580).
	(('Male Person' asDisplayText) foregroundColor: Color blue backgroundColor: Color black)
		displayOn: form at: (430)@(580).
	(('Female Person' asDisplayText) foregroundColor: Color red backgroundColor: Color black)
		displayOn: form at: (505)@(580).
	(('Father of' asDisplayText) foregroundColor: Color white backgroundColor: Color black)
		displayOn: form at: (590)@(580).
	(('Mother of' asDisplayText) foregroundColor: Color yellow backgroundColor: Color black)
		displayOn: form at: (650)@(580).
	(('Spouse' asDisplayText) foregroundColor: Color orange backgroundColor: Color black)
		displayOn: form at: (715)@(580).

	"Draw all the people objects to the screen and store their locations"
	locationDict _ IdentityDictionary new.
	genCount _ 1.
	generations do: [: gen | xOffset _ 2. gen do: [: person | person drawOn: form at:  
		(xOffset)@(((totalGen-genCount)*110) + 2). locationDict 
		add: (Association key: person value: (xOffset)@(((totalGen-genCount)*110) + 2)).
		xOffset _ xOffset + 150]. 
		genCount _ genCount + 1].

	"draw all the connecting lines"
	pen _ Pen newOnForm: form.
	locationDict keysAndValuesDo: [: key :value | 
		pen color: Color orange; down.
		key marriageRelationships ifNotNil: [key marriageRelationships do: [:elem| (key isFemaleGender) 
			ifTrue: [locationDict at: (elem man) ifPresent: [:dest| pen place: value;goto: dest.]]]].
		key familialRelationships ifNotNil: [key familialRelationships do: [:elem| (elem hasParent:key) 
			ifTrue: [(key isFemaleGender) ifTrue: [elem father ifNotNil:[locationDict at: (elem father)
			ifPresent: [:dest| pen place: value;goto: dest.]]]]]].
		key familialRelationships ifNotNil: [key familialRelationships do: [:elem| (elem hasParent:key) 
			ifTrue: [elem children do: [:child|
			(key isFemaleGender) ifTrue: [pen color: Color yellow] ifFalse: [pen color: Color 
			white]. locationDict at: (child) ifPresent: [:dest| pen  place: value;goto: dest.]] ]]].
		].
	
	"create the morph to place the form in and init it"
	imageMorph _ ImageMorph new initialize.
	imageMorph setNewImageFrom: form.
	imageMorph openInWorld.

	^ locationDict.! !


!Person methodsFor: 'gui' stamp: 'tss 9/5/2002 06:48'!
addToGenDown: generations depth: depth
	"Goes down the family tree.
	adds the appropriate people in to their respective generations"

	| myChildren |
	(generations at: depth) addLast: self.
	familialRelationships ifNil: [^ depth].
	myChildren _ IdentitySet new.
	familialRelationships do: [:elem| ((elem hasParent: self) and: [(elem children isNil) not]) 
		ifTrue: [myChildren addAll: elem children]].
	myChildren do: [: child | child addToGenDown: generations depth: depth - 1].! !

!Person methodsFor: 'gui' stamp: 'tss 9/5/2002 06:47'!
addToGenUp: generations depth: depth
	"goes up the family tree and adds in the 
	appropriate people to their specified generation"
	| family |
	(generations at: depth) addLast: self.
	familialRelationships ifNil: [^ depth].
	family _ familialRelationships detect: [:elem| elem hasChild: self.]
		ifNone: [family _ nil].
	family ifNil: [^ depth].
	family mother ifNotNil: [family mother addToGenUp: generations depth: depth + 1].
	family father ifNotNil: [family father addToGenUp: generations depth: depth + 1].! !

!Person methodsFor: 'gui' stamp: 'tss 9/5/2002 06:46'!
howDeepDown
	"returns how deep the tree is going to youngest
	returns integer"
	| myChildren deepest curr|
	familialRelationships ifNil: [^ 1].
	myChildren _ IdentitySet new.
	familialRelationships do: [:elem| ((elem hasParent: self) and: [(elem children isNil) not]) 
		ifTrue: [myChildren addAll: elem children]].
	deepest _ 0.
	myChildren do: [: child | curr _ child howDeepDown. (curr > deepest) ifTrue: [deepest _ curr]].
	^ deepest + 1.! !

!Person methodsFor: 'gui' stamp: 'tss 9/5/2002 06:46'!
howDeepUp
	"returns how deep the tree is going to oldest
	returns integer"
	| family mom dad |
	familialRelationships ifNil: [^ 1].
	family _ familialRelationships detect: [:elem| elem hasChild: self.] ifNone: [family _ nil.].
	family ifNil: [^ 1].
	((family mother isNil) and: [family father isNil]) ifTrue: [^ 1].
	family mother ifNotNil: [mom _ family mother howDeepUp]  ifNil: [mom _ 0].
	family father ifNotNil: [dad _ family father howDeepUp] ifNil: [dad _ 0].
	(mom > dad) ifTrue: [^ mom + 1].
	^ dad + 1.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Person class
	instanceVariableNames: ''!


Link to this Page