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

Monkeys with Vertigo M2

Object subclass: #CheckResults
	instanceVariableNames: 'noGivenName noSurName noGender noBornDate noBornLocation noDeathDate noDeathLocation hasChildNotMarried badDateMarriage badDateDivorce badDateBorn badDateFather badDateMother wrongGender noFather noMother '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm2'!
!CheckResults commentStamp: '' prior: 0!
An instance of this object holds all the results from a check call on a person.
There is an identity set for each type of missing or incorrect vital information
in a person.  As this object is passed around a family tree, people who meet the
missing information or incorrect information critera for any one category add
themselves to the appropriate instance variable.

At any time, most commonly after a complete relative check, the intance method
nicleyFormattingStringFor with the paramter of the person to who this class has the
information for is called to return a nicely "formating" string explaning what
information is missing or incorrect and where one might go to fix these problems.!


!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:02'!
badDateBorn: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	badDateBorn add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:02'!
badDateDivorce: marriage
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	badDateDivorce add: marriage
	! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:02'!
badDateFather: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	badDateFather add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:02'!
badDateMarriage: marriage
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	badDateMarriage add: marriage! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
badDateMother: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	badDateMother add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
hasChildNotMarried: family
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	hasChildNotMarried add: family! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/15/2002 15:24'!
initialize
	"Initalizes instance variables.
	Creates new identity sets for them."

	| |
	
	noGivenName _ IdentitySet new.
	noSurName  _ IdentitySet new.
	noGender  _ IdentitySet new.
	noBornDate  _ IdentitySet new.
	noBornLocation  _ IdentitySet new.
	noDeathDate  _ IdentitySet new.
	noDeathLocation  _ IdentitySet new.
	hasChildNotMarried  _ IdentitySet new.
	badDateMarriage  _ IdentitySet new.
	badDateDivorce _ IdentitySet new.
	badDateBorn  _ IdentitySet new.
	badDateFather  _ IdentitySet new.
	badDateMother _ IdentitySet new.
	wrongGender _ IdentitySet new.
	noFather _ IdentitySet new.
	noMother _ IdentitySet new.! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'TEO 9/16/2002 17:03'!
nicelyFormatingStringFor: person
	"returns a nicely formating string.
	the string lists categories for missing vital information
	and incorrect information and the offenders there in."

	| returnString |
	returnString _ 'Below is the missing vital information for ', person givenName, ' ',
		person surName, ' and '.
	person isFemaleGender ifTrue: [returnString _ returnString,'her'] 
		ifFalse: [returnString _ returnString,'his'].
	returnString _ returnString,' relatives.

'.


	"People Sets"

	returnString _ returnString,'Naming Problems:
'.
	noGivenName do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no given name!!
'].
	noSurName do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no sur name!!
'].

returnString _ returnString,'
Gender Problems:
'.
	noGender do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no gender!!
'].
	wrongGender do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' Appears to be the wrong gender in one or more relationships!!
'].

returnString _ returnString,'
Birth and Death Problems:
'.
	noBornDate do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no born date!!
'].
	noBornLocation do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no born location!!
'].
	noDeathDate do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no death date!!
'].
	noDeathLocation do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no death location!!
'].
	badDateBorn do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' died before birth!!
'].
	badDateFather do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		'''s father died more than nine months before their birth!!
'].
	badDateMother do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		'''s mother died before they were born!!
'].

	"Person Sets"
returnString _ returnString,'
Parental Problems:
'.

noMother do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no mother!!
'].
noFather do: [:elem| returnString _ returnString,elem givenName, ' ', elem surName,
		' has no father!!
'].

	"Family Sets"
returnString _ returnString,'
Mariatal Problems:
'.
	hasChildNotMarried do: [:elem| returnString _ returnString,elem father givenName, ' ', 
		elem father surName, ' and ',elem mother givenName, ' ', elem mother surName,
		' have children but aren''t married!!
'].

	"Marriage Sets"
	badDateMarriage do: [:elem| returnString _ returnString,elem man givenName, ' ', 
		elem man surName, ' and ',elem woman givenName, ' ', elem woman surName,
		' were married when at least one of them were not alive!!
'].

	badDateDivorce do: [:elem| returnString _ returnString,elem man givenName, ' ', 
		elem man surName, ' and ',elem woman givenName, ' ', elem woman surName,
		' were divorced when at least one of them were not alive!!
'].

returnString _ returnString,'
Some nice websites for searching for information
to fill out this family''s vital information include:
 http://www.ancestry.com 
 http://www.rootsweb.com 
 http://www.genealogy.com 
 http://www.mytrees.com 
 http://genealogy.about.com
'.
	
	"Return the nicely formating string"
	^ returnString.! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noBornDate: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noBornDate add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noBornLocation: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noBornLocation add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noDeathDate: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noDeathDate add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noDeathLocation: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noDeathLocation add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noFather: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noFather add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noGender: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noGender add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noGivenName: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noGivenName add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noMother: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noMother add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
noSurName: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	noSurName add: person! !

!CheckResults methodsFor: 'as yet unclassified' stamp: 'tss 9/18/2002 16:03'!
wrongGender: person
	"Adds the paramter to the IdentitySet.
	The IdentitySet is an instance variable."
	wrongGender add: person! !

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

CheckResults class
	instanceVariableNames: ''!

!CheckResults class methodsFor: 'as yet unclassified' stamp: 'tss 9/14/2002 17:51'!
new
	"Create New CheckResults instance.
	and initalize instance variables."

	| temp |
	temp := super new.
	temp initialize.
	^temp.! !


Object subclass: #Family
	instanceVariableNames: 'father mother children '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm2'!
!Family commentStamp: '' 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]! !


!Family methodsFor: 'init' stamp: 'TEO 9/13/2002 16:49'!
initialize
	"comment stating purpose of message"

	children := IdentitySet new.! !

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

Family class
	instanceVariableNames: ''!

!Family class methodsFor: 'as yet unclassified' stamp: 'TEO 9/13/2002 16:50'!
new
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp initialize.
	^ temp.! !


Object subclass: #Marriage
	instanceVariableNames: 'man woman marriedDate divorcedDate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm2'!
!Marriage commentStamp: '' 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/15/2002 01:55'!
hasSpouses: spouse1 and: spouse2
	"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] ].! !

!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 deathLocation miscRecords '
	classVariableNames: 'AllPersons '
	poolDictionaries: ''
	category: 'm2'!
!Person commentStamp: '' 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/15/2002 00:08'!
initialize
	givenName := String new.
	surName := String new.
	aliases := IdentitySet new.
	familialRelationships := IdentitySet new.
	marriageRelationships := IdentitySet new.
	bornLocation := String new.
	miscRecords := Dictionary 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/14/2002 22:18'!
deathLocation
	"returns death location
	returns a string"

	| |
	^ deathLocation.! !

!Person methodsFor: 'accessors' stamp: 'tss 9/14/2002 22:18'!
deathLocation: location
	"sets death location
	expects a string"

	| |
	deathLocation _ location.! !

!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/14/2002 22:19'!
died: date location: location
	"Same as deathDate. & deathLocation
	Assigns the deathDate. & deathLocation
	Expects a Date. & a string"
	self deathDate: date.
	self deathLocation: location.! !

!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 methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:49'!
searchDown: query useIfTrue: matchSet
	"searches self and children,
	 passing the query and matchSet object"

	self searchSelf: query useIfTrue: matchSet.
	familialRelationships do: [ :family |
		( (self = family father) or: [self = family mother]) ifTrue: [
			family children do: [ :child | child searchDown: query useIfTrue: matchSet ]
		]
	].! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:50'!
searchDown: query useIfTrue: matchSet cycleCheck: beenThere
	"calls search on self and children.  Does this only if self has not been searched, as
	 checked by the beenThere object which contains all Persons that have been searched
	 (successful match or not), passing the query and matchSet object"

	(beenThere includes: self) ifFalse: [
		beenThere add: self.
		self searchSelf: query useIfTrue: matchSet.
		familialRelationships do: [ :family |
			( family hasParent: self ) ifTrue: [
				family children do: [ :child | 
					child searchDown: query useIfTrue: matchSet cycleCheck: beenThere
				]
			]
		]
	].! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:32'!
searchFor: query
	"accepts a Query object and call search on self as well as up the tree and down the tree
	 returns an IdentitySet of Persons that match the query"

	| matchSet |
	matchSet := IdentitySet new.
	
	"handles self and siblings and up"
	self searchUp: query useIfTrue: matchSet cycleCheck: IdentitySet new. 

	"handles self and children"
	self searchDown: query useIfTrue: matchSet cycleCheck: IdentitySet new. 	
	^matchSet.! !

!Person methodsFor: 'queries' stamp: 'TEO 9/18/2002 17:32'!
searchSelf: query useIfTrue: matchSet
	"compares Query object passed in to self.  
	 adds self to matchSet if self matches with the query.
	 assumes only one field in query is not nil.
	 if any field matches, the comparison is a success.
	"
	
	| trueBlock |
	trueBlock := [ matchSet add: self. ^true ].

	"checks given name"
	query givenName ifNotNil: [
		( query givenName = givenName ) ifTrue: trueBlock
	].

	"checks sur name"
	query surName ifNotNil: [
		( query surName = surName ) ifTrue: trueBlock
	].

	"checks maleness"
	query isMaleGender ifNotNil: [
		( query isMaleGender = (isFemale ifNil: [nil] ifNotNil: [isFemale not]) ) ifTrue: trueBlock
	].

	"checks femaleness"
	query isFemaleGender ifNotNil: [
		( query isFemaleGender = isFemale ) ifTrue: trueBlock
	].

	"checks for alias"
	query hasAlias ifNotNil: [
		aliases ifNotNil: [ ( aliases includes: query hasAlias ) ifTrue: trueBlock ]
	].

	"checks for sibling"
	query hasSibling ifNotNil: [
		self familialRelationships do: [ :family |
			((family hasChild: self) 
				and: [family hasChild: query hasSibling]
				and: [ (self == query hasSibling) not ]
			)
				ifTrue: trueBlock 
		]
	].

	"checks for parent"
	query hasParent ifNotNil: [
		self familialRelationships do: [ :family | 
			( (family hasChild: self) and: [family hasParent: query hasParent] )
				 ifTrue: trueBlock 
		]
	].

	"checks for child"
	query hasChild ifNotNil: [
		self familialRelationships do: [ :family |
			( (family hasParent: self ) and: [ family hasChild: query hasChild ] )
				ifTrue: trueBlock
		]
	].

	"checks spouse"
	query married ifNotNil: [
		self marriageRelationships do: [ :marriage |
			( marriage hasSpouses: self and: query married ) ifTrue: trueBlock
		]
	].

	"checks birth date"
	query born ifNotNil: [
		(query born = self bornDate) ifTrue: trueBlock
	].

	"checks birth location"
	query bornIn ifNotNil: [
		(query bornIn = self bornLocation) ifTrue: trueBlock
	].

	"checks death date"
	query died ifNotNil: [
		(query died = self deathDate) ifTrue: trueBlock
	].

	"checks death location"
	query diedIn ifNotNil: [
		(query diedIn = self deathLocation) ifTrue: trueBlock
	].

	"checks for misc. record match"
	query hasInfoName ifNotNil: [
		(query hasInfoValue == self miscRecords at: query hasInfoName) ifTrue: trueBlock
	].

	"checks birth location and death location"
	query livedIn ifNotNil: [
		((query livedIn = bornLocation) or: [ query livedIn = deathLocation ])
			ifTrue: trueBlock
	].

	"checks for living on date"
	query livedOn ifNotNil: [
		bornDate ifNotNil: [
			deathDate ifNotNil: [
				"both birth and death date known.  date must be with in range"
				( ((bornDate < query livedOn) or: [bornDate = query livedOn])
				 and: [(query livedOn < deathDate) or: [query livedOn = deathDate]] ) 
				 ifTrue: trueBlock
			] ifNil: [ 
				"death date unknown.  Assumed to be still living"
				( (bornDate < query livedOn) or: [ bornDate = query livedOn] ) ifTrue: trueBlock
			]
		] ifNil: [
			"birth date unknown.  Assumed to have been living since creation until death date"
			deathDate ifNotNil: [ 
				((query livedOn < deathDate) or: [query livedOn = deathDate]) ifTrue: trueBlock
			]
		]
		"birth and death date unknown.  Cannot determine, so assume false."
	].

	"checks for string as substring in given name, surname, alias list, birth and death location,
	 and name or value in misc. records"
	query generalSearch ifNotNil: [
		givenName ifNotNil: [ (givenName includesSubString: query generalSearch) 
			ifTrue: trueBlock
		].
		surName ifNotNil: [ ( surName includesSubString: query generalSearch)
			ifTrue: trueBlock
		].
		aliases ifNotNil: [ aliases do: [ :elem | (elem includesSubString: query generalSearch)
			ifTrue: trueBlock ]
		].
		bornLocation ifNotNil: [ (bornLocation includesSubString: query generalSearch)
			ifTrue: trueBlock
		].
		deathLocation ifNotNil: [ (deathLocation includesSubString: query generalSearch)
			ifTrue: trueBlock
		].
		miscRecords ifNotNil: [
			miscRecords keys do: [ :key | (key includesSubString: query generalSearch) 
				ifTrue: trueBlock
			].
			miscRecords values do: [ :value | (value includesSubString: query generalSearch)
				ifTrue: trueBlock
			]
		]
	].

	"does not match any part of query"
	^false.! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:45'!
searchSiblings: query useIfTrue: matchSet
	"calls search on all siblings,
	 passing the query and matchSet object"

	familialRelationships do: [ :family |
		(family children includes: self) ifTrue: [
			family children do: [ :child | (child = self) 
				ifFalse: [ child searchSelf: query useIfTrue: matchSet ]
			]
		]
	].! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:46'!
searchSiblings: query useIfTrue: matchSet cycleCheck: beenThere
	"calls search on all siblings if sibling is not self nor already searched, as checked by 
	 beenThere object which contains all Persons that have been searched (successful match 
	 or not), passing the query and matchSet object"

	familialRelationships do: [ :family |
		(family children includes: self) ifTrue: [
			family children do: [ :child | 
				( (child == self) or: [beenThere includes: child] )
					ifFalse: [ beenThere add: child. child searchSelf: query useIfTrue: matchSet ]
			]
		]
	].! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:47'!
searchUp: query useIfTrue: matchSet
	"calls search on self, siblings, and recurses up the tree to mother and father,
	 passing the query and matchSet objects"

	self searchSelf: query useIfTrue: matchSet.
	self searchSiblings: query useIfTrue: matchSet.
	familialRelationships do: [ :family |
		(family hasChild: self) ifTrue: [
			family father ifNotNil: [ family father searchUp: query useIfTrue: matchSet ].
			family mother ifNotNil: [ family mother searchUp: query useIfTrue: matchSet ]

		]
	].
! !

!Person methodsFor: 'queries' stamp: 'TEO 9/16/2002 15:48'!
searchUp: query useIfTrue: matchSet cycleCheck: beenThere
	"calls search on self, siblings, and parents.  Does this only if self has not been searched, as
	 checked by the beenThere object which contains all Persons that have been searched
	 (successful match or not), passing the query and matchSet object"

	(beenThere includes: self) ifFalse: [
		beenThere add: self.
		self searchSelf: query useIfTrue: matchSet.
		self searchSiblings: query useIfTrue: matchSet cycleCheck: beenThere.
		familialRelationships do: [ :family |
			(family hasChild: self) ifTrue: [
				family father ifNotNil: [ 
					family father searchUp: query useIfTrue: matchSet cycleCheck: beenThere
				].
				family mother ifNotNil: [ 
					family mother searchUp: query useIfTrue: matchSet cycleCheck: beenThere
				]
			]
		]
	]
! !


!Person methodsFor: 'checking' stamp: 'TEO 9/16/2002 16:50'!
check
	"check person and their relativesfor missing vital information
	and incorrect information"

	| checkResults |
	
	checkResults _ CheckResults new.

	 "handles self and siblings and up"
	self checkUp: nil useIfTrue: checkResults cycleCheck: IdentitySet new.
	
	"handles self and children"
	self checkDown: nil useIfTrue: checkResults cycleCheck: IdentitySet new. 

	^ checkResults nicelyFormatingStringFor: self.! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:46'!
checkDown: query useIfTrue: checkResults
	"Check down traverses the family graph down
	until it reaches the last direct decendent of the
	originating individual.  At each person it calls
	check."

	self checkSelf: query useIfTrue: checkResults.
	familialRelationships do: [ :family |
		( (self = family father) or: [self = family mother]) ifTrue: [
			family children do: [ :child | child checkDown: query useIfTrue: checkResults ]
		]
	].! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:50'!
checkDown: query useIfTrue: checkResults cycleCheck: beenThere
	"Check down traverses the family graph down
	until it reaches the last direct decendent of the
	originating individual.  At each person it calls
	check.  It also checks for cycles using the beenThere
	weakSet."

	(beenThere includes: self) ifFalse: [

	self checkSelf: query useIfTrue: checkResults.
	familialRelationships do: [ :family |
		(family hasParent: self) ifTrue: [
			family children do: [ :child | child checkDown: query useIfTrue: checkResults ]
		]
	]

	].! !

!Person methodsFor: 'checking' stamp: 'tss 9/15/2002 16:57'!
checkSelf: query useIfTrue: checkResults
	"Checks self for missing vital information.
	When it finds missing vital information it adds itself,
	its family, or its marriage to an identity set in
	checkResults."
	
	| childFamily |

	"Make sure I have a given name"
	((givenName isNil) or: [givenName = '']) ifTrue:[
		checkResults noGivenName: self.
	].

	"Make sure I have a sur name."
	((surName isNil) or: [surName = '']) ifTrue:[
		checkResults noSurName: self.
	].

	"Am I the wrong gender in any relationships?"
	self familialRelationships do:[:family| (family hasParent: self) ifTrue: [
		self isFemaleGender ifTrue: [(family father == self) ifTrue: [
			checkResults wrongGender: self]] ifFalse: [(family mother == self) ifTrue: [
			checkResults wrongGender: self]]]].
	self marriageRelationships do:[:marriage| (marriage hasSpouse: self) ifTrue: [
		self isFemaleGender ifTrue: [(marriage man == self) ifTrue: [
			checkResults wrongGender: self]] ifFalse: [(marriage woman == self) ifTrue: [
			checkResults wrongGender: self]]]].

	"Do I have parents?"
	(childFamily _ self familialRelationships detect: [:family| family children includes: self]
		ifNone: [checkResults noMother: self.
			checkResults noFather: self.childFamily_nil])
		ifNotNil: [childFamily mother ifNil: [checkResults noMother: self].
			childFamily father ifNil: [checkResults noFather: self]].

	bornDate ifNotNil: [
		childFamily ifNotNil: [
			childFamily mother ifNotNil: [
				childFamily mother deathDate ifNotNil: [
					(bornDate > childFamily mother deathDate) ifTrue: [
						checkResults badDateMother: self
					]
				]
			].
			childFamily father ifNotNil: [
				childFamily father deathDate ifNotNil: [
					((bornDate addDays: 274) > 
						childFamily father deathDate) ifTrue: [
						checkResults badDateFather: self
					]
				]
			].
		]
	].
				

	"Am I having children without a spouse?"
		self familialRelationships do: [ :family |
			((family hasParent: self) and: [family father isNil not] and: 
				[family mother isNil not] ) ifTrue:  [
					self marriageRelationships detect: [:marriage| marriage 
						hasSpouses: family father and: family mother]
					ifNone: [checkResults hasChildNotMarried: family]]
		].

	marriageRelationships do: [:marriage| marriage marriedOn ifNotNil:[
		marriage man bornDate ifNotNil: [(marriage man bornDate > marriage marriedOn)
			ifTrue: [checkResults badDateMarriage: marriage]].
		marriage woman bornDate ifNotNil: [(marriage woman bornDate > marriage marriedOn)
			ifTrue: [checkResults badDateMarriage: marriage]].
		marriage man deathDate ifNotNil: [(marriage man deathDate < marriage marriedOn)
			ifTrue: [checkResults badDateMarriage: marriage]].
		marriage woman deathDate ifNotNil: 
				[(marriage woman deathDate < marriage marriedOn)
			ifTrue: [checkResults badDateMarriage: marriage]]]
	].
	marriageRelationships do: [:marriage| marriage divorcedOn ifNotNil:[
		marriage man bornDate ifNotNil: [(marriage man bornDate > marriage divorcedOn)
			ifTrue: [checkResults badDateDivorce: marriage]].
		marriage woman bornDate ifNotNil: [(marriage woman bornDate > marriage divorcedOn)
			ifTrue: [checkResults badDateDivorce: marriage]].
		marriage man deathDate ifNotNil: [(marriage man deathDate < marriage divorcedOn)
			ifTrue: [checkResults badDateDivorce: marriage]].
		marriage woman deathDate ifNotNil: 
				[(marriage woman deathDate < marriage divorcedOn)
			ifTrue: [checkResults badDateDivorce: marriage]]]
	].

	((bornDate isNil not) and: [deathDate isNil not]) ifTrue:[
			(deathDate < bornDate) ifTrue: [checkResults badDateBorn: self]
		]
		ifFalse:[
			bornDate ifNil: [
				checkResults noBornDate: self
			].
			deathDate ifNil: [
				checkResults noDeathDate: self
			]
		].

	((bornLocation isNil) or: [bornLocation = '']) ifTrue: [
		checkResults noBornLocation: self
	].
	((deathLocation isNil) or: [deathLocation = '']) ifTrue: [
		checkResults noDeathLocation: self
	].

	^false.! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:52'!
checkSiblings: query useIfTrue: checkResults
	"Calls checkSelf on all the relatives of the individual.
	Based on the family objects for the person it is called on."

	familialRelationships do: [ :family |
		(family children includes: self) ifTrue: [
			family children do: [ :child | (child = self) 
				ifFalse: [ child checkSelf: query useIfTrue: checkResults ]
			]
		]
	].! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:52'!
checkSiblings: query useIfTrue: checkResults cycleCheck: beenThere
	"Calls checkSelf on all the relatives of the individual.
	Based on the family objects for the person it is called on.
	It also uses the beenThere weakSet to check for cycles."

	familialRelationships do: [ :family |
		(family children includes: self) ifTrue: [
			family children do: [ :child | ( (child == self) or: [ beenThere includes: child ] )
				ifFalse: [ beenThere add: child. child checkSelf: query useIfTrue: checkResults ]
			]
		]
	].! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:53'!
checkUp: query useIfTrue: checkResults
	"Travers the family graph up the tree looking
	at direct ansestors of the originating person.
	on each person it calls the checkSelf message."

	self checkSelf: query useIfTrue: checkResults.
	self checkSiblings: query useIfTrue: checkResults.
	familialRelationships do: [ :family |
		(family children includes: self) ifTrue: [
			family father ifNotNil: [ family father checkUp: query useIfTrue: checkResults ].
			family mother ifNotNil: [ family mother checkUp: query useIfTrue: checkResults ]

		]
	].
! !

!Person methodsFor: 'checking' stamp: 'tss 9/18/2002 15:54'!
checkUp: query useIfTrue: checkResults cycleCheck: beenThere
	"Travers the family graph up the tree looking
	at direct ansestors of the originating person.
	on each person it calls the checkSelf message.
	Also, uses the beenThere weakSet to check for
	cycles."

	(beenThere includes: self) ifFalse: [

	beenThere add: self.
	self checkSelf: query useIfTrue: checkResults.
	self checkSiblings: query useIfTrue: checkResults cycleCheck: beenThere.
	familialRelationships do: [ :family |
		(family hasChild: self) ifTrue: [
			family father ifNotNil: [ 
				family father checkUp: query useIfTrue: checkResults cycleCheck: beenThere
			].
			family mother ifNotNil: [ 
				family mother checkUp: query useIfTrue: checkResults cycleCheck: beenThere
			]
		]
	]

	].
! !

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

Person class
	instanceVariableNames: ''!

!Person class methodsFor: 'as yet unclassified' stamp: 'TEO 9/16/2002 15:58'!
allPersons
	"comment stating purpose of message"

	AllPersons ifNil: [ AllPersons := WeakSet new ].
	^ AllPersons! !

!Person class methodsFor: 'as yet unclassified' stamp: 'TEO 9/16/2002 15:52'!
new
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp initialize.

	"sets class variable if not instantiated yet"
	AllPersons ifNil: [ AllPersons := WeakSet new ].

	"adds new object to set of all instantiated objects"
	AllPersons add: temp.
	^temp.! !


Object subclass: #Query
	instanceVariableNames: 'givenName surName male alias sibling parent child marriedTo birthDate birthLocation deathDate deathLocation propName propValue livedIn livedOn generalSearch '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm2'!
!Query commentStamp: '' prior: 0!
A Query object is created and is intended to be sent to a Person instance to compare the field that the query contains from the class method to that Person's data, as well as all of that Person's relative.

3 other class messages are intended to take the parameter and compare it to every Person instance created (accessed via a class message in Person) to check if it matches the query parameter.

Possible useful expressions for doIt or printIt.

Structure:
 instVar1		type -- comment about the purpose of instVar1
 instVar2		type -- comment about the purpose of instVar2

Any further useful comments about the general approach of this implementation.!


!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:47'!
born
	"comment stating purpose of message"

	^ birthDate.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:29'!
born: checkDate
	"comment stating purpose of message"

	birthDate := checkDate! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:48'!
bornIn
	"comment stating purpose of message"

	^ birthLocation.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:30'!
bornIn: checkPlace
	"comment stating purpose of message"

	birthLocation := checkPlace.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:48'!
died
	"comment stating purpose of message"

	^ deathDate.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:31'!
died: checkDate
	"comment stating purpose of message"

	deathDate := checkDate.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:48'!
diedIn
	"comment stating purpose of message"

	^ deathLocation.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:30'!
diedIn: checkPlace
	"comment stating purpose of message"

	deathLocation := checkPlace.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:49'!
generalSearch
	"comment stating purpose of message"

	^ generalSearch.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:35'!
generalSearch: checkString
	"comment stating purpose of message"

	generalSearch := checkString.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:49'!
givenName
	"comment stating purpose of message"

	^ givenName.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:03'!
givenName: checkName
	"comment stating purpose of message"

	givenName := checkName.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:50'!
hasAlias
	"comment stating purpose of message"

	^ alias.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:03'!
hasAlias: checkAlias
	"comment stating purpose of message"

	alias := checkAlias.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:50'!
hasChild
	"comment stating purpose of message"

	^ child.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:04'!
hasChild: checkChild
	"comment stating purpose of message"

	child := checkChild.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:33'!
hasInfo: checkName as: checkValue
	"comment stating purpose of message"

	propName := checkName.
	propValue := checkValue.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:02'!
hasInfoName
	"comment stating purpose of message"

	^ propName.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:02'!
hasInfoValue
	"comment stating purpose of message"

	^ propValue.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:03'!
hasParent
	"comment stating purpose of message"

	^ parent.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:26'!
hasParent: checkParent
	"comment stating purpose of message"

	parent := checkParent.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:03'!
hasSibling
	"comment stating purpose of message"

	^ sibling.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:03'!
hasSibling: checkSibling
	"comment stating purpose of message"

	sibling := checkSibling.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:01'!
isFemale
	"comment stating purpose of message"

	male := false.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:04'!
isFemaleGender
	"comment stating purpose of message"

	^ male ifNil: [nil] ifNotNil: [male not].! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:01'!
isMale
	"comment stating purpose of message"

	male := true.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:03'!
isMaleGender
	"comment stating purpose of message"

	^ male.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:06'!
livedIn
	"comment stating purpose of message"

	^ livedIn! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:34'!
livedIn: checkPlace
	"comment stating purpose of message"

	livedIn := checkPlace.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:06'!
livedOn
	"comment stating purpose of message"

	^ livedOn! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:34'!
livedOn: checkDate
	"comment stating purpose of message"

	livedOn := checkDate.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:06'!
married
	"comment stating purpose of message"

	^ marriedTo.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:29'!
married: checkSpouse
	"comment stating purpose of message"

	marriedTo := checkSpouse.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 22:07'!
surName
	"comment stating purpose of message"

	^ surName.! !

!Query methodsFor: 'accessing' stamp: 'TEO 9/12/2002 21:04'!
surName: checkName
	"comment stating purpose of message"

	surName := checkName.! !

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

Query class
	instanceVariableNames: ''!

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:43'!
born: checkDate
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp born: checkDate.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:44'!
bornIn: checkLocation
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp bornIn: checkLocation.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:44'!
died: checkDate
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp died: checkDate.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:45'!
diedIn: checkLocation
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp diedIn: checkLocation.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:37'!
givenName: checkName
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp givenName: checkName.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:41'!
hasAlias: checkSibling
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp hasAlias: checkSibling.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:43'!
hasChild: checkChild
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp hasChild: checkChild.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:45'!
hasInfo: checkName as: checkValue
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp hasInfo: checkName as: checkValue.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:42'!
hasParent: checkParent
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp hasParent: checkParent.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:42'!
hasSibling: checkSibling
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp hasSibling: checkSibling.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:40'!
isFemale
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp isFemale.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:39'!
isMale
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp isMale.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:43'!
married: checkSpouse
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp married: checkSpouse.
	^ temp.! !

!Query class methodsFor: 'instance creation' stamp: 'TEO 9/12/2002 21:37'!
surName: checkName
	"comment stating purpose of message"

	| temp |
	temp := super new.
	temp surName: checkName.
	^ temp.! !


!Query class methodsFor: 'global search' stamp: 'TEO 9/16/2002 12:24'!
generalSearch: checkString
	"comment stating purpose of message"

	| temp matchSet |
	temp := super new.
	temp generalSearch: checkString.
	matchSet := IdentitySet new.
	Person allPersons do: [ :person | person searchSelf: temp useIfTrue: matchSet ].
	^ matchSet.! !

!Query class methodsFor: 'global search' stamp: 'TEO 9/16/2002 12:26'!
livedIn: checkLocation
	"comment stating purpose of message"

	| temp matchSet |
	temp := super new.
	temp livedIn: checkLocation.
	matchSet := IdentitySet new.
	Person allPersons do: [ :person | person searchSelf: temp useIfTrue: matchSet ].
	^ matchSet.! !

!Query class methodsFor: 'global search' stamp: 'TEO 9/16/2002 12:26'!
livedOn: checkDate
	"comment stating purpose of message"

	| temp matchSet |
	temp := super new.
	temp livedOn: checkDate.
	matchSet := IdentitySet new.
	Person allPersons do: [ :person | person searchSelf: temp useIfTrue: matchSet ].
	^ matchSet.! !





Link to this Page