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

g e d

SystemWindow subclass: #CheckMorph
	instanceVariableNames: 'checkResults webQueryDictionary scrollPane webQueryMorphContainer person '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!CheckMorph commentStamp: '' prior: 0!
This object when instantied displays the result of a check on a person's family tree to a user.  This involves discovering what vital information is missing and what vital information is contradictory.  For example a person who does not have a mother or a person who's death date is prior to their birth date.  Then 5 websites are queried to try to fill in the missing or inccorect information.  The user is presented with the results from the web and is given the option to fill in the result of their choice.!


!CheckMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/30/2002 20:09'!
checkResults: aCheckResults checkResults _ aCheckResults! !

!CheckMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:11'!
display
	"This displays the morph to the user.
	First it creates all the submorphs according the check results.
	then it open it in the world."

	| y tempString closeButton |
	
	y _ 15.

	"display check results"
	tempString _ (StringMorph new) position: (50@(y));
		contents: ('Below is the missing vital information for ');
		emphasis: 1.
	webQueryMorphContainer addMorph: (tempString).
	
	tempString _ (StringMorph new) position: (80@(y+13));
		contents: (person givenName,' ', person surName, ' and ');
		emphasis: 1.
	person isFemaleGender ifTrue: [tempString contents: (tempString contents,'her')] 
		ifFalse: [tempString contents: (tempString contents,'his')].
	tempString contents: (tempString contents,' relatives').
	webQueryMorphContainer addMorph: (tempString).
	y _ y + 50.	

	"Naming Problems"
	tempString _ (StringMorph new) position: (20@(y+10));
		contents: 'Naming Problems:';
		emphasis: 1.
	webQueryMorphContainer addMorph: (tempString).
	y _ y + 30.
	
	(checkResults noGivenName) do: [:aPerson| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName,' has no given name!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].
	(checkResults noSurName) do: [:aPerson| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName,' has no sur name!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	"Birth and death problems"
	tempString _ (StringMorph new) position: (20@(y+10));
		contents: 'Birth and Death Problems:';
		emphasis: 1.
	webQueryMorphContainer addMorph: (tempString).
	y _ y + 30.

	"no born date"
	(checkResults noBornDate) do: [: aPerson |
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #bornDate
				title: (aPerson givenName, ' ', aPerson surName, '  has no born date!!')
			) position: 15@y
		).
		y _ y + 150.
	].
	
	"no birth location"
	(checkResults noBornLocation) do: [: aPerson |
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #bornLocation
				title: (aPerson givenName, ' ', aPerson surName, '  has no birth location!!')
			) position: 15@y
		).
		y _ y + 150.
	].
	

	"no death date"
	(checkResults noDeathDate) do: [: aPerson |
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #deathDate
				title: (aPerson givenName, ' ', aPerson surName, '  has no death date!!')
			) position: 15@y
		).
		y _ y + 150.
	].

	"no death location"
	(checkResults noDeathLocation) do: [: aPerson |
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #deathLocation
				title: (aPerson givenName, ' ', aPerson surName, '  has no death location!!')
			) position: 15@y
		).
		y _ y + 150.
	].

	"badDateBorn"
	(checkResults badDateBorn) do: [: aPerson |
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName, '  died before birth!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #bornDate
				title: (aPerson givenName, ' ', aPerson surName, $' asString ,'s birth date')
			) position: 15@y
		).
		y _ y + 150.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #deathDate
				title: (aPerson givenName, ' ', aPerson surName, $' asString ,'s death date')
			) position: 15@y
		).
		y _ y + 150.
	].

	"badDateFather"
	(checkResults badDateFather) do: [: aPerson |
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName, $' asString,
				's father died more than').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 10.
		tempString _ (StringMorph new) position: (50@(y));
			contents: 'nine months before their birth!!'.
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #bornDate
				title: (aPerson givenName, ' ', aPerson surName, $' asString ,'s birth date')
			) position: 15@y
		).
		y _ y + 150.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: (aPerson father)) 
				aspect: #deathDate
				title: ((aPerson father) givenName, ' ', (aPerson father) surName,
					$' asString ,'s death date')
			) position: 15@y
		).
		y _ y + 150.
	].

	"badDateMother"
	(checkResults badDateMother) do: [: aPerson |
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName, $' asString,
				's mother died more than').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 10.
		tempString _ (StringMorph new) position: (50@(y));
			contents: 'nine months before their birth!!'.
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: aPerson) 
				aspect: #bornDate
				title: (aPerson givenName, ' ', aPerson surName, $' asString ,'s birth date')
			) position: 15@y
		).
		y _ y + 150.
		webQueryMorphContainer addMorph: (
			(WebQueryMorph
				from: (webQueryDictionary at: (aPerson mother)) 
				aspect: #deathDate
				title: ((aPerson mother) givenName, ' ', (aPerson mother) surName,
					$' asString ,'s death date')
			) position: 15@y
		).
		y _ y + 150.
	].


	"Parental Problems:"
	tempString _ (StringMorph new) position: (20@(y+10));
		contents: 'Parental Problems:';
		emphasis: 1.
	webQueryMorphContainer addMorph: (tempString).
	y _ y + 30.

	(checkResults noMother) do: [:aPerson| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName,' has no mother!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	(checkResults noFather) do: [:aPerson| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson givenName, ' ', aPerson surName,' has no father!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	"Mariatal Problems:"
	tempString _ (StringMorph new) position: (20@(y+10));
		contents: 'Mariatal Problems:';
		emphasis: 1.
	webQueryMorphContainer addMorph: (tempString).
	y _ y + 30.
	
	(checkResults hasChildNotMarried) do: [:aPerson| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (aPerson father givenName, ' ', 
		aPerson father surName, ' and ',aPerson mother givenName, ' ', aPerson mother surName,
		' have children but aren''t married!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	(checkResults badDateMarriage) do: [:elem| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (elem man givenName, ' ', 
		elem man surName, ' and ',elem woman givenName, ' ', elem woman surName,
		' were married when at least one of them were not alive!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	(checkResults badDateDivorce) do: [:elem| 
		tempString _ (StringMorph new) position: (50@(y));
			contents: (elem man givenName, ' ', 
		elem man surName, ' and ',elem woman givenName, ' ', elem woman surName,
		' were divorced when at least one of them were not alive!!').
		webQueryMorphContainer addMorph: (tempString).
		y _ y + 15.
	].

	"Close button"
	closeButton := PluggableButtonMorph on: self
					getState: nil
					action: #delete.
	closeButton label: 'Close'.
	webQueryMorphContainer addMorph: (closeButton position: 180@y).

	! !

!CheckMorph methodsFor: 'as yet unclassified' stamp: 'tss 11/4/2002 11:04'!
initialize
	"  Initializes the basic display proporties of the morph
	The morph is not actually displayed until display is called"

	| |
	super initialize.
	self paneColor: (Color yellow).

	webQueryMorphContainer _ WebQueryMorphContainer new.
	webQueryMorphContainer color: (Color yellow veryMuchLighter).
	webQueryMorphContainer borderWidth: 0.
	webQueryMorphContainer model: self.

	scrollPane _ webQueryMorphContainer inATwoWayScrollPane.

	self addMorph: scrollPane frame:  (0@0 extent: 1@1).

! !

!CheckMorph methodsFor: 'as yet unclassified' stamp: 'tss 11/4/2002 11:03'!
initializeWebQueryDictionary
	"  This method initializes the dictionary that maps
	web queries to individual people.
	Then it displays the information found using the display method."

	| messedPeople progress menu |

	messedPeople _ IdentitySet new.

	messedPeople addAll: (checkResults noBornDate).
	messedPeople addAll: (checkResults noBornLocation).
	messedPeople addAll: (checkResults noDeathDate).
	messedPeople addAll: (checkResults noDeathLocation).
	messedPeople addAll: (checkResults badDateBorn).
	messedPeople addAll: (checkResults badDateFather).
	messedPeople addAll: ((checkResults badDateFather) collect: [: aPerson | aPerson father]).
	messedPeople addAll: (checkResults badDateMother).
	messedPeople addAll: ((checkResults badDateMother) collect: [: aPerson | aPerson mother]).
	messedPeople addAll: ((checkResults badDateMarriage) collect: [: elem | elem man]).
	messedPeople addAll: ((checkResults badDateMarriage) collect: [: elem | elem woman]).
	messedPeople addAll: ((checkResults badDateDivorce) collect: [: elem | elem man]).
	messedPeople addAll: ((checkResults badDateDivorce) collect: [: elem | elem woman]).

	webQueryDictionary _ IdentityDictionary new.

	progress _ ProgressMorph label: 'Querying Web'.
	progress subLabel: 'Please be patient, this may take a few moments.'.
	progress openInWorld.

	[[messedPeople do: [: aPerson |
		webQueryDictionary at: aPerson put: (WebQuery from: aPerson).
		(webQueryDictionary at: aPerson) execute.
		" Querying Web - progress bar "
		progress incrDone: (1 / (messedPeople size)).
	].

	self display.

	progress delete.
	self openInWorld.
	self extent: 400@500.
	self position: 300@30.
	scrollPane fitContents.
	] ifError: [
		menu _ MenuMorph entitled: 'Cannot connect to internet!!'.
			menu add: ('OK')
			target: GenealogyMap
			selector: #DoNothing.
		menu popUpInWorld.
	]] fork.! !

!CheckMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/31/2002 11:56'!
person: aPerson person _ aPerson! !

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

CheckMorph class
	instanceVariableNames: ''!

!CheckMorph class methodsFor: 'as yet unclassified' stamp: 'tss 11/4/2002 11:02'!
from: aCheckResults on: aPerson
	"Creates a new Check Morph.
	It is created for the person specified using the results of a check 
	that is specified by the aCheckResults parameter."

	| toRet |

	toRet _ super labelled: 'Check Results'.
	toRet checkResults: aCheckResults.
	toRet person: aPerson.
	toRet initializeWebQueryDictionary.
	^ toRet! !


Object subclass: #CheckResults
	instanceVariableNames: 'noGivenName noSurName noGender noBornDate noBornLocation noDeathDate noDeathLocation hasChildNotMarried badDateMarriage badDateDivorce badDateBorn badDateFather badDateMother wrongGender noFather noMother '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!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 10/30/2002 19:26'!
badDateBorn ^ badDateBorn! !

!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 10/30/2002 19:26'!
badDateDivorce ^ badDateDivorce
	! !

!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 10/30/2002 19:27'!
badDateFather ^ badDateFather! !

!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 10/30/2002 19:30'!
badDateMarriage ^badDateMarriage! !

!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 10/30/2002 19:30'!
badDateMother ^ badDateMother! !

!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 10/30/2002 19:30'!
hasChildNotMarried ^ hasChildNotMarried! !

!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 10/30/2002 19:30'!
noBornDate ^ noBornDate! !

!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 10/30/2002 19:31'!
noBornLocation ^ noBornLocation! !

!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 10/30/2002 19:31'!
noDeathDate ^ noDeathDate! !

!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 10/30/2002 19:31'!
noDeathLocation ^ noDeathLocation! !

!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 10/30/2002 19:32'!
noFather ^ noFather! !

!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 10/30/2002 19:32'!
noGender ^ noGender! !

!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 10/30/2002 19:33'!
noGivenName ^ noGivenName! !

!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 10/30/2002 19:39'!
noMother ^ noMother! !

!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 10/30/2002 19:39'!
noSurName ^ noSurName! !

!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 10/30/2002 19:40'!
wrongGender ^ wrongGender! !

!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 uniqueID '
	classVariableNames: 'NextUniqueID '
	poolDictionaries: ''
	category: 'm7'!
!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 10/21/2002 13:56'!
fixGender
	"examines the genders of the mother and father 
	and assuers the mother is female."

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

!Family methodsFor: 'as yet unclassified' stamp: 'tss 11/16/2002 18:23'!
toGEDCOM
	| gedcom linebreak |
	gedcom _ ''.
	linebreak _ String crlf.

	"0 @ID@ FAM"
	gedcom _ gedcom, '0 @', self uniqueID, '@ FAM', linebreak.

	"1 HUSB @I2@"
	father ifNotNil: [
		gedcom _ gedcom, '1 HUSB @', father uniqueID, '@', linebreak
	].

	"1 WIFE @I3@"
	mother ifNotNil: [
		gedcom _ gedcom, '1 WIFE @', mother uniqueID, '@', linebreak
	].

	"marriages"
	mother ifNotNil: [
		mother marriageRelationships do: [: aMarriage |
			(aMarriage hasSpouse: father) ifTrue: [
				"1 MARR"
				gedcom _ gedcom, '1 MARR' , linebreak.

					"2 DATE 01 FEB 1860"
					gedcom _ gedcom, '2 DATE ', aMarriage marriedOn mmddyyyy, linebreak.

					"2 PLAC Concord, Jefferson, WI"
					"NOT SUPPORTED"
				(aMarriage divorcedOn) ifNotNil: [
					"1 DIV"
					gedcom _ gedcom, '1 DIV' , linebreak.

						"2 DATE 01 FEB 1860"
						gedcom _ gedcom, '2 DATE ', aMarriage divorcedOn mmddyyyy, linebreak.
	
						"2 PLAC Concord, Jefferson, WI"
						"NOT SUPPORTED"
				].
			]
		]
	].	

	"children"
	children do: [: aChild |
		"1 CHIL @I1@"
	 	gedcom _ gedcom, '1 CHIL @', aChild uniqueID, '@', linebreak.
	].


	"Transcript show: gedcom."

	^ gedcom! !

!Family methodsFor: 'as yet unclassified' stamp: 'tss 11/7/2002 12:12'!
uniqueID ^ 'F', (uniqueID asString)! !

!Family methodsFor: 'as yet unclassified' stamp: 'tss 11/7/2002 11:38'!
uniqueID: id uniqueID _ id! !


!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: 'tss 11/16/2002 18:20'!
GetNextUniqueID
	"comment stating purpose of message"

	| temp |

	"sets class variables if not instantiated yet"
	NextUniqueID ifNil: [NextUniqueID _ 0].

	"sets the unique id"
	temp _ NextUniqueID.
	NextUniqueID _ NextUniqueID + 1.

	^ temp.! !

!Family class methodsFor: 'as yet unclassified' stamp: 'tss 11/16/2002 20:19'!
new
	"comment stating purpose of message"

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

	"sets class variables if not instantiated yet"
	"NextUniqueID ifNil: [NextUniqueID _ 0]."

	"sets the unique id"
	"temp uniqueID: NextUniqueID.
	NextUniqueID _ NextUniqueID + 1."

	temp uniqueID: self GetNextUniqueID.

	^ temp.! !


Object subclass: #GEDCOMParser
	instanceVariableNames: 'scanner currentToken objs tempSpouse '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!GEDCOMParser commentStamp: '' prior: 0!
This is a recursive-descent parser. It holds a reference to its scanner in 'scanner' variable. After a successful parse it returns an OrderedCollection of all people found in the file. 

Grammar used for parsing:
File				:  	InitialLine Body	;
InitialLine	 	: 	'0' 'HEAD';
ClosingLine 		: 	'0' 'TRLR';
Record 			: 	Header InfoLines;
Header		 	:	'0' Pointer Type	;								
Type			:	'INDI'
				|	'FAM';
InfoLines 		:	Tag Value InfoLines
				|	ClosingLine;
Tag 			:	('NAME' | 'SEX' | 'BIRT' | 'DATE' | 'PLAC' | 'FAMS' | 'FAMC' | 'DEAT' | 'HUSB' | 'WIFE' | 'CHIL' | 'MARR' | '_ALI' | '_MIS');
Value 			:	'M'	
				|	'F'
				|	Date
				|	Pointer
				|	
				|	 Tag Date;
Date 			: 	('JAN' | 'FEB' | 'MAR' | 'APR' | 'MAY' | 'JUN' | 'JUL' | 'AUG' | 'SEP' | 'OCT' | 'NOV' | 'DEC');
Pointer 			: 	('I' | 'F');!


!GEDCOMParser methodsFor: 'private' stamp: 'tss 11/17/2002 21:36'!
initialize

	objs _ Dictionary new.
	tempSpouse _ OrderedCollection new.
	2 timesRepeat:[ tempSpouse add:' '].! !

!GEDCOMParser methodsFor: 'private' stamp: 'Dino 11/12/2002 19:33'!
scanner: aScanner

	scanner _ aScanner! !

!GEDCOMParser methodsFor: 'private' stamp: 'Dino 11/12/2002 17:08'!
tokens: aCollection

	tokens _ aCollection! !


!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 15:17'!
display: aString
	"Used for debugging. To see it in action uncomment the code below. Takes a long time to parse file with it enabled!!!!!!!!"

	"Transcript show:'';cr.
	Transcript show: aString."! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/13/2002 18:11'!
error

	Transcript show: '';cr.
	Transcript show: 'Error occured !!!!!! Happy Debugging :-)';cr.! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 17:30'!
firstName: aString
	"Answers all parts of the aString parameter that are not sourounded by /. "

	| names fName | 
	fName _ String new.

	names _ aString findTokens: ' '.
	names do:[ :name | (name beginsWith:'/') ifFalse:[fName _ fName, ' ', name]].
	(fName size > 0) ifTrue: [((fName at: 1) asString = ' ') ifTrue: [fName _ fName copyFrom: 2 to: (fName size)]].
	^fName! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:08'!
isClosingLine
	"Answers if scanner is at the last line of the file. Does not advance the scanner."

	| temp token |
	temp _ scanner tokens.
	token _ temp at:(scanner position + 1).

	(token asInteger notNil and: [token asInteger = 0]) ifTrue:
	[
		^((temp at:(scanner position + 2)) = 'TRLR').
	].
	^false
	! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:08'!
isIdentifier: aString
	"Answers if aString is one of the supported identifiers."

	^(aString = 'NAME' 	or: [ aString = 'SEX'
						or: [ aString = 'BIRT'
						or: [ aString = 'DATE'	
						or: [ aString = 'PLAC'
						or: [ aString = 'FAMS'
						or: [ aString = 'FAMC'
						or: [ aString = 'DEAT'
						or: [ aString = 'HUSB'
						or: [ aString = 'WIFE'
						or: [ aString = 'CHIL'
						or: [ aString = 'MARR'
						or: [ aString = 'DIV']]]]]]]]]]]])! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:22'!
isLastLine
	"Answers if the line the scanner is currently on is the last line of a record - family or individual. Does not advance scanner." 

	^(((scanner tokens) at: (scanner position + 2)) = '0') 
! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:10'!
lastName: aString
	"Answers the name sourounded by the / delimiters."

	| names lName |
	lName _ String new.

	names _ aString findTokens: ' '.	
	names do:[ :name | (name beginsWith:'/') ifTrue: [lName _ name]].
	lName _ lName copyReplaceAll:'/' with:''.
	^lName! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 15:15'!
matchAliasLine
	"Matched the _ALI line of the file. Uses matchText to answer the value of the line."

	((currentToken _ scanner next) asInteger notNil) ifTrue:
	[
		((currentToken _ scanner next) = '_ALI_NAME') ifTrue:
		[
			currentToken _ scanner next.
			^self matchText.
		]
	]! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 17:54'!
matchDate
	"Answers the date as a Date object from a DATE line or nil if fail."

	| temp parts dt |

	temp _ (currentToken _ scanner next).
	parts _ temp findTokens: '/'.

	self display: 'parts of the date are: ', parts asString.

	(parts size < 3) ifFalse:
	[
		((parts at: 2) asInteger notNil) ifTrue:
		[
			(self matchMonth: (parts at: 1)) ifTrue:
			[
				((parts at: 3) asInteger notNil) ifTrue:
				[
					dt _ (Date newDay:(parts at: 2) asInteger month: (parts at: 1) asInteger year: (parts at: 3) asInteger).
					self display: ' incrementing scanner in matchDate'.
					scanner next.
					^dt
				]. 
			]
		]
	].
	scanner next.
	^nil! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 19:25'!
matchDateLine
	"Matches date lines. Answers the date from matchDate."

	self display: ' matching a date', currentToken.

	((currentToken _ scanner next) asInteger isNil) ifFalse:
	[
		((currentToken _ scanner next) = 'DATE') ifTrue:
		[
			self display: 'matched a date'.
			^self matchDate.
		]
		ifFalse:
			[
				scanner position: (scanner position - 2).
				^nil
			]
	].
	self display:'failed to match a date'.
	^nil
	! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 20:50'!
matchDivLines
	"Matches divorce lines. Answers the date from matchDate."

	self display: ' matching a divorce', currentToken.

	((currentToken _ scanner next) asInteger isNil) ifFalse:
	[
		((currentToken _ scanner next) = 'DIV') ifTrue:
		[
			self display: 'matched a divorce'.
			scanner next.
			^self matchDateLine.
		]
		ifFalse:
			[
				scanner position: (scanner position - 2).
				^nil
			]
	].
	self display:'failed to match a divorce'.
	^nil
	! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:52'!
matchFile
	"matches a file represenataion. It is the final rule of the grammar."

	self display: ' matching a file'.

	(self matchInitialLine) ifTrue:
	[

		self display: 'matched intialLine'.

		(self matchRecord) ifTrue:
		[

		self display: 'matched record(s)'.

			(self matchLastLine) ifTrue:
			[
				self display: 'matched last line'.
				^true
			]
		]
	].
	self display: 'failed to match the file'.
	^false

	
	
	! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:05'!
matchHeader

	"Answers the pointer name, used as a reference to the actual object being created -- I0, ... or F0,... Also, stores the pointer name used to reference to the record this header 'heads' in the table instance variable at: 1."

	| temp |

	((currentToken _ scanner next) asInteger notNil and:[ currentToken asInteger = 0]) ifTrue:
	[
		(temp _ self matchPointer) ifNotNil:  "...store the reference (I or F number) returned by matchPointer in temp ...."
		[ 
			((currentToken _ scanner next) = 'INDI') ifTrue:  " ... and if we are looking at individual record add a Person object to objs with temp as its key"
			[
				((currentToken _ scanner next) = '_el')ifTrue:
				[
					objs at: temp put: (Person new).
				]
			].
			(currentToken = 'FAM') ifTrue:  " ... do the same for a family record.."
			[
				((currentToken _ scanner next) = '_el') ifTrue:
				[
					objs at: temp put: (Family new).
				]
			].			
			^temp.  "... answer the reference (I or F number) for the record this header begins to in the file"
		]
	].
	self error! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:44'!
matchIdentifier
	"Matches an identifier. Advances the scanner."

	((currentToken _ scanner next) = 'NAME' 	or: [ currentToken = 'SEX'
												or: [ currentToken = 'BIRT'
												or: [ currentToken = 'DATE'	
												or: [ currentToken = 'PLAC'
												or: [ currentToken = 'FAMS'
												or: [ currentToken = 'FAMC'
												or: [ currentToken = 'DEAT'
												or: [ currentToken = 'HUSB'
												or: [ currentToken = 'WIFE'
												or: [ currentToken = 'CHIL'
												or: [ currentToken = 'MARR'
												or: [ currentToken = 'DIV'
												or: [ currentToken = '_ALI'
												or: [ currentToken = '_ALI_NAME'
												or: [ currentToken = '_MIS'
												or: [ currentToken = '_KEY'
												or: [ currentToken = '_VALUE']]]]]]]]]]]]]]]]]) ifTrue:[ ^currentToken ].
	^nil! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 10:30'!
matchInfoLines: aReference
	"Answers true if infoLine(s) have been matched, false otherwise. A recursive method."
		

	(self isLastLine) ifFalse:
	[
	self display: 'not a lastline - the current token is ', currentToken.

		((currentToken _ scanner next) asInteger notNil) ifTrue: " ... read in the number token at the beginning of the line ... "
		[
			((currentToken asInteger) = 0) ifFalse:
			[
				self display: 'found number'.			

				(self matchTag: aReference) ifTrue:
				[
					self display: 'recursively calling matchInfoLines'.	

					self matchInfoLines: aReference.
				]
			]
			ifTrue:
			[
				self display: 'matched last line of a record'.
				scanner position: (scanner position - 1).  "put the 0 token back "
				^true
			]
		]
		ifFalse:
		[
			self display: 'expected a number but got: ', currentToken.
		]
	].
	^true! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 12:56'!
matchInitialLine
	"Matches the very first line of the file. "

	self display: 'matching initial line'.

	((currentToken _ scanner next) asInteger notNil and: [currentToken asInteger = 0]) ifTrue:
	[
		^((currentToken _ scanner next) = 'HEAD' and:[(currentToken _ scanner next) = '_el'])
	].
	^false! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:22'!
matchLastLine
	"Matches teh very last line of the file."

	self display: 'matching last line'.

	((currentToken _ scanner next) asInteger notNil and:[ currentToken asInteger = 0]) ifTrue:
	[
		^((currentToken _ scanner next) = 'TRLR')
	].
	^false! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 15:13'!
matchMiscKey
	"Matches the _KEY line of the _MIS construct. Calls matchText to return the value of the key."

	((currentToken _ scanner next) asInteger notNil) ifTrue:
	[
		((currentToken _ scanner next) = '_KEY')ifTrue:
		[
			currentToken _ scanner next.
			^self matchText.
		]
	]! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 15:14'!
matchMiscValue
	"Matches the _VALUE line of the file. Calls matchText to return the acctul value of the line."

	((currentToken _ scanner next) asInteger notNil) ifTrue:
	[
		((currentToken _ scanner next) = '_VALUE') ifTrue:
		[
			currentToken _ scanner next.
			^ self matchText
		]
	]! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:23'!
matchMonth: aString
	"Answers if the paramater is a valid month represenataion. - One of below or an integer < 12."

	^(aString = 'JAN' 	or: [ aString = 'FEB'
						or: [ aString = 'MAR'
						or: [ aString = 'APR'
						or: [ aString = 'MAY'
						or: [ aString = 'JUN'
						or: [ aString = 'JUL'
						or: [ aString = 'AUG'
						or: [ aString = 'SEP'
						or: [ aString = 'OCT'
						or: [ aString = 'NOV'
						or: [ aString = 'DEC'
						or: [ aString asInteger notNil and:[ aString asInteger < 13]]]]]]]]]]]]])! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 18:00'!
matchPlaceLine
	"Answers the place argument from a PLAC line."

	| place |

	place _ String new.

	self display: 'matching  a place line'.

	((currentToken _ scanner next) asInteger notNil) ifTrue:
	[
		self display: ' in matchPlaceLine -- found number:', currentToken.

		(currentToken asInteger = 2) ifTrue:
		[
			self display:' number is 2'.
			((currentToken _ scanner next) = 'PLAC') ifTrue:
			[
				self display: 'got the PLAC token'.
				[(currentToken _ scanner next) = '_el'] whileFalse: "... read in all values until we hit the next line"
				[
					place _ place, ' ', currentToken.
				].
				(place size > 0) ifTrue: [((place at: 1) asString = ' ') ifTrue: [place _ place copyFrom: 2 to: (place size)]].
				self display: 'matched a place line'.
				^place
			]
			ifFalse:
			[
				scanner position: (scanner position - 1).
				^nil
			]
		]
		ifFalse:
		[
			scanner position: (scanner position - 1).
			^nil
		]		
	]
	ifFalse:
	[
		self display:'expected a number but got: ', currentToken, ' in matchPlaceLine'.
		scanner position: (scanner position - 1).
		^nil
	]! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:29'!
matchPointer
	"Answers the reference to the object being described in the file. -- I1, I2, ... or F1, F2, .... Answers nil if fail"

	|tmp i|
	self display:'matching a pointer'.

	((currentToken _ scanner next) beginsWith: '@') ifTrue:
	[
		i _ 2.
		tmp _ ''.
		[(currentToken at: i) asString = '@'] whileFalse: [ tmp _ tmp, (currentToken at: i) asString. i _ i + 1].
		^ tmp.	
	].
	self display: 'could not match a pointer'.
	^nil! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 13:00'!
matchPointer: aPointer
	"Matches the pointer from the string passed to it. Does NOT advance the currentToken - this is the difference btwn it and matchPointer."

	| tmp i|

	self display:'matching a pointer locally'.

	((aPointer) beginsWith: '@') ifTrue:
	[
		
		i _ 2.
		tmp _ ''.
		[(aPointer at: i) asString = '@'] whileFalse: [ tmp _ tmp, (aPointer at: i) asString. i _ i + 1].
		^ tmp.
	].
	self display: 'could not match a pointer'.
	^nil! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:26'!
matchRecord
	"Matches a record within a file. Records are all entries referring to a reference - the I or F number in the file."

	self display: 'matching a record'.

	(self isClosingLine) ifFalse:
	[
		self matchInfoLines: (self matchHeader).
		self matchRecord.
		^true
	]
	ifTrue:
	[	
		^true
	]
! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 21:37'!
matchTag: aReference
	"Answers if a tag has successfully been matched. Invokes appropriate methods that the tag specifies for the object pointed to by aReference parameter. "

	| id val |
	
	self display: 'matching a tag'.

	(id _ self matchIdentifier) ifNotNil:  "... store the identifier into id ..."
	[	
		val _ self matchValue.   " ... also, store the value for the identifier from above in the val variable."
	].
	
	" Now, based on the id invoke appropriate methods for the object held pointed to by aReference parameter ..."
	(id = 'NAME') ifTrue:
	[
		
		(objs at: aReference) givenName: (self firstName: val) .
		(objs at: aReference) surName: (self lastName: val).
		^true
	].
	(id = 'BIRT') ifTrue: 	
	[
		| plac |
		self display: 'matching a birth date'.
		val _ self matchDateLine.
		self display: 'matching a place'.
		plac _ self matchPlaceLine.
		self display: 'place we got was: ', plac asString.
		(plac isNil) ifTrue:
		[
			(objs at: aReference) bornDate: val.
		]
		ifFalse:
		[
			(objs at: aReference) born: val location: plac.
		].
		^true.
	].
	(id = 'DEAT') ifTrue:
	[
		| plac |
		val _ self matchDateLine.
		plac _ self matchPlaceLine.
		(val isNil) ifTrue:
		[
			(objs at: aReference) deathLocation: plac.
		]
		ifFalse: [
			(plac isNil) ifTrue:
			[
				(objs at: aReference) died: val.
			]
			ifFalse:
			[
				(objs at: aReference) died: val location: plac
			].
		].
		^true
	].
	(id = 'MARR') ifTrue:
	[
		|marr div|
		val _ self matchDateLine.
		div _ self matchDivLines.
		div ifNil:
		[
			marr _ Marriage marry:(objs at:(tempSpouse at: 1)) with: (objs at: (tempSpouse at: 2)) on: val.
		]
		ifNotNil:
		[
			marr _ Marriage marry:(objs at:(tempSpouse at: 1)) with: (objs at: (tempSpouse at: 2)) on: val divorcedOn: div.
		].

		(objs at: (tempSpouse at: 1)) addMarriage: marr.
		(objs at: (tempSpouse at: 2)) addMarriage: marr.
		^true
	].
	"(id = 'DIV') ifTrue:
	[
		| marriages |
		val _ self matchDateLine.
		((objs at: aReference) father) notNil ifTrue:
		[
			marriages _((objs at: aReference) father) marriageRelationships.
		]
		ifFalse:
		[
			((objs at: aReference) mother) notNil ifTrue:
			[
				marriages _ ((objs at: aReference) mother) marriageRelationships.
			]
		].
		marriages do: [ :marriage |  ((marriage man) == (objs at: (tempSpouse at: 1)) or: [ (marriage man) == (objs at: (tempSpouse at: 2))]) ifTrue:
									[
										((marriage woman) == (objs at: (tempSpouse at: 1)) or: [(marriage woman) == (objs at: (tempSpouse at: 2))]) ifTrue:
										[
											marriage divorcedOn: val.
										]
									]
						].
	^true
	]."
	(id = 'SEX') ifTrue:
	[
		(val = 'M') ifTrue:
		[
			(objs at: aReference) isMale.
			^true
		]
		ifFalse:
		[
			(objs at: aReference) isFemale.
			^true
		]
	].
	(id = 'FAMS') ifTrue:
	[
		(objs includesKey: val) ifFalse:
		[
			objs at: val put: (Family new).
		].
		(objs at: aReference) addFamily: (objs at: val).
		(objs at: val) addParent: (objs at: aReference).
		^true
	].
	(id = 'FAMC') ifTrue:
	[
		(objs includesKey: val) ifFalse:
		[
			objs at: val put: (Family new).
		].
		(objs at: aReference) addFamily: (objs at: val).
		(objs at: val) addChild: (objs at: aReference).
		^true
	].
	"(id = 'HUSB' or:[ id = 'WIFE']) ifTrue:
	[
		self display: 'matching a HUSB or WIFE'.
		tempSpouse addLast: val.
		^true
	]."
	(id = 'HUSB') ifTrue:	
	[
		self display: 'matching a HUSB'.
		tempSpouse at:1 put: val.
		^true
	].
	(id = 'WIFE') ifTrue:
	[
		tempSpouse at: 2 put:val.
		^true
	].
	(id = 'CHIL') ifTrue:
	[
		(objs at: aReference) addChild: (objs at: val).
		^true
	].
	(id = '_ALI') ifTrue:
	[
		(objs at: aReference) addAlias:(self matchAliasLine).
		^true
	].
	(id = '_MIS') ifTrue:
	[
		|key|
		key _ self matchMiscKey.
		val _ self matchMiscValue.
		(objs at: aReference) record: key as: val.
		^true
	].
	^false! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'tss 11/17/2002 17:57'!
matchText
	"Answers the matched text. "

	| temp textValue pos |

	temp _ scanner tokens.
	pos _ scanner position.	
	textValue _ String new.

	(self isIdentifier:(temp at: pos)) ifFalse:
	[
		[(temp at: pos) = '_el'] whileFalse:
		[
			textValue _ textValue, ' ', (temp at: pos).

			self display: 'text value holds :', textValue.
			self display: 'inside matchText -- moving currentToken to ', currentToken.

			pos _ pos + 1.
		].
		(pos - (scanner position)) timesRepeat: [currentToken _ scanner next].  "update the currentToken since we had to copy text from the stream"

		(textValue size > 0) ifTrue: [((textValue at: 1) asString = ' ') ifTrue: [textValue _ textValue copyFrom: 2 to: (textValue size)]].
		self display: 'returning value of text : ', textValue.
		^textValue
	]
	ifTrue:
	[
		self display: 'matching text was negative'.
		^nil
	]! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 14:23'!
matchValue
	"Answers the value of the token found -- the acctual data refering to the object being created. Answers nil if fail."	


	self display:'matching a value'.

	(((currentToken _ scanner next) asString) = 'M' or: [currentToken = 'F']) ifFalse:
	[
		(self testDate: currentToken) ifTrue: 
		[
			^ self matchDate 
		].
		(self testPointer: currentToken) ifTrue:
		[
			scanner next.
			^ self matchPointer:currentToken
		].
		(currentToken = '_el') ifTrue:
		[
			self display: 'found end of line as value'.
			
			^''.
		].
		^ self matchText.
	]
	ifTrue:
	[
		scanner next. " ... advace input beyons _el"
		^currentToken
	].

	self display:'returning from matching a value with nil'.
	^nil.! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/17/2002 12:55'!
parse
	"Answers a collection of people created by parsing the file or nil if fail."	

	| keys collection retCollection |
	
	collection _ OrderedCollection new.
	retCollection _ OrderedCollection new.

	(self matchFile) ifTrue:
	[
		self display:'matched entire file :-)'.
		keys _ objs keys.
		keys do:[ :key | ((key asString) beginsWith: 'I') ifTrue:[collection addLast: key]].	"get only I entries from the objs dictionary"
		collection do: [:each | retCollection addLast: (objs at: each)].
		^retCollection
	].
	^nil
! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:28'!
testDate: aDate
	"Answers if the paramter is a valid date."

	| parts |
	
	self display: 'testing a date..'.

	parts _ aDate findTokens: '/'.
	(parts size < 3) ifFalse:
	[
		((parts at: 1) isAllDigits) ifTrue:
		[
			(self matchMonth: (parts at: 2)) ifTrue:
			[
				self display: ' matched a date'.
				^((parts at: 3) isAllDigits)
			]
		]
	].
	self display: 'date test negative'.
	^false! !

!GEDCOMParser methodsFor: 'parsing' stamp: 'Dino 11/15/2002 16:28'!
testPointer: aPointer
	"Ansers if the parameter is a valid pointer."

	self display:'testing a pointer'.

	(aPointer beginsWith: '@') ifTrue:
	[
		^(aPointer endsWith: '@') 
	].
	self display: 'test is negative'.
	^false! !

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

GEDCOMParser class
	instanceVariableNames: ''!

!GEDCOMParser class methodsFor: 'as yet unclassified' stamp: 'TEO 12/5/2002 00:06'!
on: aCollection
	"Instantiates the parser class.  Points the scanner instance variable to a new instance of GEDCOMScanner."

	|temp|
	temp _ super new.
	temp initialize.
	temp scanner: (GEDCOMScanner on: aCollection).
	^temp! !


Object subclass: #GEDCOMScanner
	instanceVariableNames: 'tokens position '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!GEDCOMScanner commentStamp: '' prior: 0!
A very limited scanner built only for the purposes of this milestone. It receives a collection of tokens and returns one token at a time. To advance to the next token invoke its next method.!


!GEDCOMScanner methodsFor: 'accessing' stamp: 'Dino 11/15/2002 15:59'!
next
	"returns next token in the collectio or nil if out of tokens."

	position _ position + 1.
	(position > tokens size) ifFalse:
	[
		^(tokens at: position) asString.
	].
	^nil! !


!GEDCOMScanner methodsFor: 'initialization' stamp: 'Dino 11/15/2002 15:59'!
initialize
	"Sets the initial position within the collection of tokens to the beginning."

	position _ 0.! !


!GEDCOMScanner methodsFor: 'private' stamp: 'Dino 11/15/2002 16:00'!
position
	"Answers the value of position."

	^position! !

!GEDCOMScanner methodsFor: 'private' stamp: 'Dino 11/15/2002 16:00'!
position: aNumber
	"Sets the position to the paramater."

	position _ aNumber! !

!GEDCOMScanner methodsFor: 'private' stamp: 'Dino 11/15/2002 16:00'!
tokens
	"Returns the entire collection of tokens."

	^tokens! !

!GEDCOMScanner methodsFor: 'private' stamp: 'Dino 11/15/2002 16:01'!
tokens: aCollection
	"Sets the collection of tokens to the paramater. This is the collection that is scanned and whose values are returned by next method."

	tokens _ aCollection.! !

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

GEDCOMScanner class
	instanceVariableNames: ''!

!GEDCOMScanner class methodsFor: 'as yet unclassified' stamp: 'Dino 11/15/2002 16:03'!
on: aCollection
	"Instantiates the scanner object. Sets the tokens to be scanned to the paramater."

	| temp |
	temp _ super new.
	temp initialize.
	temp tokens: aCollection.
	^temp! !


Object subclass: #GenealogyMap
	instanceVariableNames: 'people gMapMorph selectedIndex title merging canMerge removedPeople '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!GenealogyMap commentStamp: '' prior: 0!
A GenealogyMap containes a set of people that it can manipulate at the users discretion.
The open message displays a graphical representation of the map and allows aditional abilities to interact with the contained people.!


!GenealogyMap methodsFor: 'accessors' stamp: 'tss 10/17/2002 17:42'!
addPeople: somePeople
	people addAll: somePeople.
	self changed: #people.
	^people! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:16'!
addPerson: aPerson
	"add this person to the set of people in the map, including all relatives"
	| iSet |
	iSet _ IdentitySet newFrom: people.
	iSet addAll: (aPerson relatives).
	people _ SortedCollection  sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].
	iSet do:[:thisPerson|thisPerson addDependent: self].
	people addAll: iSet.
	self changed: #people.
	^people! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:17'!
addPersonWOrelatives: aPerson
	"add person to map, but not include relatives"
	| iSet |
	iSet _ IdentitySet newFrom: people.
	iSet add: aPerson.
	people _ SortedCollection  sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].
	iSet do:[:thisPerson|thisPerson addDependent: self].
	people addAll: iSet.
	self changed: #people.
	^people! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 00:38'!
canMerge ^ canMerge! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 00:37'!
canMerge: boolean canMerge _ boolean! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 12/5/2002 00:05'!
compareToGEDCOM: filename
	"compares this gmap to another gmap contained in a GEDCOM file"
	
	"Read in the file all at once and tokenize it by the whitespace. I know this is not the prefered way to do it, but it WORKS!! :)"	

	| str tokens cr ppl gmap2 |

	[
	gmap2 _ GenealogyMap new.

	cr _ String with:(Character cr).	
	str _ (FileStream fileNamed: filename) contentsOfEntireFile.
	str _ str copyReplaceAll:cr with:' _el '.
	tokens _ str findTokens: (' '). 
		
"	Transcript show: tokens asString."

	
	((ppl _ (GEDCOMParser on: tokens) parse) notNil) ifTrue:
	[
		gmap2 addPeople: ppl.
	].
	self compareToGMap: gmap2.
	] ifError: [|menu|menu _ MenuMorph new.
			
			menu add: 'Import Failed (bad filename)!!' target: self action: #doNothing.
			menu popUpInWorld.].
! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 02:06'!
compareToGMap: gmap2
	"compares this gmap with the parameter returns the merged people"

	| merged gmapm|
	
	merged _ IdentitySet new.

	gmapm _ GenealogyMapMerged with: merged gmap1: self gmap2: gmap2.

	self merging: gmapm; canMerge: false.
	gmap2 merging: gmapm; canMerge: false; open.
	gmapm canMerge: false; open.! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/23/2002 22:03'!
export
	"collects all people in the GenealogyMap and their relatives and writes code
	 to the Transcript that when executed will rebuild the map"

	| allPeople map index toPrint|
	Transcript cr; cr.
	allPeople := IdentitySet new.
	toPrint := 'set := IdentitySet new.
'.	

	"collects people and relatives and puts them in a set"
	self people do: [ :person |
		allPeople addAll: (person relatives)
	].

	"creates a variable name for each person"
	map := Dictionary new.
	index := 0.
	allPeople do: [ :person |
		map at: person put: ('person',index asString).
		toPrint := toPrint,' set add: person',(index asString),'.
'.
		index := index+1
	].

	"for each person, have it export basic information that does not relate to others"
	allPeople do: [ :person |
		person exportBasicInfoWithVariable: (map at: person).
	].

	"for each person, have it export code that rebuilds it's relationships with others"
	allPeople do: [ :person |
		person exportRelationsInfoWithMap: map
	].

	toPrint := toPrint,'(GenealogyMap with: set) open.
'.
	Transcript show: toPrint;cr.! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 10/21/2002 12:10'!
getTerroristWarningLevel
	"returns the current terrorist warning level"

	"| mimeObj firstCueIndex secondCueIndex warningLevel thirdCueIndex |
	mimeObj _ HTTPSocket httpGetDocument: 'http://www.whitehouse.gov/homeland/'.
	firstCueIndex _ mimeObj content findString: 'threatlevel.gif'. 
	secondCueIndex _ mimeObj content findString: 
										'alt=' startingAt: firstCueIndex . 
	thirdCueIndex _ mimeObj content findString: 'PUT QUOTE HERE' startingAt: (secondCueIndex + 5).

	warningLevel _ mimeObj content copyFrom: (secondCueIndex + 5) to: (thirdCueIndex - 1).
	(warningLevel sameAs: 'Low') ifTrue: [^ Color green].
	(warningLevel sameAs: 'Guarded') ifTrue: [^ Color blue].
	(warningLevel sameAs: 'Elevated') ifTrue: [^ Color yellow].
	(warningLevel sameAs: 'High') ifTrue: [^ Color orange].
	(warningLevel sameAs: 'Severe') ifTrue: [^ Color red].
	^ Color gray."
	^ Color yellow.
 
		"DEMO OF POP UP MENUS

		(alert _ MenuMorph new)
		title: ('The current terrorist warning level is ', findTokens: ' ');
		defaultTarget: alert;
		stayUp: true;
		add: 'OK' action: #delete;
		popUpInWorld."! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 12/4/2002 22:49'!
initialize
	"initializes the GenealogyMap"

	| |
	
	merging _ nil.
	canMerge _ true.
	selectedIndex _ 1.
	people _ SortedCollection sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].
	removedPeople _ IdentitySet new.! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 00:12'!
isMerging
	^ (merging notNil)! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 00:12'!
merging
	^ merging! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/24/2002 00:21'!
merging: aMergedGMap
	merging _ aMergedGMap! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 10/21/2002 12:59'!
people
	^people reSort! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 10/21/2002 12:55'!
people: somePeople
	people _ somePeople.
	people do:[:aPerson|aPerson addDependent: self].
	self changed: #people.
	^people! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 12/4/2002 22:50'!
removePerson: aPerson
	"remove this person from the genealogy map
	does not affect the person's relatives"

	people remove: aPerson.
	removedPeople add: aPerson.
	self changed: #people.
	^people! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 12/4/2002 22:50'!
removedPeople ^ removedPeople! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:22'!
selectPerson: index
	"set the selected person in a list"

	|  |
	
	(index = 0) ifFalse: [
		selectedIndex _ index.
		self changed: #selectedPersonIndex
	].! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/23/2002 22:01'!
selectThisPerson: aPerson
	"set the selected person in a list"

	|  |
	
	aPerson ifNotNil: [
		selectedIndex _ (self people find: aPerson).
		self changed: #selectedPersonIndex
	].! !

!GenealogyMap methodsFor: 'accessors' stamp: 'tss 11/23/2002 22:01'!
selectedPerson
	"returns the selected person in the list"

	|   |
	(selectedIndex > (self people size)) ifFalse:[^ self people at: selectedIndex.] ifTrue: [^nil].! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:23'!
selectedPersonIndex
	"returns selected index"

	|  |
	
	^ selectedIndex.! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:17'!
title: t
	"set title for morph"

	|  |
	
	title _ t.! !

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:17'!
update: aspect
	"called when dependancy changes"

	|  |
	
	(aspect = #data) ifTrue: [self changed: #people.]! !


!GenealogyMap methodsFor: 'displaying' stamp: 'TEO 10/22/2002 06:17'!
closeView
	"close view"

	| |
	gMapMorph closeBoxHit.! !

!GenealogyMap methodsFor: 'displaying' stamp: 'tss 10/22/2002 03:58'!
open
	"open's this instance's GeneologyMapMorph in the world"

	| |
	gMapMorph _ GenealogyMapMorph newLabelled: title.
	gMapMorph model: self;
		paneColor: self getTerroristWarningLevel.
	self changed: #people.
	gMapMorph openInWorld.
	gMapMorph extent: 750@550.
	gMapMorph position: 20@20.! !


!GenealogyMap methodsFor: 'GEDCOM' stamp: 'tss 10/6/2002 18:51'!
doNothing
	"does nothing"! !

!GenealogyMap methodsFor: 'GEDCOM' stamp: 'tss 11/23/2002 22:06'!
exportToGEDCOM: filename
	
	| families gedcom linebreak aFile gedcomFam gedper |

	"WARNING: there may be a problem when loading in.
	If a person is in one of these families but not in the gmap then that is bad

	WARNING: If the file already exists there are unpredictable results right now."

	[families _ IdentitySet new.
	linebreak _ String crlf.
	gedcom _ '0 HEAD',  linebreak.
	gedcomFam _ ''.

	"Collect all person GEDCOM information"
	self people do: [: aPerson |
		gedper _ aPerson toGEDCOM.
		gedcom _ gedcom, (gedper at: 1).
		gedcomFam _ gedcomFam, (gedper at: 2).
		families addAll: (aPerson familialRelationships).
	].

	"Collect all family GEDCOM information"
	families do: [: aFamily |
		(aFamily children size > 0) ifTrue: [
			gedcom _ gedcom, aFamily toGEDCOM
		]
	].

	gedcom _ gedcom, gedcomFam.

	gedcom _ gedcom, '0 TRLR', linebreak.

	aFile _ FileStream fileNamed: filename.
	aFile nextPutAll: gedcom.
	aFile close.

	"Transcript show: gedcom."] ifError: [|menu|menu _ MenuMorph new.
			
			menu add: 'Export Failed (bad filename)!!' target: self action: #doNothing.
			menu popUpInWorld.].

	^ gedcom! !

!GenealogyMap methodsFor: 'GEDCOM' stamp: 'TEO 12/5/2002 00:06'!
importFromGEDCOM: filename
	"Read in the file all at once and tokenize it by the whitespace. I know this is not the prefered way to do it, but it WORKS!! :)"	

	| str tokens cr ppl |

	[cr _ String with:(Character cr).	
	str _ (FileStream fileNamed: filename) contentsOfEntireFile.
	str _ str copyReplaceAll:cr with:' _el '.
	tokens _ str findTokens: (' '). 
		
"	Transcript show: tokens asString."

	
	((ppl _ (GEDCOMParser on: tokens) parse) notNil) ifTrue:
	[
		self addPeople: ppl.
	]] ifError: [|menu|menu _ MenuMorph new.
			
			menu add: 'Import Failed (bad filename)!!' target: self action: #doNothing.
			menu popUpInWorld.].! !


!GenealogyMap methodsFor: 'as yet unclassified' stamp: 'TEO 12/2/2002 16:11'!
generateMatchReport
	"comment stating purpose of message"

	| |
	merging ifNotNil: [
		merging generateMatchReport.
	].! !

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

GenealogyMap class
	instanceVariableNames: ''!

!GenealogyMap class methodsFor: 'instance creation' stamp: 'tss 11/4/2002 00:57'!
DoNothing! !

!GenealogyMap class methodsFor: 'instance creation' stamp: 'tss 11/15/2002 17:47'!
new
	"creates and initializes a new GeneologyMap"

	| newGMap  |
	
	newGMap _ super new initialize.
	newGMap title: 'Genealogy Map'.
	^ newGMap.! !

!GenealogyMap class methodsFor: 'instance creation' stamp: 'tss 10/22/2002 03:55'!
with: aCollection
	"creates a new GenealogyMap with the people in aCollection and their relatives."

	| newGMap  |
	
	newGMap _ super new initialize.
	newGMap title: 'Genealogy Map'.
	aCollection do: [: aPerson | newGMap addPerson: aPerson].
	^ newGMap.! !

!GenealogyMap class methodsFor: 'instance creation' stamp: 'tss 10/22/2002 03:54'!
withOutRelatives: aCollection
	"creates a new GenealogyMap with the people in aCollection and their relatives."

	| newGMap  |
	
	newGMap _ super new initialize.
	newGMap title: 'Query Results'.
	aCollection do: [: aPerson | newGMap addPersonWOrelatives: aPerson].
	^ newGMap.! !


GenealogyMap subclass: #GenealogyMapMerged
	instanceVariableNames: 'gmap1 gmap2 lastMerged '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!GenealogyMapMerged commentStamp: '' prior: 0!
This is a merged version of the gmap.  It inherits from gmap.  The functionality it adds is that need to mediate the merging between two other gmaps.!


!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 23:05'!
generateMatchReport
	"creates a match report based on the gmap"

	| group1 group2 matches matchResultsWindow group3 |
	group1 := gmap1 people.
	group2 := gmap2 people.
	group3 := self justPeople.

	matches := SortedCollection new.
	group1 do: [ :person1 | group2 do: [ :person2 |
		matches add: (Match with: person1 and: person2).
	]].

	group3 do: [ :person3 |
		group1 do: [ :person1 |
			matches add: (Match with: person1 and: person3).
		].
		group2 do: [ :person2 |
			matches add: (Match with: person2 and: person3).
		].
	].

	1 to: (group3 size) do: [ :i | (i+1) to: (group3 size) do: [ :j |
		matches add: (Match with: (group3 at: i) and: (group3 at: j)).
	]].

"	matches do: [ :match | match printScores ]."

	matchResultsWindow := MatchResultsWindow new.
	matchResultsWindow mergedGenealogyMap: self matches: matches.! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 20:58'!
gmap1 ^ gmap1! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 21:54'!
gmap1: aGMap gmap1 _ aGMap! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 20:58'!
gmap2 ^ gmap2! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 21:54'!
gmap2: aGMap gmap2 _ aGMap! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/3/2002 20:44'!
justPeople
	| sortedPeople |	
	
	sortedPeople _ SortedCollection  sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].

	sortedPeople addAll: people.
		
	^sortedPeople reSort! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 18:47'!
lastMerged ^ lastMerged! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 18:47'!
lastMerged: aMergedPerson lastMerged _ aMergedPerson! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 23:12'!
match: person1 with: person2
	"runs a math and shows a report"

	| match matchResultsWindow |
	match := Match with: person1 and: person2.
	
	"display results morph"
	"match printScores."

	matchResultsWindow := MatchResultsWindow new.
	matchResultsWindow mergedGenealogyMap: self matches: (Array with: match).! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 18:49'!
merge: aPerson with: anotherPerson
	"Merges these two people
	removes them from their gmaps and merges them
	adds the resultant merged person to my people"

	| toRemove1 toRemove2 toAdd mergeArray |

	mergeArray _ MergedPerson merge: aPerson with: anotherPerson.

	toAdd _ mergeArray at: 3.	

	((gmap1 people) includes: aPerson) ifTrue:[
		toRemove1 _ mergeArray at: 1.
		toRemove2 _ mergeArray at: 2.
	] ifFalse: [
		toRemove1 _ mergeArray at: 2.
		toRemove2 _ mergeArray at: 1.
	].

	toRemove1 do: [: toRem |
		(toRem isKindOf: MergedPerson)
			ifTrue: [
				(people includes: toRem) ifTrue:[
					self removePerson: toRem
				]
			] ifFalse: [
				((gmap1 people) includes: toRem) ifTrue:[
					gmap1 removePerson: toRem
				] ifFalse: [
					gmap2 removePerson: toRem
				]
			]
	].
	toRemove2 do: [: toRem |
		(toRem isKindOf: MergedPerson)
			ifTrue: [
				(people includes: toRem) ifTrue:[
					self removePerson: toRem
				]
			] ifFalse: [
				((gmap2 people) includes: toRem) ifTrue:[
					gmap2 removePerson: toRem
				] ifFalse: [
					gmap1 removePerson: toRem
				]
			]
	].
	toAdd do: [: personToAdd | self addPersonWOrelatives: personToAdd].

	aPerson familialRelationships do: [: aFamily |
		(aFamily mother == aPerson) ifTrue: [aFamily mother: (mergeArray at: 4). 
			(mergeArray at: 4) addFamily: aFamily.
		]
	].
	aPerson familialRelationships do: [: aFamily |
		(aFamily father == aPerson) ifTrue: [aFamily father: (mergeArray at: 4).
			(mergeArray at: 4) addFamily: aFamily.
		]
	].
	anotherPerson familialRelationships do: [: aFamily |
		(aFamily mother == anotherPerson) ifTrue: [aFamily mother: (mergeArray at: 4).
			(mergeArray at: 4) addFamily: aFamily.
		]
	].
	anotherPerson familialRelationships do: [: aFamily |
		(aFamily father == anotherPerson) ifTrue: [aFamily father: (mergeArray at: 4).
			(mergeArray at: 4) addFamily: aFamily.
		]
	].

	self lastMerged: (mergeArray at: 4).! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 12:13'!
otherPeople: gmap

	(gmap == gmap1) ifTrue: [^ gmap2 people] ifFalse: [^ gmap1 people]! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 21:59'!
people
	| sortedPeople |	
	
	sortedPeople _ SortedCollection  sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].

	sortedPeople addAll: people; addAll: (gmap1 people); addAll: (gmap2 people).
		
	^sortedPeople reSort! !

!GenealogyMapMerged methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 22:54'!
unmerge
	"Unmerges the last cascade of merges"

	| toAdd1 toAdd2 toRem unmergedArray |
	
	unmergedArray _ (self lastMerged) unmerge.

	toAdd1 _ unmergedArray at: 1.
	toAdd2 _ unmergedArray at: 2.
	toRem _ unmergedArray at: 3.

	((self lastMerged) person1) familialRelationships do: [: aFamily |
		(aFamily mother == (self lastMerged)) ifTrue: [
			aFamily mother: ((self lastMerged) person1).
		]
	].
	((self lastMerged) person2) familialRelationships do: [: aFamily |
		(aFamily mother == (self lastMerged)) ifTrue: [
			aFamily mother: ((self lastMerged) person2).
		]
	].
	((self lastMerged) person1) familialRelationships do: [: aFamily |
		(aFamily father == (self lastMerged)) ifTrue: [
			aFamily father: ((self lastMerged) person1).
		]
	].
	((self lastMerged) person2) familialRelationships do: [: aFamily |
		(aFamily father == (self lastMerged)) ifTrue: [
			aFamily father: ((self lastMerged) person2).
		]
	].

	toAdd1 do: [: aPerson |
		(aPerson isKindOf: MergedPerson) 
			ifTrue: [self addPersonWOrelatives: aPerson]
			ifFalse: [
				((gmap1 removedPeople) includes: aPerson) ifTrue:[
					gmap1 addPersonWOrelatives: aPerson
				].
				((gmap2 removedPeople) includes: aPerson) ifTrue:[
					gmap2 addPersonWOrelatives: aPerson
				].
			].
	].

	toAdd2 do: [: aPerson |
		(aPerson isKindOf: MergedPerson) 
			ifTrue: [self addPersonWOrelatives: aPerson]
			ifFalse: [
				((gmap1 removedPeople) includes: aPerson) ifTrue:[
					gmap1 addPersonWOrelatives: aPerson
				].
				((gmap2 removedPeople) includes: aPerson) ifTrue:[
					gmap2 addPersonWOrelatives: aPerson
				].
			].
	].

	toRem do: [: aPerson |
		self removePerson: aPerson
	].

	self lastMerged: nil.! !

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

GenealogyMapMerged class
	instanceVariableNames: ''!

!GenealogyMapMerged class methodsFor: 'as yet unclassified' stamp: 'tss 11/23/2002 20:45'!
with: aCollection
	"creates a new GenealogyMapMerged with the people in aCollection and their relatives.
	Along with the people in gmap1 and gmap2."

	| newGMapMerged  |
	
	newGMapMerged _ super new initialize.
	newGMapMerged title: 'New Merged Genealogy Map'.
	aCollection do: [: aPerson | newGMapMerged addPerson: aPerson].
	^ newGMapMerged.
! !

!GenealogyMapMerged class methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 18:48'!
with: aCollection gmap1: gmap1 gmap2: gmap2
	"creates a new GenealogyMapMerged with the people in aCollection and their relatives.
	Along with the people in gmap1 and gmap2."

	| newGMapMerged  |
	
	newGMapMerged _ super new initialize.
	newGMapMerged title: 'New Merged Genealogy Map'.
	aCollection do: [: aPerson | newGMapMerged addPerson: aPerson].
	newGMapMerged gmap1: gmap1.
	newGMapMerged gmap2: gmap2.
	newGMapMerged lastMerged: nil.
	^ newGMapMerged.
! !


SystemWindow subclass: #GenealogyMapMorph
	instanceVariableNames: 'scrollPane rectMorph genealogyMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!GenealogyMapMorph commentStamp: '' prior: 0!
This morph is a graphical representation of the GenealogyMap.

It displays a list of people.  For any given person selected it displays that person's family tree.

By clicking on a person or the area around the people, users get menus that allow them to interact with the people, their information. and their family structure.!


!GenealogyMapMorph methodsFor: 'drawing' stamp: 'TEO 10/22/2002 06:12'!
createPerson
	"prompt user for given and sur name of a new person, adds person"

	| givenName surName person|

	givenName := FillInTheBlankMorph request: 'Enter given name' initialAnswer: 'given name'.
	(givenName = '') ifFalse: [
		surName := FillInTheBlankMorph request: 'Enter sur name' initialAnswer: 'sur name'.
		(surName = '') ifFalse: [
			person _ Person new.
			person givenName: givenName; surName: surName.
			model addPerson: person.
		].
	].! !

!GenealogyMapMorph methodsFor: 'drawing' stamp: 'TEO 12/2/2002 16:08'!
generateMatchReport
	"comment stating purpose of message"

	| |

	model generateMatchReport.! !

!GenealogyMapMorph methodsFor: 'drawing' stamp: 'tss 11/17/2002 15:16'!
popUpCompareToGEDCOM
	"prompt user for filename to read in GEDCOM from"

	| filename |

	filename _ ''.

	filename := FillInTheBlankMorph request: 'Enter filename for GEDCOM file' initialAnswer: 'fam.ged'.
	(filename = '') ifFalse: [
		model compareToGEDCOM: filename.
	].! !

!GenealogyMapMorph methodsFor: 'drawing' stamp: 'tss 11/7/2002 13:41'!
popUpExportToGEDCOM
	"prompt user for filename to write out GEDCOM to"

	| filename |

	filename _ ''.

	filename := FillInTheBlankMorph request: 'Enter filename for GEDCOM file' initialAnswer: 'fam.ged'.
	(filename = '') ifFalse: [
		model exportToGEDCOM: filename.
	].! !

!GenealogyMapMorph methodsFor: 'drawing' stamp: 'tss 11/12/2002 13:43'!
popUpImportFromGEDCOM
	"prompt user for filename to read in GEDCOM from"

	| filename |

	filename _ ''.

	filename := FillInTheBlankMorph request: 'Enter filename for GEDCOM file' initialAnswer: 'fam.ged'.
	(filename = '') ifFalse: [
		model importFromGEDCOM: filename.
	].! !


!GenealogyMapMorph methodsFor: 'initialization' stamp: 'tss 10/20/2002 14:40'!
initialize
	"initializes the morph.. most of this is done when you set the model:"

	|  |
	
	super initialize.

	

"	self addMorph: scrollPane.
	scrollPane openInWorld."
	"scrollPane _ TwoWayScrollPane new."

"	self addMorph: scrollPane fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@0 corner: 0@0 negated)
		)."! !

!GenealogyMapMorph methodsFor: 'initialization' stamp: 'TEO 10/22/2002 06:12'!
model: aModel
	"sets model and initializes some data"

	|  plugListMorph key keyLabel malePerson femalePerson pcLabel rLabel directionsLabel lcaLabel lcpLabel lcaLabel2 |
	super model: aModel.
	genealogyMap _ aModel.
	rectMorph := PersonContainerMorph new owningWindow: self.
	rectMorph model: genealogyMap.
	rectMorph setColor: (Color yellow veryMuchLighter) borderWidth: 0 borderColor: (Color black).
	plugListMorph := PluggableListMorph on: genealogyMap
		list: #people
		selected: #selectedPersonIndex
		changeSelected: #selectPerson:
		.
	plugListMorph scrollBarOnLeft: true.
	scrollPane := rectMorph inATwoWayScrollPane.

	key _ RectangleMorph new.
	keyLabel _ StringMorph contents: 'Key:'.
	key addMorph: keyLabel.
	keyLabel position: (5@5).
	malePerson _ Person new.
	malePerson surName: 'Person'; givenName: 'A Male'; isMale.
	femalePerson _ Person new.
	femalePerson surName: 'Person'; givenName: 'A Female'; isFemale.
	key addMorph: ((PersonMorph fromPerson: malePerson) position: 5@20).
	key addMorph: ((PersonMorph fromPerson: femalePerson) position: 90@20).
	pcLabel _ StringMorph contents: 'Parent/Child'.
	key addMorph: pcLabel.
	pcLabel position: (5@70).
	rLabel _ StringMorph contents: 'Relationship'.
	key addMorph: rLabel.
	rLabel position: (5@80).
	key addMorphBack: (LineMorph from: 90@80 to: 170@80 color: (Color black) width: 3).
	key addMorphBack: (LineMorph from: 3@100 to: 183@100 color: (Color black) width: 1).
	directionsLabel _ StringMorph contents: 'Directions:'.
	key addMorph: directionsLabel.
	directionsLabel position: (5@105).
	lcaLabel _ StringMorph contents: 'Click the area at right'.
	key addMorph: lcaLabel.
	lcaLabel position: (5@125).
	lcaLabel2 _ StringMorph contents: 'for a menu.'.
	key addMorph: lcaLabel2.
	lcaLabel2 position: (5@135).
	lcpLabel _ StringMorph contents: 'Click a person for a menu.'.
	key addMorph: lcpLabel.
	lcpLabel position: (5@155).

	self addMorph: plugListMorph frame: (0@0 extent: 0.25@0.65).
	self addMorph: scrollPane frame: (0.25@0 extent: 0.75@1).
	self addMorph: key frame: (0@0.65 extent: 0.25@0.35).
! !


!GenealogyMapMorph methodsFor: 'submorphs-add/remove' stamp: 'TEO 10/8/2002 23:05'!
addPerson: aPerson
	"adds a morph to the scrollpane"

	|  |
	scrollPane addMorph: ((PersonMorph fromPerson: aPerson) position: 1000@1000 ).
	scrollPane fitContents.	! !

!GenealogyMapMorph methodsFor: 'submorphs-add/remove' stamp: 'tss 10/22/2002 04:20'!
drawFamilyFor: personToDraw
	"Draws aPerson's family on the screen.
	expects an instance of a person."

	|  map deepest tempGen currGen nextGen y x largestX dicOlocations |
	
	personToDraw ifNotNil:[
	map := Dictionary new.
	personToDraw buildGenerationDictionaryIn: map withRelatives: ((personToDraw relatives) select:[:p|model people includes: p]).

	deepest _ 0.
	[map includesKey: deepest] whileTrue: [deepest _ deepest +1].
	deepest _ deepest -1.

	"line up siblings in youngest generations"
	tempGen _ OrderedCollection new.
	currGen _ map at: deepest.
	(currGen) do: [: aPerson |
		currGen remove: aPerson.
		tempGen addLast: aPerson.
		currGen do: [: other | (aPerson hasThisSibling: other)
			ifTrue: [
				currGen remove: other.
				tempGen addLast: other.
			]
		]
	].
	map at: deepest put: tempGen.
	[map includesKey: (deepest-1)] whileTrue: [
		tempGen _ OrderedCollection new.
		nextGen _ map at: (deepest - 1).
		currGen _ map at: (deepest).
		(currGen) do: [: aPerson |
			nextGen do: [: other | (aPerson hasThisParent: other)
				ifTrue: [
					nextGen remove: other.
					tempGen addLast: other.
					"tempGen addLast other's siblings"
					nextGen do: [: sibling | (other hasThisSibling: sibling) ifTrue: [
						nextGen remove: sibling.
						tempGen addLast: sibling.
					]]
				]
			]
		].
		tempGen addAllLast: nextGen.
		map at: (deepest - 1) put: tempGen.
		deepest _ deepest -1.
	].

	"clear display"
	rectMorph removeAllMorphs.

	"display family, from left to right and save positions"
	dicOlocations _ Dictionary new.
	y _ 50.
	largestX _ 100.
	deepest _ 0.
	[map includesKey: deepest] whileTrue: [deepest _ deepest -1].
	deepest _ deepest + 1.
	[map includesKey: deepest] whileTrue: [
		x _ 100.
		(map at: deepest) do: [: aPerson |
			(aPerson == personToDraw) ifTrue: [self addSpecialPerson: aPerson at: x@y.]
				ifFalse: [self addPerson: aPerson at: x@y.].
			dicOlocations add: (Association key: aPerson value: (x+40)@(y+10)).
			x _ x + 100.
		].
		(x > largestX) ifTrue: [largestX _ x].
		y _ y + 100.
		deepest _ deepest +1.
	].

	"Draw the relationship lines"
	dicOlocations keysAndValuesDo: [: aPerson : aLoc | 
		aPerson familialRelationships ifNotNil: [
			aPerson familialRelationships do: [: aFamily|
				(aFamily hasParent:aPerson) ifTrue: [
					aFamily children do: [: aChild |
						dicOlocations at: (aChild) ifPresent: [: dest |
							"pen  place: aLoc;goto: dest"
							rectMorph addMorphBack: (LineMorph from: aLoc to: dest color: (Color black) width: 3)
						]
					]
				].
				((aFamily children) includes: aPerson) ifTrue: [((aFamily children) reject: [:p|p==self])
					do: [: aChild |
						dicOlocations at: (aChild) ifPresent: [: dest |
							"pen  place: aLoc;goto: dest"
							rectMorph addMorphBack: (LineMorph from: aLoc to: dest color: (Color blue) width: 3)
						]
					]
				]
			]
		]
	].

	"resize the rectMorph"
	rectMorph extent: (largestX + 100)@(y).
	scrollPane fitContents.
]! !


!GenealogyMapMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:13'!
update: aspect
	"called when a dependancy changes"

	| |
	aspect = #people ifTrue: [self drawFamilyFor: (model selectedPerson)].
	aspect = #selectedPersonIndex ifTrue: [self drawFamilyFor: (model selectedPerson)].! !

!GenealogyMapMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:14'!
updatePeopleObsolete: somePeople
	"depreciated....old code for old way of thinking...not called"
	| disjointCollectionOfConnectedFammilyGraphs currentConnectedGraph peopleLeft numElem y x largestY connectedFamilyGenerations dictionaryOfGenerations deepest largestX lastLargestX tempGen currGen nextGen |
	
	"make a copy of the people identity set"
	peopleLeft _ OrderedCollection newFrom: model people.

	"init disjointSetOfConnectedFammilyGraphs"
	disjointCollectionOfConnectedFammilyGraphs _ IdentitySet new.
	[peopleLeft size > 0] whileTrue: [
		"init currentConnectedGraph"
		currentConnectedGraph _ OrderedCollection with: (peopleLeft removeFirst).

		"remove all relative of each element of currentConnectedGraph
		  from peopleLeft and add them to currentConnectedGraph"
		currentConnectedGraph do: [: aConnectedPerson | 
			(aConnectedPerson relatives) do: [: aRelative |
				numElem _ peopleLeft size.
				peopleLeft removeAllSuchThat: [: aPerson | aPerson == aRelative].
				(numElem > peopleLeft size) ifTrue: [currentConnectedGraph addLast: aRelative]
			]
		].
		disjointCollectionOfConnectedFammilyGraphs add: currentConnectedGraph
	].
	"self chooseMagnification."

	"TEO's code here"
	connectedFamilyGenerations := OrderedCollection new.
	disjointCollectionOfConnectedFammilyGraphs do: [ :connectedFamily |
		dictionaryOfGenerations := Dictionary new.
		(connectedFamily at: 1) buildGenerationDictionaryIn: dictionaryOfGenerations
			 withRelatives: (connectedFamily copyFrom: 1 to: (connectedFamily size)).
		connectedFamilyGenerations addLast: dictionaryOfGenerations.
	].

	"reorder the generations such that parents line up with their kids"
	connectedFamilyGenerations do: [: dicOgen | 
		deepest _ 0.
		[dicOgen includesKey: deepest] whileTrue: [deepest _ deepest +1].
		deepest _ deepest -1.

		"line up siblings in youngest generations"
		tempGen _ OrderedCollection new.
		currGen _ dicOgen at: deepest.
		(currGen) do: [: aPerson |
			currGen remove: aPerson.
			tempGen addLast: aPerson.
			currGen do: [: other | (aPerson hasThisSibling: other)
				ifTrue: [
					currGen remove: other.
					tempGen addLast: other.
				]
			]
		].
		dicOgen at: deepest put: tempGen.
		Transcript show: 'Bottom = ', deepest asString ;cr.
		[dicOgen includesKey: [deepest-1]] whileTrue: [
			tempGen _ OrderedCollection new.
			nextGen _ dicOgen at: (deepest - 1).
			currGen _ dicOgen at: (deepest).
			(currGen) do: [: aPerson |
				nextGen do: [: other | (aPerson hasParent: other)
					ifTrue: [
						nextGen remove: other.
						tempGen addLast: other.
					]
				]
			].
			tempGen addAllLast: nextGen.
			dicOgen at: (deepest - 1) put: tempGen.
			deepest _ deepest -1.
		].
	].

	"clear display"
	rectMorph removeAllMorphs.

	"display each extended family, from left to right"
	largestX _ 0.
	largestY _ 0.
	connectedFamilyGenerations do: [: dicOgen | 
		y _ 0.
		deepest _ 0.
		lastLargestX _ largestX.
		[dicOgen includesKey: deepest] whileTrue: [deepest _ deepest -1].
		deepest _ deepest + 1.
		[dicOgen includesKey: deepest] whileTrue: [
			x _ lastLargestX.
			(dicOgen at: deepest) do: [: aPerson |
				self addPerson: aPerson at: x@y.
				x _ x + 100.
			].
			(x > largestX) ifTrue: [largestX _ x].
			y _ y + 100.
			deepest _ deepest +1.
		].
		(y > largestY) ifTrue: [largestY _ y].
	].
	
	"resize the rectMorph"
	rectMorph extent: (x + 100)@(largestY + 100)

	"disjointCollectionOfConnectedFammilyGraphs do: [: connectedGraph | 
		y _ 100.
		connectedGraph do: [: aPerson | self addPerson: aPerson at: (x)@y. y _ y + 100. x _ x + 100].
		(y > largestY) ifTrue: [largestY _ y].
	]."! !


!GenealogyMapMorph methodsFor: 'top window' stamp: 'tss 10/19/2002 14:00'!
activate
	"Make me unable to respond to mouse and keyboard"

	|  |
	super activate.
	"Transcript show: 'activating'; cr."
	scrollPane unlock.
	rectMorph unlock.! !

!GenealogyMapMorph methodsFor: 'top window' stamp: 'TEO 10/22/2002 06:11'!
addPerson: aPerson at: aPoint
	"add PersonMorph at aPoint"

	| |
	rectMorph addMorph: ((PersonMorph fromPerson: aPerson owner: genealogyMap) position: aPoint).! !

!GenealogyMapMorph methodsFor: 'top window' stamp: 'TEO 10/22/2002 06:11'!
addSpecialPerson: aPerson at: aPoint
	"add a special person at point"

	| |
	rectMorph addMorph: ((PersonMorph specialFromPerson: aPerson owner: genealogyMap) position: aPoint).! !

!GenealogyMapMorph methodsFor: 'top window' stamp: 'tss 10/19/2002 14:09'!
passivate
	"Make me unable to respond to mouse and keyboard"

	|  |
	super passivate.
	"Transcript show: 'passivating'; cr."
	scrollPane lock.
	rectMorph lock.! !

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

GenealogyMapMorph class
	instanceVariableNames: ''!

!GenealogyMapMorph class methodsFor: 'instance creation' stamp: 'tss 10/17/2002 17:52'!
new
	"creates a new GeneologyMapMorph"
	^ super labelled: 'GenealogyMap'! !

!GenealogyMapMorph class methodsFor: 'instance creation' stamp: 'tss 10/22/2002 03:56'!
newLabelled: label
	"creates a new GeneologyMapMorph"
	^ super labelled: label! !


Object subclass: #Marriage
	instanceVariableNames: 'man woman marriedDate divorcedDate uniqueID '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!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 11/16/2002 20:37'!
hasSpouse: spouse
	"returns true if the passed in person object is 
	present as the man or woman in this marriage"
	^ (spouse == man) or: [spouse == woman].! !

!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 11/16/2002 20:02'!
uniqueID ^ uniqueID! !

!Marriage methodsFor: 'as yet unclassified' stamp: 'tss 11/16/2002 20:01'!
uniqueID: id uniqueID _ id! !

!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 11/16/2002 20:01'!
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 uniqueID: (Family GetNextUniqueID) asString.
	^ marriage.! !

!Marriage class methodsFor: 'as yet unclassified' stamp: 'tss 11/16/2002 20:01'!
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 uniqueID: (Family GetNextUniqueID) asString.
	^ marriage.! !


Object subclass: #Match
	instanceVariableNames: 'person1 person2 givenNameScore surNameScore genderScore aliasScore miscScore bornScore deathScore infoScore fatherScore motherScore childrenScore spouseScore '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!Match commentStamp: 'TEO 12/4/2002 23:50' prior: 0!
A Match object measures the closeness of the data and relatives of the two people passed in the class message.  Call "score" for the value of the score.!


!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:42'!
< aMatch
	"returns true if this Matches score is less than than aMatch's score"


	^ self score < aMatch score.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:42'!
<= aMatch
	"returns true if this Matches score is less than or equal to than aMatch's score"

	^ self score <= aMatch score.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:43'!
aliasScore
	"returns the score for the closeness of the aliases. Range: 0,3"

	| col1 col2 toRet |
	aliasScore ifNil: [
		aliasScore := 0.
		col1 := person1 aliases.
		col2 := person2 aliases.

		col1 do: [ :alias1 | col2 do: [ :alias2 |
			((alias1 includesSubString: alias2) or: [alias2 includesSubString: alias1]) ifTrue: [
				aliasScore := aliasScore + 1.
			].
		]].
		(aliasScore>3) ifTrue: [ aliasScore := 3 ].
	].
	toRet := aliasScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:44'!
bornScore
	"returns the score for the closeness of the birth info. Range: 0,5"

	| toRet date1 date2 loc1 loc2 |
	bornScore ifNil: [
		bornScore := 0.
	
		"DOB"
		date1 := person1 bornDate.
		date2 := person2 bornDate.
		bornScore := bornScore + (self scoreForDate: date1 and: date2).
				
		"location"
		loc1 := person1 bornLocation.
		loc2 := person2 bornLocation.
		((loc1 = '') and: [loc2 = '']) ifFalse: [
			(loc1 = loc2) ifTrue: [
				bornScore := bornScore + 2.
			] ifFalse: [
				((loc1 includesSubString: loc2) or: [loc2 includesSubString: loc1]) ifTrue: [
					bornScore := bornScore + 1.
				].
			].
		].
	].
	toRet := bornScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:46'!
childrenScore
	"returns the score for the closeness of the children. Range: 0,10"

	| children1 toRet children2 |
	childrenScore ifNil: [
		children1 := person1 children.
		children2 := person2 children.
		childrenScore := 0.

		children1 do: [ :child1 | children2 do: [ :child2 |
			((Match with: child1 and: child2) infoScore > 25) ifTrue: [
				childrenScore := childrenScore + 2.
			]
		]].
		(childrenScore > 10) ifTrue: [ childrenScore := 10 ].
	].
	toRet := childrenScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:46'!
deathScore
	"returns the score for the closeness of the death info. Range: 0,5"

	| toRet date1 date2 loc1 loc2 |
	deathScore ifNil: [
		deathScore := 0.
	
		"DOB"
		date1 := person1 deathDate.
		date2 := person2 deathDate.
		deathScore := deathScore + (self scoreForDate: date1 and: date2).
		
		"location"
		loc1 := person1 deathLocation.
		loc2 := person2 deathLocation.
		((loc1 = '') and: [loc2 = '']) ifFalse: [
			(loc1 = loc2) ifTrue: [
				deathScore := deathScore + 2.
			] ifFalse: [
				((loc1 includesSubString: loc2) or: [loc2 includesSubString: loc1]) ifTrue: [
					deathScore := deathScore + 1.
				].
			].
		].
	].
	toRet := deathScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:45'!
fatherScore
	"returns the score for the closeness of the fathers. Range: -10,15"

	| dad1 dad2 toRet |
	fatherScore ifNil: [
		fatherScore := 0.

		dad1 := person1 father.
		dad2 := person2 father.
		dad1 ifNotNil: [
			dad2 ifNotNil: [
				fatherScore := (Match with: dad1 and: dad2) infoScore // 2 - 10.
			].
		].
	].
	toRet := fatherScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:45'!
genderScore
	"returns the score for the closeness of the genders. Range: -5,5"

	| toRet |
	genderScore ifNil: [
		(person1 isFemaleGender = person2 isFemaleGender) ifTrue: [
			genderScore := 5.
		] ifFalse: [
			genderScore := -5.
		].
	].
	toRet := genderScore.
	^toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:45'!
givenNameScore
	"returns the score for the closeness of the given names. Range: 0,12"

	| toRet soundex1 soundex2 |
	givenNameScore ifNil: [
		soundex1 := self soundexCodeFor: person1 givenName.		
		soundex2 := self soundexCodeFor: person2 givenName.
		((soundex1 = '') and: [ soundex2 = '' ]) ifTrue: [
			givenNameScore := 0.
		] ifFalse: [
			(soundex1 = soundex2) ifTrue: [
				(person1 givenName = person2 givenName) ifTrue: [
					givenNameScore := 12.
				] ifFalse: [
					givenNameScore := 10.
				].
			] ifFalse: [	
				((person1 givenName includesSubString: (person2 givenName)) or: [
						person2 givenName includesSubString: (person1 givenName)]) ifTrue: [
					givenNameScore := 5.
				] ifFalse: [
					givenNameScore := 0.
				].
			].
		].

	].
	toRet := givenNameScore.
	^toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:45'!
infoScore
	"returns the sum of the vital information closeness.  Range: -5,25"

	| toRet |
	toRet := 0.
	toRet := toRet + self givenNameScore.
	toRet := toRet + self surNameScore.
	toRet := toRet + self genderScore.
	toRet := toRet + self bornScore.
	toRet := toRet + self deathScore.
	toRet := toRet + self aliasScore.
	toRet := toRet + self miscScore.
	
	^toRet.
 ! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:45'!
miscScore
	"returns the score for the closeness of the misc. records. Range: 0,3"

	| col1 col2 toRet value1 value2 |
	miscScore ifNil: [
		miscScore := 0.
		col1 := person1 miscRecords.
		col2 := person2 miscRecords.

		col1 keysDo: [ :key1 | col2 keysDo: [ :key2 |
			((key1 includesSubString: key2) or: [key2 includesSubString: key1]) ifTrue: [
				value1 := (col1 at: key1) asString.
				value2 := (col2 at: key2) asString.
				((value1 includesSubString: value2) or: [value2 includesSubString: value1])
					ifTrue: [
						miscScore := miscScore + 1.
				].
			].
		]].
		(miscScore>3) ifTrue: [ miscScore := 3 ].
	].
	toRet := aliasScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:46'!
motherScore
	"returns the score for the closeness of the mothers. Range: -10,15"

	| toRet mom1 mom2 |
	motherScore ifNil: [
		motherScore := 0.

		mom1 := person1 mother.
		mom2 := person2 mother.
		mom1 ifNotNil: [
			mom2 ifNotNil: [
				motherScore := (Match with: mom1 and: mom2) infoScore // 2 - 10.
			].
		].
	].
	toRet := motherScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/2/2002 16:13'!
person1
	"comment stating purpose of message"


	^person1.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/2/2002 16:13'!
person2
	"comment stating purpose of message"


	^person2.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:46'!
printScores
	"prints the scores of the match to transcript"

	Transcript cr.
	Transcript show: (person1 asStringOrText), ' and ', (person2 asStringOrText);cr.
	Transcript show: 'Info: ', (self infoScore asString);cr.	
	Transcript show: 'Relationships: ', (self relationshipScore asString);cr.
	Transcript show: 'Total: ', (self score asString);cr.
! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:47'!
printSummary
	"prints a full summary of scores of the match to the Transcript"

	Transcript cr.
	Transcript show: (person1 asStringOrText), ' and ', (person2 asStringOrText);cr.
	Transcript show: 'Given Name: ', (self givenNameScore asString);cr.
	Transcript show: 'Sur Name: ', (self surNameScore asString);cr.
	Transcript show: 'Gender: ', (self genderScore asString);cr.
	Transcript show: 'Born: ', (self bornScore asString);cr.
	Transcript show: 'Death: ', (self deathScore asString);cr.
	Transcript show: 'Alias: ', (self aliasScore asString);cr.
	Transcript show: 'Misc Records: ', (self miscScore asString);cr.
	Transcript show: 'Info: ', (self infoScore asString);cr;cr.	

	Transcript show: 'Father: ', (self fatherScore asString);cr.
	Transcript show: 'Mother: ', (self motherScore asString);cr.
	Transcript show: 'Children: ', (self childrenScore asString);cr.
	Transcript show: 'Spouses: ', (self spouseScore asString);cr.
	Transcript show: 'Relationships: ', (self relationshipScore asString);cr;cr.

	Transcript show: 'Total: ', (self score asString);cr.
! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:47'!
relationshipScore
	"returns the score for the closeness of the relationships. Range: -20,50"

	| toRet |
	toRet := 0.
	toRet := toRet + self fatherScore.
	toRet := toRet + self motherScore.
	toRet := toRet + self childrenScore.
	toRet := toRet + self spouseScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:47'!
score
	"returns the score for the closeness of the people. Range: -25,100"

	| toRet |
	toRet := self infoScore + self relationshipScore.
	^toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:48'!
scoreForDate: date1 and: date2
	"returns the score for the closeness of two dates. Range: 0,3"

	| diff |
	date1 ifNotNil: [ date2 ifNotNil: [
		(date1 = date2) ifTrue: [
			^ 3.
		] ifFalse: [
			((date1 dayOfMonth = date2 dayOfMonth) 
				and: [ date1 month = date2 month ]) ifTrue: [
				^ 2.
			] ifFalse: [
				(((date1 month = date2 month) or: [date1 dayOfMonth = date2 dayOfMonth])
					and: [date1 year = date2 year]) ifTrue: [
		
					^ 2.
				] ifFalse: [
					diff := date1 asJulianDayNumber - date2 asJulianDayNumber.
					((diff >= -365) and: [ diff <= 365 ]) ifTrue: [
						^ 1.
					].
				].
			].				
		].
	]].
	^ 0.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:48'!
soundexCodeFor: name
	"returns the Soundex code for a name"

	| toRet codes upper last next |
	(name size = 0) ifTrue: [ ^''. ].

	upper := name select: [ :a | true ].
	upper := upper translateToUppercase.
	codes := #('BFPV' 'CGJKQSXZ' 'DT' 'L' 'MN' 'R' 'AEIOUY').
	toRet := ((upper at: 1) asString).
	last := -1.
	1 to: (codes size) do: [ :index | 
		( (codes at: index) includes: (upper at: 1) ) ifTrue: [ last := index ]
	].
	(last = 7) ifTrue: [ last := 0 ].
	next := last.
	(upper size > 1) ifTrue: [
		2 to: (upper size) do: [ :index |
			last := next.
			1 to: (codes size) do: [ :index2 |
				( (codes at: index2) includes: (upper at: index) ) ifTrue: [ next := index2 ]
			].
			"Transcript show: ('Last: ',last asString,' Next: ',next asString); cr."
			(next = 7) ifTrue: [ next := 0 ] ifFalse: [
				(next = last) ifFalse: [
					toRet := toRet, (next asString).
				]
			].
		]
	].
	[toRet size < 4 ] whileTrue: [
		toRet := toRet, '0'.
	].
	^ toRet copyFrom: 1 to: 4.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:48'!
spouseScore
	"returns the score for the closeness of the spouses. Range: 0,10"

	| toRet spouses1 spouses2 |
	spouseScore ifNil: [
		spouses1 := person1 spouses.
		spouses2 := person2 spouses.
		spouseScore := 0.

		spouses1 do: [ :spouse1 | spouses2 do: [ :spouse2 |
			((Match with: spouse1 and: spouse2) infoScore > 25) ifTrue: [
				spouseScore := spouseScore + 5.
			]
		]].
		(spouseScore > 10) ifTrue: [ spouseScore := 10 ].
	].
	toRet := spouseScore.
	^ toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:48'!
surNameScore
	"returns the score for the closeness of the surnames. Range: 0,17"

	| toRet soundex1 soundex2 |
	surNameScore ifNil: [
		soundex1 := self soundexCodeFor: person1 surName.		
		soundex2 := self soundexCodeFor: person2 surName.		
		((soundex1 = '') and: [ soundex2 = '' ]) ifTrue: [
			surNameScore := 0.
		] ifFalse: [
			(soundex1 = soundex2) ifTrue: [
				(person1 surName = person2 surName) ifTrue: [
					surNameScore := 17.
				] ifFalse: [
					surNameScore := 15.
				].
			] ifFalse: [	
				((person1 surName includesSubString: (person2 surName)) or: [
						person2 surName includesSubString: (person1 surName)]) ifTrue: [
					surNameScore := 10.
				] ifFalse: [
					surNameScore := 0.
				]
			].
		].
	].
	toRet := surNameScore.
	^toRet.! !

!Match methodsFor: 'as yet unclassified' stamp: 'TEO 12/1/2002 14:18'!
with: newPerson1 and: newPerson2
	"sets persons of Match"

	| |
	person1 := newPerson1.
	person2 := newPerson2.! !

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

Match class
	instanceVariableNames: ''!

!Match class methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:49'!
with: person1 and: person2
	"creates a Match object for measuring the closeness of two people"

	| toRet |
	toRet := super new.
	toRet with: person1 and: person2.
	^toRet.! !


RectangleMorph subclass: #MatchResultsMorph
	instanceVariableNames: 'model match '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!MatchResultsMorph commentStamp: 'TEO 12/4/2002 23:51' prior: 0!
Displays the results of a Match object passed in and allows the user to merge the people of the match object together.!


!MatchResultsMorph methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:54'!
initializeWith: aMatch model: aModel
	"creates morph to display report of the Match object's scores.  Allows user to merge people
	 involved in Match"

	| y x dx mergeButton |

	model := aModel.
	match := aMatch.
	
	self color: (Color yellow veryMuchLighter).
	self borderWidth: 0.
	self extent: 350@200.

	x := 10.
	dx := 160.
	y := 5.
	self addMorph: ((StringMorph new) 
		position: (x@y); 
		contents: ((match person1 asStringOrText),' and ', (match person2 asStringOrText)) ).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Given Name: ',(match givenNameScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Father: ',(match fatherScore asString))).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Sur Name: ',(match surNameScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Mother: ',(match motherScore asString))).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Gender: ',(match genderScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Children: ',(match childrenScore asString))).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Birth Data: ',(match bornScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Spouses : ',(match spouseScore asString))).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Death Data: ',(match deathScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Vitals: ',(match infoScore asString));
		emphasis: 1).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Aliases: ',(match aliasScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Relationships: ',(match relationshipScore asString));
		emphasis: 1).
	y := y+21.

	self addMorph: ((StringMorph new)
		position: (x@y);
		contents: ('Misc. Records: ',(match miscScore asString))).
	self addMorph: ((StringMorph new)
		position: (x+dx@y);
		contents: ('Total: ',(match score asString));
		emphasis: 3).
	y := y+21.

	mergeButton := PluggableButtonMorph on: self 
		getState: nil 
		action: #merge.
	mergeButton label: 'Merge'; position: ((self width//3)@y).
	self addMorph: mergeButton.
	y := y+21.! !

!MatchResultsMorph methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:54'!
merge
	"tell model to merge two people"

	|  |
	
	"match printScores."
	model merge: (match person1) with: (match person2).! !


SystemWindow subclass: #MatchResultsWindow
	instanceVariableNames: 'gMap matches introMorph '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!MatchResultsWindow commentStamp: 'TEO 12/4/2002 23:52' prior: 0!
Displays the results of a SortedCollection of Match objects and passes any merge messages to the GenealogyMapMerged.  Closes self after merge is selected.  Also displays an explaination of the scores in a separate morph (closes that morph when closing self).!


!MatchResultsWindow methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:52'!
delete
	"deletes self and the morph containing an explaination of Match scoring"

	| |
	[introMorph delete] ifError: [].
	super delete.! !

!MatchResultsWindow methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:53'!
merge: person1 with: person2
	"closes self and passes along message to merge two people"

	self delete.
	gMap merge: person1 with: person2.! !

!MatchResultsWindow methodsFor: 'as yet unclassified' stamp: 'TEO 12/4/2002 23:53'!
mergedGenealogyMap: map matches: matchList
	"creates the morph and displays the Match objects passed in.  Also displays the explaination
	 of the Match scoring."

	| matchContainer y reversed dy introTextMorph introClose |
	gMap := map.
	matches := matchList.

	"draw window"
	self paneColor: (Color yellow).
	self setLabel: 'Match Results'.
	self openInWorld.
	self extent: (400@500); position: 400@20.

	matchContainer := RectangleMorph new.
	matchContainer color: (Color yellow veryMuchLighter); borderWidth: 0.	
	self addMorph: (matchContainer inATwoWayScrollPane) frame: (0@0 extent: 1@1).

	y := 0.
	dy := 200.

	introMorph := RectangleMorph new.
	introMorph extent: (400@400).
	introMorph color: (Color black); borderWidth: 1.
	introClose := PluggableButtonMorph on: introMorph
		getState: nil
		action: #delete.
	introMorph addMorph: (introClose label: 'X'; position:(0@380)).
	introTextMorph := TextMorph new.
	introMorph addMorph: (introTextMorph).
	introTextMorph fillingOnOff; color: (Color green).
	introTextMorph contentsWrapped: 'Scores are based on two parts, a comparison of the vital ',
		'statistics of the two people, and a comparison of the vital statistics of their relatives.  ',
		'The vital scores range from -5 to 50.  The relatives scores range from -20 to 50.  ',
		'For the given name and last name, if the names are an exact match, the score for ',
		'that aspect is worth 12 and 17, respectively.  If their Soundex codes match, ',
		'it is worth 10 and 15 points respectively.  If one is contained in the other, it is worth ',
		'5 and 10 points respectively.  If their genders match, it is worth 5 points, otherwise ',
		'-5.  If dates match (birth and death dates are scored separately), it is worth 3 points.  ',
		'If the only one of the day, month, or year are different, it is worth 2 points.  If the ',
		'difference in dates is less than a year, it is worth one point.  If the locations are an ',
		'exact match, it is worth 2 points.  If one is contained in the other, it is worth one ',
		'point.  If any two aliases are a match or one is contained in the other, it is worth 1 ',
		'for each match, up to a maximum of 3 points.  If any two records have the names ',
		'and the values contained within each other, it is worth one point for each match, ',
		'with a maximum of three.  The sum of these is the vital score.  The father score is ',
		'takes the vital score from the two fathers and scales it to a range of -10 to 15.  The ',
		'same is done with the mothers.  If either parent is unknown for either person, the ',
		'score is zero for that part.  For any pair of children that have a vital score of ',
		'25 or more, that is worth 2 points, up to a maximum of 10.  For any pair of spouses ',
		'that have a vital score of 25 or more, that is worth 5 points, up to a maximum of ',
		'10.  These compose the relatives score.  The sum of the vital score and the relatives '.
		'score is the total score.'.		

	introMorph openInWorld.
	"matchContainer addMorph: (introMorph position: (0@y)).
	y := y + dy + dy."

	reversed := OrderedCollection new.
	matches do: [ :object | reversed addFirst: object ].
	reversed do: [ :match |
		matchContainer addMorph: ((MatchResultsMorph new) 
			initializeWith: match model: self;
			position: (0@y) ).
			y := y + dy.
	].

! !


RectangleMorph subclass: #MediateMergeMorph
	instanceVariableNames: 'person1 person2 givenNameField1 givenNameField2 givenNamePair surNameField1 surNameField2 surNamePair birthdateField1 birthdateField2 birthDatePair birthplaceField1 birthplaceField2 birthPlacePair deathdateField1 deathdateField2 deathDatePair deathplaceField1 deathplaceField2 deathPlacePair genderField1 genderField2 genderPair done '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!MediateMergeMorph commentStamp: '' prior: 0!
This morph allows a user to select between to people who's information to use in a new merged person.!


!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 14:27'!
accept
	done _ true! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:48'!
birthDatePair ^ birthDatePair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:48'!
birthPlacePair ^birthPlacePair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:49'!
deathDatePair ^ deathDatePair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:49'!
deathPlacePair ^ deathPlacePair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:49'!
genderPair ^ genderPair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 14:25'!
getUserResponse
	"Wait for the user to accept or cancel, and answer the result MediateMergeMorph. Answers nil."
	"Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."

	| w |
	w _ self world.
	w ifNil: [^ nil].
	[done] whileFalse: [World doOneCycle].
	self delete.
	World doOneCycle.
	^ self! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:48'!
givenNamePair ^ givenNamePair! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 17:54'!
initialize

	" this one really does the initializing of the morph"

	|  closeButton |

	super initialize.
	self extent: 550@200.

	"givenName"
	givenNameField1 := StringMorph new.
	self addMorph: (givenNameField1 position: 5@12).	
	givenNameField2 := StringMorph new.
	self addMorph: (givenNameField2 position: 300@12).
	givenNamePair _ RadioButtonPairMorph new.
	self addMorph: (givenNamePair position: 240@12).

	"surName"
	surNameField1 := StringMorph new.
	self addMorph: (surNameField1 position: 5@33).
	surNameField2 := StringMorph new.
	self addMorph: (surNameField2 position: 300@33).
	surNamePair _ RadioButtonPairMorph new.
	self addMorph: (surNamePair position: 240@33).

	"birthdate"
	birthdateField1 := StringMorph new.
	self addMorph: (birthdateField1 position: 5@54).
	birthdateField2 := StringMorph new.
	self addMorph: (birthdateField2 position: 300@54).
	birthDatePair _ RadioButtonPairMorph new.
	self addMorph: (birthDatePair position: 240@52).

	"birthplace"
	birthplaceField1 := StringMorph new.
	self addMorph: (birthplaceField1 position: 5@75).
	birthplaceField2 := StringMorph new.
	self addMorph: (birthplaceField2 position: 300@75).
	birthPlacePair _ RadioButtonPairMorph new.
	self addMorph: (birthPlacePair position: 240@75).

	"deathdate"
	deathdateField1 := StringMorph new.
	self addMorph: (deathdateField1 position: 5@96).
	deathdateField2 := StringMorph new.
	self addMorph: (deathdateField2 position: 300@96).
	deathDatePair _ RadioButtonPairMorph new.
	self addMorph: (deathDatePair position: 240@96).

	"deathplace"
	deathplaceField1 := StringMorph new.
	self addMorph: (deathplaceField1 position: 5@117).
	deathplaceField2 := StringMorph new.
	self addMorph: (deathplaceField2 position: 300@117).
	deathPlacePair _ RadioButtonPairMorph new.
	self addMorph: (deathPlacePair position: 240@117).

	"gender"
	genderField1 := StringMorph new.
	self addMorph: (genderField1 position: 5@138).
	genderField2 := StringMorph new.
	self addMorph: (genderField2 position: 300@138).
	genderPair _ RadioButtonPairMorph new.
	self addMorph: (genderPair position: 240@138).

	"MiscRecords"
	"miscLabel := StringMorph new.
	miscLabel contents: 'Misc'.
	self addMorph: (miscLabel position: 5@250).
	misc2Label := StringMorph new.
	misc2Label contents: 'Records:'.
	self addMorph: (misc2Label position: 5@265).
	selectMiscIndex _ 0.
	miscList := PluggableListMorph on: self
		list: #miscRecords
		selected: #selectedMiscIndex
		changeSelected: #selectMisc:
		.
	miscList scrollBarOnLeft: true.
	miscList extent: 180@50.
	self addMorph: (miscList position: 5@236).
	addMiscEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpaddMiscEdit.
	addMiscEdit label: 'Add Misc Record'.
	self addMorph: (addMiscEdit position: 5@255)."
	
	"Close button"
	closeButton := PluggableButtonMorph on: self
					getState: nil
					action: #accept.
	closeButton label: 'Accept'.
	self addMorph: (closeButton position: 243@170).
	done _ false.
! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:29'!
mouseEnter: evt
	self set.! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 13:38'!
person1 ^person1! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 13:52'!
person1: aPerson person1_ aPerson.

	person1 ifNotNil:[
		givenNameField1 contents: 'Given Name: ',(person1 givenName).
		surNameField1 contents: 'Sur Name: ',(person1 surName).
		birthdateField1 contents: 'Birthdate: ', (person1 bornDate asString).
		birthplaceField1 contents: 'Birthplace: ', (person1 bornLocation asString).
		deathdateField1 contents: 'Deathdate: ', (person1 deathDate asString).
		deathplaceField1 contents: 'Death Location: ', (person1 deathLocation asString).
		genderField1 contents: 'Gender: ', (person1 isFemaleGender ifNotNilDo:[: isFemale | 
			isFemale ifTrue: ['Female'] ifFalse: ['Male']]).
	]! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 13:38'!
person2 ^person2! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 14:03'!
person2: aPerson person2_ aPerson.

	person2 ifNotNil:[
		givenNameField2 contents: 'Given Name: ',(person2 givenName).
		surNameField2 contents: 'Sur Name: ',(person2 surName).
		birthdateField2 contents: 'Birthdate: ', (person2 bornDate asString).
		birthplaceField2 contents: 'Birthplace: ', (person2 bornLocation asString).
		deathdateField2 contents: 'Deathdate: ', (person2 deathDate asString).
		deathplaceField2 contents: 'Death Location: ', (person2 deathLocation asString).
		genderField2 contents: 'Gender: ', (person2 isFemaleGender ifNotNilDo:[: isFemale | 
			isFemale ifTrue: ['Female'] ifFalse: ['Male']]).
	]! !

!MediateMergeMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:48'!
surNamePair ^ surNamePair! !


!MediateMergeMorph methodsFor: 'nil' stamp: 'tss 12/4/2002 15:40'!
mouseDown: evt

	self set.! !

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

MediateMergeMorph class
	instanceVariableNames: ''!

!MediateMergeMorph class methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:48'!
between: person1 and: person2
	"creates a new mediated merge morph to mediate the merge
	between person1 and person2"

	| toRet |

	toRet _ self new.
	toRet person1: person1; person2: person2.
	toRet openInWorld.
	toRet getUserResponse.
	^ toRet.! !


Object subclass: #Person
	instanceVariableNames: 'givenName surName isFemale aliases familialRelationships marriageRelationships bornDate bornLocation deathDate deathLocation miscRecords uniqueID '
	classVariableNames: 'AllPersons NextUniqueID '
	poolDictionaries: ''
	category: 'm7'!
!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 11/7/2002 12:14'!
initialize
	givenName := String new.
	surName := String new.
	aliases := OrderedCollection new.
	familialRelationships := IdentitySet new.
	marriageRelationships := IdentitySet new.
	bornLocation := String new.
	deathLocation := String new.
	miscRecords := Dictionary new.! !


!Person methodsFor: 'conversions' stamp: 'tss 10/20/2002 14:25'!
asStringOrText
	"returns surName, givenName"
	
	^ self surName, ', ', self givenName! !


!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 13:16'!
addAlias: alias
	"Adds an alias to this person.
	The alias is stored an idenity set.
	Accepts a String."
	aliases ifNil: [aliases _ OrderedCollection new.].
	aliases add: alias.
	self changed: #data.! !

!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 10/21/2002 01:55'!
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.
	self changed: #data.
	^ 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 10/21/2002 01:52'!
bornDate: date
	"assings the date born.
	expects a Date object."
	bornDate _ date.
	self changed: #data.! !

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

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:52'!
bornLocation: location
	"assigns the location of birth.
	Expects a String."
	bornLocation _ location.
	self changed: #data.! !

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

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:52'!
deathDate: date
	"Assigns the date I died.
	Expects a Date."
	deathDate _ date.
	self changed: #data.! !

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

	| |
	^ deathLocation.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:52'!
deathLocation: location
	"sets death location
	expects a string"

	| |
	deathLocation _ location.
	self changed: #data.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:52'!
died: date
	"Same as deathDate.
	Assigns the deathDate.
	Expects a Date."
	self deathDate: date.
	self changed: #data.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:53'!
died: date location: location
	"Same as deathDate. & deathLocation
	Assigns the deathDate. & deathLocation
	Expects a Date. & a string"
	self deathDate: date.
	self deathLocation: location.
	self changed: #data.! !

!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 10/31/2002 13:15'!
father
	familialRelationships do: [: aFamily |
		(aFamily hasChild: self) ifTrue: [^ aFamily father]
	].
	^ nil! !

!Person methodsFor: 'accessors' stamp: 'tss 11/7/2002 12:43'!
genderString
	"returns 'F' if person is female 'M' if male"

	isFemale ifNil: [^ 'M'].

	isFemale ifTrue: [^ 'F'].

	^ 'M'.! !

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

!Person methodsFor: 'accessors' stamp: 'TEO 10/20/2002 22:39'!
givenName: newGivenName
	"Assign the given name.
	accepts a String."
	givenName _ newGivenName.
	self changed: #data.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 23:57'!
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.
			self changed: #data.
		^ 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. 	self changed: #data.^ 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. 	self changed: #data.^ 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: [	self changed: #data.^familyChild] "Nothing to do... Family object already had the data"
			ifFalse: 
				[familyParents mergeWith: familyChild.
				(familyChild children) do:
					[: childElem | 
					childElem removeFamilialRelationship: familyChild.
					childElem addFamily: familyParents].
				self changed: #data.
				^ familyParents.]
		].! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 23:35'!
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. 	self changed: #data.^ familySelf.].

	"If i don't know who my mother is"
	(familySelf mother) ifNil: [familySelf father: dad.  dad addFamily: familySelf. 	self changed: #data.^ 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. 	self changed: #data.^ familySelf].

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

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 23:34'!
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. 	self changed: #data.^ familySelf.].

	"If i don't know who my father is"
	(familySelf father) ifNil: [familySelf mother: mom.  mom addFamily: familySelf. 	self changed: #data.^ 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.	self changed: #data. ^ familySelf].

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

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 23:04'!
hasSibling: sibling
	"Sets up family information for havein given person as my sibling.
	expects a Person object"

	| familySelf familySibling |
	
	sibling ifNil: [^ nil].

	"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.
		self changed: #data.
		^ familySelf.].

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

	"if my sibling has a family but i don't"
	( ((familySibling isNil) not) and: [familySelf isNil] ) ifTrue:
		[familySibling addChild: self. self addFamily: familySibling. 	self changed: #data.^ familySibling.].
	
	"If we are both children in families"
	( ((familySibling isNil) not) and: [(familySelf isNil) not] ) ifTrue:
		[(familySibling == familySelf)
			ifTrue: [	self changed: #data.^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.].
					self changed: #data.^ familySelf.]
		].
	! !

!Person methodsFor: 'accessors' stamp: 'tss 10/20/2002 13:55'!
hasThisParent: aPerson
	"returns true if aPerson is a parent of me"

	|  |
	familialRelationships do: [: aFamily | (aFamily hasParent: aPerson) ifTrue: [^ true]].
	^ false.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/20/2002 01:45'!
hasThisSibling: aPerson
	"returns true if person passed in is a sibling"

	|  |

	familialRelationships do: [: aFamily | ((aFamily hasChild: self) and: [aFamily hasChild: aPerson]) ifTrue: [^ true]].
	^ false.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:54'!
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]]].
	self changed: #data.! !

!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 10/21/2002 01:54'!
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]]].
	self changed: #data.! !

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

!Person methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:10'!
marriageRelationshipsCollection
	"returns collection of text descriptions of marriages"

	| toRet |
	toRet _ OrderedCollection new.
	self marriageRelationships do: [:marriage | 
		toRet add: (
			(marriage divorcedOn) ifNil:[
				(marriage  man == self) 
				ifTrue: [marriage woman asStringOrText, ' on ', (marriage marriedOn asString)]
				ifFalse: [marriage man asStringOrText, ' on ', (marriage marriedOn asString)]
			]
			ifNotNil:[
				(marriage  man == self) 
				ifTrue: [marriage woman asStringOrText, ' on ', (marriage marriedOn asString), 
					' divorced on ', ((marriage divorcedOn) asString)]
				ifFalse: [marriage man asStringOrText, ' on ', (marriage marriedOn asString), 
					' divorced on ', ((marriage divorcedOn) asString)]
			]
		)
	].
	^  toRet! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:55'!
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.
	self changed: #data.! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:55'!
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.
	self changed: #data.! !

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

!Person methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:10'!
miscRecordsCollection
	"returns collection of Strings representing the miscellaneous information"
	| toRet |
	toRet _ OrderedCollection new.
	miscRecords keysAndValuesDo: [:key :value| toRet add: (key asString , ' = ', value asString)].
	^  toRet! !

!Person methodsFor: 'accessors' stamp: 'tss 10/31/2002 13:16'!
mother
	familialRelationships do: [: aFamily |
		(aFamily hasChild: self) ifTrue: [^ aFamily mother]
	].
	^ nil! !

!Person methodsFor: 'accessors' stamp: 'tss 10/21/2002 01:55'!
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).
	self changed: #data.! !

!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 11/24/2002 21:11'!
removeFamily: family
	"removes a family relationship.
	Accepts a Family object.
	The inputed family is removed from the collection."

	familialRelationships remove: family ifAbsent:[].! !

!Person methodsFor: 'accessors' stamp: 'tss 11/24/2002 16:50'!
siblings
	familialRelationships do: [: aFamily |
		(aFamily hasChild: self) ifTrue: [^ aFamily children]
	].
	^ nil! !

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

!Person methodsFor: 'accessors' stamp: 'TEO 10/20/2002 22:41'!
surName: newSurName
	"assigns my sur name.
	expects a string."

	surName _ newSurName.
	self changed: #data.! !

!Person methodsFor: 'accessors' stamp: 'tss 11/16/2002 21:34'!
toGEDCOM
	| gedcom gedcomFam linebreak tmp marriedNoKids foundMarriage curr famStrings tmpString |
	famStrings _ IdentitySet new.
	gedcom _ ''.
	gedcomFam _ ''.
	linebreak _ String crlf.

	"0 @ID@ INDI"
	gedcom _ gedcom, '0 @', self uniqueID, '@ INDI', linebreak.

	"1 NAME givenName /surName/"
	gedcom _ gedcom, '1 NAME ', givenName, ' /', surName, '/', linebreak.

	"1 SEX M"
	gedcom _ gedcom, '1 SEX ', self genderString, linebreak.

	"1 BIRT"
	((bornDate notNil) or: [bornLocation size > 0]) ifTrue: [
		gedcom _ gedcom, '1 BIRT', linebreak.	
			bornDate ifNotNil: [
				"2 DATE 10 JAN 1836"
				gedcom _ gedcom, '2 DATE ', bornDate mmddyyyy, linebreak.
			].
			(bornLocation size > 0) ifTrue: [
				"2 PLAC Cuba, Allegheny, NY"
				gedcom _ gedcom, '2 PLAC ', bornLocation, linebreak.
			]
	].

	"1 DEAT"
	((deathDate notNil) or: [deathLocation size > 0]) ifTrue: [
		gedcom _ gedcom, '1 DEAT', linebreak.	
			deathDate ifNotNil: [
				"2 DATE 08 JUN 1902"
				gedcom _ gedcom, '2 DATE ', deathDate mmddyyyy, linebreak.
			].
			(deathLocation size > 0) ifTrue: [
				"2 PLAC De Smet, Kingsbury, Dakota Territory"
				gedcom _ gedcom, '2 PLAC ', deathLocation, linebreak.
			]
	].

	"aliases"
	aliases do: [: alias |
		[
			tmp _ '2 _ALI_NAME ', alias, linebreak.
			"1 _ALI"
			gedcom _ gedcom, '1 _ALI', linebreak.
			"2 _ALI_NAME"
			gedcom _ gedcom, tmp
		] ifError: []
	].

	"misc records"
	miscRecords keysAndValuesDo: [:key :value |
		[
			tmp _ '2 _KEY ', key, linebreak.
			tmp _ tmp, '2 _VALUE ', value, linebreak.
			"1 _MIS"
			gedcom _ gedcom, '1 _MIS', linebreak.
			"2 _KEY"
			"2 _VALUE"
			gedcom _ gedcom, tmp
		] ifError: []
	].

		marriedNoKids _ IdentitySet new.
		self marriageRelationships do: [: aMarriage |
			Transcript show: (aMarriage marriedOn mmddyyyy);cr.
				foundMarriage _ false.
				(self familialRelationships) do: [: aFamily |
					((aFamily hasParent: self) and: [aFamily children size > 0]) ifTrue: [foundMarriage _ true]].
				foundMarriage ifFalse: [
					marriedNoKids add: aMarriage.
				]
		].
		marriedNoKids do: [: aMarriage |
			curr _ IdentitySet new.
			"marriedNoKids remove: aMarriage."
			curr add: aMarriage.
			tmpString _ 'F9999', aMarriage uniqueID.
			marriedNoKids  do: [: aMarriage2 |
				((aMarriage2 woman == aMarriage woman) and: [aMarriage2 man == aMarriage man]) ifTrue: [
					"marriedNoKids remove: aMarriage2."
					curr add: aMarriage2.
					tmpString _ tmpString, aMarriage2 uniqueID
				]
			].
			marriedNoKids removeAll: curr.
			famStrings add: tmpString.

			((aMarriage man) == self) ifTrue:[
			"0 @ID@ FAM"
			gedcomFam _ gedcomFam, '0 @', tmpString, '@ FAM', linebreak.

			"1 HUSB @I2@"
			gedcomFam _ gedcomFam, '1 HUSB @', aMarriage man uniqueID, '@', linebreak.

			"1 WIFE @I3@"
			gedcomFam _ gedcomFam, '1 WIFE @', aMarriage woman uniqueID, '@', linebreak.
			
			curr do: [: aMarriage2 |
					"1 MARR"
					gedcomFam _ gedcomFam, '1 MARR' , linebreak.

						"2 DATE 01 FEB 1860"
						gedcomFam _ gedcomFam, '2 DATE ', aMarriage2 marriedOn mmddyyyy, linebreak.

						"2 PLAC Concord, Jefferson, WI"
						"NOT SUPPORTED"
					(aMarriage2 divorcedOn) ifNotNil: [
						"1 DIV"
						gedcomFam _ gedcomFam, '1 DIV' , linebreak.

							"2 DATE 01 FEB 1860"
							gedcomFam _ gedcomFam, '2 DATE ', aMarriage2 divorcedOn mmddyyyy, linebreak.
		
							"2 PLAC Concord, Jefferson, WI"
							"NOT SUPPORTED"
					]
			]]
		].

	"families"
	(self familialRelationships) do: [: aFam |

		"families where i am a child"
		(aFam hasChild: self) ifTrue: [
			"1 FAMC @F2@"
			gedcom _ gedcom, '1 FAMC @', aFam uniqueID, '@', linebreak
		].

		"families where i am a parent"
		((aFam hasParent: self) and: [aFam children size > 0]) ifTrue: [
			"1 FAMS @F3@"
			gedcom _ gedcom, '1 FAMS @', aFam uniqueID, '@', linebreak
		]

	].
	famStrings do: [: id | gedcom _ gedcom, '1 FAMS @', id, '@', linebreak ].

	"Transcript show: gedcom."

	^ Array with: gedcom with: gedcomFam
! !

!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: 'tss 10/22/2002 05:07'!
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 ifAbsent:[nil])) ifTrue: trueBlock
	].
	"checks birth location and death location"
	query livedIn ifNotNil: [
		(    ( self bornLocation includesSubString: (query livedIn)  ) or: 
			[ self deathLocation includesSubString: (query livedIn) ])
			ifTrue: trueBlock.

		miscRecords ifNotNil: [
			miscRecords keys do: [ :key | (key includesSubString: query livedIn) 
				ifTrue: trueBlock
			].
			miscRecords values do: [ :value | (value includesSubString: query livedIn)
				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 10/30/2002 23:38'!
checkResults
	"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.! !

!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 methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:41'!
addAncestorsTo: relativeList

	"add self to list and recurse to parents (if they exist)"

	"only add self and recurse if not already in list"
	(relativeList includes: self) ifFalse: [
		relativeList add: self.
		self addSiblingsTo: relativeList.
		familialRelationships do: [ :family |
			(family hasChild: self) ifTrue: [
				family father ifNotNil: [
					family father addAncestorsTo: relativeList
				].
				family mother ifNotNil: [
					family mother addAncestorsTo: relativeList
				]
			]
		]
	].! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:36'!
addDecendentsTo: relativeList

	"add children to Collection and recurse"

	"only do if person not part of list yet, to prevent cycles"
	(relativeList includes: self) ifFalse: [
		relativeList add: self.
		familialRelationships do: [ :family |
			(family hasParent: self) ifTrue: [
				family children do: [ :child |
					"recurse!!"
					child addDecendentsTo: relativeList
				]
			]
		]
	].! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:30'!
addSiblingsTo: relativeList

	"add siblings to Collection passed in"
	familialRelationships do: [ :family |
		(family hasChild: self) ifTrue: [
			relativeList addAll: family children
		]
	].
	^ relativeList.! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/19/2002 19:29'!
buildGenerationDictionaryIn: dictionaryOfGenerations withRelatives: connectedFamily

	"calls helper message that gives the number to start"
	self buildGenerationDictionaryIn: dictionaryOfGenerations
			withRelatives: connectedFamily
			startingAt: 0.! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/19/2002 19:49'!
buildGenerationDictionaryIn: dictionaryOfGenerations withRelatives: connectedFamily 	startingAt: generationIndex

	"builds a dictionary with keys of numbers and values of collections
	 the key indicates which generation it is
	 the value is the Person instances in the generation
	"

	| currentGeneration |
	(connectedFamily includes: self) ifTrue: [
		
		"remove from connected family to prevent cycles"
		connectedFamily remove: self.

		"adds an IdentitySet for the generation if one does not exist yet"
		(dictionaryOfGenerations includesKey: generationIndex) ifFalse: [
			dictionaryOfGenerations at: generationIndex put: (IdentitySet new).
		].
		currentGeneration := dictionaryOfGenerations at: generationIndex.
		currentGeneration add: self.
		
		familialRelationships do: [ :family |

			"recurse over parents"
			(family children includes: self) ifTrue: [
				(family father) ifNotNil: [
					family father buildGenerationDictionaryIn: dictionaryOfGenerations
									withRelatives: connectedFamily
									startingAt: (generationIndex-1).
				].
				(family mother) ifNotNil: [
					family mother buildGenerationDictionaryIn: dictionaryOfGenerations
									withRelatives: connectedFamily
									startingAt: (generationIndex-1).
				].
			].

			"recurse over children"
			(family hasParent: self) ifTrue: [
				family children do: [ :child |
					child buildGenerationDictionaryIn: dictionaryOfGenerations
							withRelatives: connectedFamily
							startingAt: (generationIndex+1).
				].
			].

			"recurse over siblings"
			(family children includes: self) ifTrue: [
				family children do: [ :child |
					(child == self) ifFalse: [
						child buildGenerationDictionaryIn: dictionaryOfGenerations
								withRelatives: connectedFamily
								startingAt: generationIndex.
					].
				].
			].
		]. "end familialRelationships"
	].! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 12/1/2002 16:47'!
children
	"comment stating purpose of message"

	| toRet |
	toRet := IdentitySet new.
	self familialRelationships do: [ :family |
		(family hasParent: self) ifTrue: [
			toRet addAll: family children.
		].
	].
	^ toRet.! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:28'!
exportBasicInfoWithVariable: variable

	"write code to Transcript for reloading basic information"

	| toPrint |

	"create new instance of person"
	toPrint := variable,' := Person new.
	'.

	"given name"
	givenName ifNotNil: [ toPrint := toPrint,variable,' givenName: ',$' asString,givenName,$' asString,'.
	'
	].

	"sur name"
	surName ifNotNil: [ toPrint := toPrint,variable,' surName: ',$' asString,surName,$' asString,'.
	'
	].

	"aliases"
	aliases do: [ :alias | toPrint := toPrint,variable,' addAlias: ',$' asString,alias,$' asString,'.
	'
	].

	"gender"
	self isFemaleGender ifTrue: [ toPrint := toPrint,variable,' isFemale.
	'
	] ifFalse: [ toPrint := toPrint,variable,' isMale.
	'
	].

	"birthday"
	bornDate ifNotNil: [
		toPrint := toPrint,variable,' born: (Date newDay: ', (bornDate day asString),
			"' month: ', (bornDate month asString),"
			' year: ', (bornDate year asString),' )'.
		bornLocation ifNotNil: [ toPrint := toPrint,' location:',$' asString,bornLocation,$' asString ].
		toPrint := toPrint,'.
	'
	].

	"death day"
	deathDate ifNotNil: [
		toPrint := toPrint,variable,' died: (Date newDay: ', (deathDate day asString),
			"' month: ', (deathDate month asString),"
			' year: ', (deathDate year asString),' )'.
		deathLocation ifNotNil: [ toPrint := toPrint,' location:',$' asString,deathLocation,$' asString ].
		toPrint := toPrint,'.
	'
	].

	"record:as: info"
	miscRecords keysAndValuesDo: [ :key :value |
		toPrint := toPrint,variable,' record: ',$' asString,key,$' asString,' as: ',$' asString,value,$' asString,'.
	'
	].
	Transcript show: toPrint.! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:26'!
exportRelationsInfoWithMap: map

	"writes code to rebuild relationships
	 map is a relationship from a person to its variable in the export"

	| toPrint variable spouse |
	toPrint := ''.
	variable := map at: self.
	familialRelationships do: [ :family |
		"don't need children because other parent would need to be known AND
		 relationship can be built from child to parent (a hasFather/hasMother: b)"
		"
		(family hasParent: self) ifTrue: [
			family children do: [ :child |
				toPrint := toPrint,variable,' hasChild: ',(map at: child),'.
	'
			]
		].
		"
		
		"code for father/mother relationships"
		(family hasChild: self) ifTrue: [
			family father ifNotNil: [
				toPrint := toPrint,variable,' hasFather: ',(map at: family father),'.
	'
			].
			family mother ifNotNil: [
				toPrint := toPrint,variable,' hasMother: ',(map at: family mother),'.
	'
			].

			"code for siblings"
			family children do: [ :child |
				(child == self) ifFalse: [
					toPrint := toPrint,variable,' hasSibling: ',(map at: child),'.
	'
				]
			]
		]
	].
	"for marriages; marriages different than sharing children"
	marriageRelationships do: [ :marriage |
		(self == marriage man) ifTrue: [
			spouse := marriage woman
		] ifFalse: [
			spouse := marriage man
		].

		"don't try to write code if spouse isn't in the map, 
		 because their variable name isn't known"
		(map includesKey: spouse) ifTrue: [
			toPrint := toPrint,variable,' married: ',(map at: spouse).
			toPrint := toPrint,' on: (Date newDay: ', (marriage marriedOn day asString),
				"' month: ', (marriage marriedOn month asString),"
				' year: ', (marriage marriedOn year asString),' )'.

			"only do divorce if divorced"
			marriage divorcedOn ifNotNil: [
				toPrint := toPrint,' divorced: (Date newDay: ', (marriage divorcedOn day asString),
					"' month: ', (marriage divorcedOn month asString),"
					' year: ', (marriage divorcedOn year asString),' )'.
			].
			toPrint := toPrint,'.
	'
		]
	].
	Transcript show: toPrint.! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 10/18/2002 22:21'!
relatives
	"builds a set of relatives of person"

	| anc dec |
	anc := IdentitySet new.
	dec := IdentitySet new.
	"toRet add: self."
	self addAncestorsTo: anc.
	self addDecendentsTo: dec.
	anc addAll: dec.
	^ anc.
! !

!Person methodsFor: 'as yet unclassified' stamp: 'TEO 12/1/2002 17:22'!
spouses
	"comment stating purpose of message"

	| toRet |
	toRet := IdentitySet new.
	
	self marriageRelationships do: [ :marriage |
		toRet add: marriage man.
		toRet add: marriage woman.
	].
	toRet remove: self ifAbsent: [].
	^ toRet.
	! !

!Person methodsFor: 'as yet unclassified' stamp: 'tss 11/7/2002 12:12'!
uniqueID ^ 'I', (uniqueID asString)! !

!Person methodsFor: 'as yet unclassified' stamp: 'tss 11/7/2002 11:37'!
uniqueID: id uniqueID _ id! !

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

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: 'tss 11/7/2002 11:37'!
new
	"comment stating purpose of message"

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

	"sets class variables if not instantiated yet"
	AllPersons ifNil: [ AllPersons := WeakSet new ].
	NextUniqueID ifNil: [NextUniqueID _ 0].

	"sets the unique id"
	temp uniqueID: NextUniqueID.
	NextUniqueID _ NextUniqueID + 1.

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


Person subclass: #MergedPerson
	instanceVariableNames: 'person1 person2 mergedDad mergedMom newFam '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!MergedPerson commentStamp: '' prior: 0!
This represents two people who have been merged together.  It holds all the information needed to unmerge the two peolple.!


!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 17:15'!
initialize
	super initialize.! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 16:44'!
mergedDad ^ mergedDad! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 17:15'!
mergedDad: aPerson mergedDad _ aPerson! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 16:44'!
mergedMom ^ mergedMom! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 17:15'!
mergedMom: aPerson mergedMom _ aPerson! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 20:26'!
newFam: fam newFam _ fam! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 15:30'!
person1 ^ person1! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 15:29'!
person1: aPerson person1 _ aPerson! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 15:30'!
person2 ^ person2! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 11/24/2002 15:29'!
person2: aPerson person2 _ aPerson! !

!MergedPerson methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 22:30'!
unmerge
	"unmerges up the tree"

	| toAdd1 toAdd2 toRem unmergedArray |
	
	toAdd1 _ IdentitySet new.
	toAdd2 _ IdentitySet new.
	toRem _ IdentitySet new.

	"if mother clash recursivley unmerge"
	mergedMom ifNotNil: [
		unmergedArray _ mergedMom unmerge.
		toAdd1 addAll: (unmergedArray at: 1).
		toAdd2 addAll: (unmergedArray at: 2).
		toRem addAll: (unmergedArray at: 3).
		toAdd1 add: (person1 mother).
		toAdd2 add: (person2 mother).
		toRem add: mergedMom.
		(person1 mother) familialRelationships do: [: aFamily |
			((aFamily mother == mergedMom) and: [(aFamily hasChild: person1) not]) ifTrue: [
				aFamily mother: (person1 mother).
			]
		].
		(person2 mother) familialRelationships do: [: aFamily |
			((aFamily mother == mergedMom) and: [(aFamily hasChild: person2) not]) ifTrue: [
				aFamily mother: (person2 mother).
			]
		].
	] ifNil: [
		"give new fam the appropriate mom or none at all"
		(person1 mother) ifNotNil: [
			(person1 mother) familialRelationships do: [: aFamily |
				(aFamily mother == (person1 mother)) ifTrue: [
					(person1 mother) addFamily: aFamily 
				]
			].
			(person1 mother) removeFamily: newFam.
		]. 
		(person2 mother) ifNotNil: [
			(person2 mother) familialRelationships do: [: aFamily |
				(aFamily mother == (person2 mother)) ifTrue: [
					(person2 mother) addFamily: aFamily 
				]
			].
			(person2 mother) removeFamily: newFam.
		]. 
	].

	"if father clash recursivley unmerge"
	mergedDad ifNotNil: [
		unmergedArray _ mergedDad unmerge.
		toAdd1 addAll: (unmergedArray at: 1).
		toAdd2 addAll: (unmergedArray at: 2).
		toRem addAll: (unmergedArray at: 3).
		toAdd1 add: (person1 father).
		toAdd2 add: (person2 father).
		toRem add: mergedDad.
		(person1 father) familialRelationships do: [: aFamily |
			((aFamily father == mergedDad) and: [(aFamily hasChild: person1) not]) ifTrue: [
				aFamily father: (person1 father).
			]
		].
		(person2 father) familialRelationships do: [: aFamily |
			((aFamily father == mergedDad) and: [(aFamily hasChild: person2) not]) ifTrue: [
				aFamily father: (person2 father).
			]
		].
	] ifNil: [
		"give new fam the appropriate mom or none at all"
		(person1 father) ifNotNil: [
			(person1 father) familialRelationships do: [: aFamily |
				(aFamily father == (person1 father)) ifTrue: [
					(person1 father) addFamily: aFamily 
				]
			].
			(person1 father) removeFamily: newFam.
		]. 
		(person2 father) ifNotNil: [
			(person2 father) familialRelationships do: [: aFamily |
				(aFamily father == (person2 father)) ifTrue: [
					(person2 father) addFamily: aFamily 
				]
			].
			(person2 father) removeFamily: newFam.
		]. 
	].

	"revert to my old immidiate family"
	person2 familialRelationships do: [: aFamily |
		(aFamily hasChild: person2) ifTrue: [
			(aFamily children reject: [: p | p == person1]) do:
				[: p | p removeFamily: newFam. p addFamily: aFamily.].
			(aFamily mother) ifNotNil:[(aFamily mother) addFamily: aFamily].
			(aFamily father) ifNotNil:[(aFamily father) addFamily: aFamily].
		]
	].
	person1 familialRelationships do: [: aFamily |
		(aFamily hasChild: person1) ifTrue: [
			(aFamily children reject: [: p | p == person1]) do:
				[: p | p removeFamily: newFam. p addFamily: aFamily.].
			(aFamily mother) ifNotNil:[(aFamily mother) addFamily: aFamily].
			(aFamily father) ifNotNil:[(aFamily father) addFamily: aFamily].
		]
	].

	"updating marriages"
	(person1 marriageRelationships) do: [: aMarr |
		(aMarr man == self) ifTrue:[aMarr man: person1].
		(aMarr woman == self) ifTrue:[aMarr woman: person1].		
	].
	(person2 marriageRelationships) do: [: aMarr |
		(aMarr man == self) ifTrue:[aMarr man: person2].
		(aMarr woman == self) ifTrue:[aMarr woman: person2].		
	].

	toAdd1 add: person1.
	toAdd2 add: person2.
	toRem add: self.
	^ (Array with: toAdd1 with: toAdd2 with: toRem with: self)! !

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

MergedPerson class
	instanceVariableNames: ''!

!MergedPerson class methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 22:38'!
merge: person1 with: person2

	| merged toRemove1 toRemove2 toAdd mergeArray newFam mediater |

	toRemove1 _ IdentitySet new.
	toRemove2 _ IdentitySet new.
	toAdd _ IdentitySet new.
	newFam _ Family new.

	merged _ super new.
	merged mergedMom: nil.
	merged mergedDad: nil.
	
	merged person1: person1.
	merged person2: person2.

	"Figure out what data to copy"
	mediater _ MediateMergeMorph between: person1 and: person2.
	
	"copy over data from either person1 or person2"
	(mediater givenNamePair zeroIsSet)
		ifTrue:[merged givenName: (person1 givenName).]
		ifFalse:[merged givenName: (person2 givenName).].

	(mediater surNamePair zeroIsSet)
		ifTrue:[merged surName: (person1 surName).]
		ifFalse:[merged surName: (person2 surName).].
	
	(mediater genderPair zeroIsSet)
		ifTrue:[(person1 isFemaleGender) ifTrue: [merged isFemale] ifFalse: [merged isMale].]
		ifFalse:[(person2 isFemaleGender) ifTrue: [merged isFemale] ifFalse: [merged isMale].].

	(mediater birthDatePair zeroIsSet)
		ifTrue:[merged bornDate: (person1 bornDate).]
		ifFalse:[merged bornDate: (person2 bornDate).].
	
	(mediater birthPlacePair zeroIsSet)
		ifTrue:[merged bornLocation: (person1 bornLocation).]
		ifFalse:[merged bornLocation: (person2 bornLocation).].

	(mediater deathDatePair zeroIsSet)
		ifTrue:[merged died: (person1 deathDate).]
		ifFalse:[merged died: (person2 deathDate).].
	
	(mediater deathPlacePair zeroIsSet)
		ifTrue:[merged deathLocation: (person1 deathLocation).]
		ifFalse:[merged deathLocation: (person2 deathLocation).].

	"Combine Aliases"
	(person1 aliases) do: [: alias | merged addAlias: alias].
	(person2 aliases) do: [: alias | merged addAlias: alias].

	"Combine MiscInfo"
	(person1 miscRecords) keysAndValuesDo: [: key :value | merged record: key as: value].
	(person2 miscRecords) keysAndValuesDo: [: key :value | merged record: key as: value].

	"if mother clash recursivley merge"
	((person1 mother notNil) and: 
		[person2 mother notNil] and: [((person1 mother) == (person2 mother)) not]) ifTrue: [
		mergeArray _ MergedPerson merge: (person1 mother) with: (person2 mother).
		toRemove1 addAll: (mergeArray at: 1).
		toRemove2 addAll: (mergeArray at: 2).
		toAdd addAll: (mergeArray at: 3).
		toRemove1 add: (person1 mother).
		toRemove2 add: (person2 mother).
		merged mergedMom: (mergeArray at: 4).
		merged mergedMom addFamily: newFam.
		(person1 mother) familialRelationships do: [: aFamily |
			((aFamily mother == (person1 mother)) and: [(aFamily hasChild: person1) not]) ifTrue: [
				aFamily mother: (merged mergedMom).
			]
		].
		(person2 mother) familialRelationships do: [: aFamily |
			((aFamily mother == (person2 mother)) and: [(aFamily hasChild: person2) not]) ifTrue: [
				aFamily mother: (merged mergedMom).
			]
		].
		newFam mother: (merged mergedMom).
	] ifFalse: [
		"give new fam the appropriate mom or none at all"
		(person1 mother) ifNotNil: [
			newFam mother: (person1 mother).
			(person1 mother) familialRelationships do: [: aFamily |
				(aFamily mother == (person1 mother)) ifTrue: [
					(person1 mother) removeFamily: aFamily 
				]
			].
			(person1 mother) addFamily: newFam.
		]. 
		(person2 mother) ifNotNil: [
			newFam mother: (person2 mother).
			(person2 mother) familialRelationships do: [: aFamily |
				(aFamily mother == (person2 mother)) ifTrue: [
					(person2 mother) removeFamily: aFamily 
				]
			].
			(person2 mother) addFamily: newFam.
		]. 
	].

	"if fathers clash recursivley merge"
	((person1 father notNil) and:
		[person2 father notNil] and: [((person1 father) == (person2 father)) not]) ifTrue: [
		mergeArray _ MergedPerson merge: (person1 father) with: (person2 father).
		toRemove1 addAll: (mergeArray at: 1).
		toRemove2 addAll: (mergeArray at: 2).
		toAdd addAll: (mergeArray at: 3).
		toRemove1 add: (person1 father).
		toRemove2 add: (person2 father).
		merged mergedDad: (mergeArray at: 4).
		merged mergedDad addFamily: newFam.
		(person1 father) familialRelationships do: [: aFamily |
			((aFamily father == (person1 father)) and: [(aFamily hasChild: person1) not]) ifTrue: [
				aFamily father: (merged mergedDad).
			]
		].
		(person2 father) familialRelationships do: [: aFamily |
			((aFamily father == (person2 father)) and: [(aFamily hasChild: person2) not]) ifTrue: [
				aFamily father: (merged mergedDad).
			]
		].
		newFam father: (merged mergedDad).
	] ifFalse: [
		"give new fam the appropriate dad or none at all"
		"self entitled: ''."
		(person1 father) ifNotNil: [
			newFam father: (person1 father).
			(person1 father) familialRelationships do: [: aFamily |
				(aFamily father == (person1 father)) ifTrue: [
					(person1 father) removeFamily: aFamily 
				]
			].
			(person1 father) addFamily: newFam.
		]. 
		(person2 father) ifNotNil: [
			newFam father: (person2 father).
			(person2 father) familialRelationships do: [: aFamily |
				(aFamily father == (person2 father)) ifTrue: [
					(person2 father) removeFamily: aFamily 
				]
			].
			(person2 father) addFamily: newFam.
		]. 
	].

	"create a new family for my siblings and me"
	newFam addChild: merged.
	person1 familialRelationships do: [: aFamily |
		(aFamily hasChild: person1) ifTrue: [
			(aFamily children reject: [: p | p == person1]) do:
				[: p | newFam addChild: p. p removeFamily: aFamily. p addFamily: newFam.].
		]
	].
	person2 familialRelationships do: [: aFamily |
		(aFamily hasChild: person2) ifTrue: [
			(aFamily children reject: [: p | p == person2]) do:
				[: p | newFam addChild: p. p removeFamily: aFamily. p addFamily: newFam.]
		]
	].
	
	"updating marriages"
	(person1 marriageRelationships) do: [: aMarr |
		(aMarr man == person1) ifTrue:[merged addMarriage: aMarr.  aMarr man: merged].
		(aMarr woman == person1) ifTrue:[merged addMarriage: aMarr.  aMarr woman: merged].		
	].
	(person2 marriageRelationships) do: [: aMarr |
		(aMarr man == person2) ifTrue:[merged addMarriage: aMarr.  aMarr man: merged].
		(aMarr woman == person2) ifTrue:[merged addMarriage: aMarr.  aMarr woman: merged].
	].
	
	
	merged addFamily: newFam.
	merged newFam: newFam.

	toRemove1 add: person1.
	toRemove2 add: person2.
	toAdd add: merged.
	^ (Array with: toRemove1 with: toRemove2 with: toAdd with: merged)
! !


RectangleMorph subclass: #PersonContainerMorph
	instanceVariableNames: 'model owningWindow '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!PersonContainerMorph commentStamp: '' prior: 0!
This morph contains people.

It main purpose is to capture mouse clicks and do the appropriate things with them.

i.e. display a menu or pass it along to a contained morph.!


!PersonContainerMorph methodsFor: 'events' stamp: 'tss 10/18/2002 00:50'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	|  |
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu add: 'export' target: model action: #export.! !

!PersonContainerMorph methodsFor: 'events' stamp: 'tss 10/17/2002 23:15'!
mouseMove: evt
	|  |
	super mouseMove: evt.
	submorphs do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m mouseMove: evt]].! !

!PersonContainerMorph methodsFor: 'events' stamp: 'tss 10/17/2002 23:14'!
mouseUp: evt
	|  |
	super mouseUp: evt.
	submorphs do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m mouseUp: evt]].! !


!PersonContainerMorph methodsFor: 'accessing' stamp: 'tss 10/18/2002 00:17'!
model: aModel
	""

	|  |
	model _ aModel.! !

!PersonContainerMorph methodsFor: 'accessing' stamp: 'tss 12/4/2002 18:53'!
mouseDown: evt
	| menu subMorphsPoint |
	"super mouseDown: evt."
	self isLocked ifTrue: [
		owningWindow activate.
	]
	ifFalse: [
		subMorphsPoint _ false.
		submorphs do: [:m | (m containsPoint: evt cursorPoint) 
			ifTrue: [subMorphsPoint _ true. m mouseDown: evt]].
		"((self containsPoint: evt cursorPoint) and: [subMorphsPoint not]) ifTrue: ["
		(subMorphsPoint not) ifTrue: [
			menu _ MenuMorph new.
			menu add: 'Export to Transcript' target: model action: #export.
			menu add: 'Export to a "GedPage" compatible GEDCOM file'
				target: owningWindow 
				action: #popUpExportToGEDCOM.
			menu add: 'Import from a "GedPage" compatible GEDCOM file'
				target: owningWindow 
				action: #popUpImportFromGEDCOM.
			(model canMerge) ifTrue: [
				(model isMerging) ifFalse: [
					menu add: 'Compare Map to a GEDCOM file'
						target: owningWindow 
						action: #popUpCompareToGEDCOM.
				].
			].
			(model canMerge) ifFalse: [
				menu add: 'Display match report'
					target: owningWindow
					action: #generateMatchReport.
			].
			(model isKindOf: GenealogyMapMerged) ifTrue: [
				(model lastMerged) ifNotNil:[
					menu add: 'Undo last merge cascade' target: model action: #unmerge.
				]
			].
			menu add: 'Create a Person' target: owningWindow action: #createPerson.
			menu addLine.
			menu add: 'Close' target: model action: #closeView.
			menu popUpInWorld.
		].
	].! !

!PersonContainerMorph methodsFor: 'accessing' stamp: 'tss 10/19/2002 13:32'!
owningWindow: aWindow
	""

	|  |
	owningWindow _ aWindow.! !


RectangleMorph subclass: #PersonDetailedMorph
	instanceVariableNames: 'givenNameField surNameField saveButton givenEdit surEdit birthdateField birthplaceField deathdateField deathplaceField genderField aliasList selectAliasIndex miscList selectMiscIndex siblingList selectSiblingIndex marriageList selectMarriageIndex model windowOwner '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!PersonDetailedMorph commentStamp: '' prior: 0!
This morph shows the information specific to an individual.

Each part of a person can be viewed and modified through this morph.!


!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 13:08'!
aliases
	^ model aliases.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/20/2002 23:13'!
initialize

	" "

	super initialize.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:04'!
initializeNow

	" this one really does the initializing of the morph"

	|  closeButton birthdateEdit birthplaceEdit deathdateEdit deathplaceEdit setFemaleEdit setMaleEdit aliasLabel addAliasEdit miscLabel misc2Label addMiscEdit siblingsLabel addSiblingEdit marriagesLabel addMarriageEdit |


	self extent: 400@500.

	"givenName"
	givenNameField := StringMorph new.
	self addMorph: (givenNameField position: 150@12).	
	givenEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpGivenNameEdit.
	givenEdit label: 'Edit given name'.
	self addMorph: (givenEdit position: 5@7).

	"surName"
	surNameField := StringMorph new.
	self addMorph: (surNameField position: 150@33).
	surEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpSurNameEdit.
	surEdit label: 'Edit sur name'.
	self addMorph: (surEdit position: 5@28).

	"birthdate"
	birthdateField := StringMorph new.
	self addMorph: (birthdateField position: 150@54).
	birthdateEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpBirthdateEdit.
	birthdateEdit label: 'Edit Birthdate'.
	self addMorph: (birthdateEdit position: 5@49).

	"birthplace"
	birthplaceField := StringMorph new.
	self addMorph: (birthplaceField position: 150@75).
	birthplaceEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpBirthplaceEdit.
	birthplaceEdit label: 'Edit Birthplace'.
	self addMorph: (birthplaceEdit position: 5@71).

	"deathdate"
	deathdateField := StringMorph new.
	self addMorph: (deathdateField position: 150@96).
	deathdateEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpDeathdateEdit.
	deathdateEdit label: 'Edit Deathdate'.
	self addMorph: (deathdateEdit position: 5@92).

	"deathplace"
	deathplaceField := StringMorph new.
	self addMorph: (deathplaceField position: 150@117).
	deathplaceEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpDeathplaceEdit.
	deathplaceEdit label: 'Edit Death Location'.
	self addMorph: (deathplaceEdit position: 5@113).

	"gender"
	genderField := StringMorph new.
	self addMorph: (genderField position: 150@148).
	setFemaleEdit := PluggableButtonMorph on: model
					getState: nil
					action: #isFemale.
	setFemaleEdit label: 'Set Gender to Female'.
	self addMorph: (setFemaleEdit position: 5@134).
	setMaleEdit := PluggableButtonMorph on: model
					getState: nil
					action: #isMale.
	setMaleEdit label: 'Set Gender to Male'.
	self addMorph: (setMaleEdit position: 5@155).

	"Aliases"
	aliasLabel := StringMorph new.
	aliasLabel contents: 'Aliases:'.
	self addMorph: (aliasLabel position: 150@195).
	selectAliasIndex _ 0.
	aliasList := PluggableListMorph on: self
		list: #aliases
		selected: #selectedAliasIndex
		changeSelected: #selectAlias:
		.
	aliasList scrollBarOnLeft: true.
	aliasList extent: 180@50.
	self addMorph: (aliasList position: 200@176).
	addAliasEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpaddAliasEdit.
	addAliasEdit label: 'Add Alias'.
	self addMorph: (addAliasEdit position: 5@191).

	"MiscRecords"
	miscLabel := StringMorph new.
	miscLabel contents: 'Misc'.
	self addMorph: (miscLabel position: 150@250).
	misc2Label := StringMorph new.
	misc2Label contents: 'Records:'.
	self addMorph: (misc2Label position: 150@265).
	selectMiscIndex _ 0.
	miscList := PluggableListMorph on: self
		list: #miscRecords
		selected: #selectedMiscIndex
		changeSelected: #selectMisc:
		.
	miscList scrollBarOnLeft: true.
	miscList extent: 180@50.
	self addMorph: (miscList position: 200@236).
	addMiscEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpaddMiscEdit.
	addMiscEdit label: 'Add Misc Record'.
	self addMorph: (addMiscEdit position: 5@255).

	"Siblings"
	siblingsLabel := StringMorph new.
	siblingsLabel contents: 'Siblings:'.
	self addMorph: (siblingsLabel position: 150@315).
	selectSiblingIndex _ 0.
	siblingList := PluggableListMorph on: self
		list: #siblings
		selected: #selectedSiblingIndex
		changeSelected: #selectSibling:
		.
	siblingList scrollBarOnLeft: true.
	siblingList extent: 180@50.
	self addMorph: (siblingList position: 200@296).
	addSiblingEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpaddSiblingEdit.
	addSiblingEdit label: 'Add a Sibling'.
	self addMorph: (addSiblingEdit position: 5@311).

	"add marriage"
	marriagesLabel := StringMorph new.
	marriagesLabel contents: 'Marriages:'.
	self addMorph: (marriagesLabel position: 170@375).
	selectMarriageIndex _ 0.
	marriageList := PluggableListMorph on: self
		list: #marriages
		selected: #selectedMarriageIndex
		changeSelected: #selectSibling:
		.
	marriageList scrollBarOnLeft: true.
	marriageList extent: 390@50.
	self addMorph: (marriageList position: 5@390).
	addMarriageEdit := PluggableButtonMorph on: self
					getState: nil
					action: #popUpAddMarriageEdit.
	addMarriageEdit label: 'Add a Marriage'.
	self addMorph: (addMarriageEdit position: 150@450).
	
	"Close button"
	closeButton := PluggableButtonMorph on: self
					getState: nil
					action: #delete.
	closeButton label: 'Close'.
	self addMorph: (closeButton position: 180@475).! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 01:00'!
marriages
	^ model marriageRelationshipsCollection.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:05'!
married: spouse on: date1
	"asks user for date of divorce and adds a marriage based on parameters and input"

	| return date |

	return := FillInTheBlankMorph request: 'Enter the date of the divorce'
		initialAnswer: ((Date fromString: '1/1/1') asString).
	(return = '') ifFalse: [
		[
			date _ (Date fromString: return).
			model married: spouse on: date1 divorced: date
		] ifError:[.]
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 14:38'!
miscRecords
	^ model miscRecordsCollection.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:05'!
model: aModel
	"sets model and initializes morph"

	| |
	model := aModel.
	model addDependent: self.
	self initializeNow.
	self resetText.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 22:35'!
people
	^ model people.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:05'!
popUpAddMarriageEdit
	"called when user wants to add a marriage"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select Spouse')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == model]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #popUpMarriedOn:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:05'!
popUpBirthdateEdit
	"called when user wants to set the birthdate"

	| return |

	return := FillInTheBlankMorph request: 'Enter new birthdate' initialAnswer: (model bornDate asString).
	(return = '') ifFalse: [
		[model bornDate: (Date fromString: return)] ifError:[.].
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpBirthplaceEdit
	"called when user wants to set the birthplace"

	| return |

	return := FillInTheBlankMorph request: 'Enter new birth location' initialAnswer: (model bornLocation asString).
	(return = '') ifFalse: [
		model bornLocation: return.
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpDeathdateEdit
	"called when user wants to set the death location"

	| return |

	return := FillInTheBlankMorph request: 'Enter new deathdate' initialAnswer: (model deathDate asString).
	(return = '') ifFalse: [
		[model deathDate: (Date fromString: return)] ifError:[.].
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpDeathplaceEdit
	"called when user wants to set the deathplace"

	| return |

	return := FillInTheBlankMorph request: 'Enter new death location' initialAnswer: (model deathLocation asString).
	(return = '') ifFalse: [
		model deathLocation: return.
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpGivenNameEdit
	"called when user wants to set the given name"

	| return |

	return := FillInTheBlankMorph request: 'Enter new given name' initialAnswer: (model givenName).
	"self chooseMagnification."
	(return = '') ifFalse: [
		model givenName: return
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpHasFatherEdit
	"called when user wants to set the father"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == model]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: model
			selector: #hasFather:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:06'!
popUpHasMotherEdit
	"called when user wants to set the mother"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == model]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: model
			selector: #hasMother:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:07'!
popUpMarriedOn: spouse
	"called when user wants to add a marriage"

	| return menu date |

	return := FillInTheBlankMorph request: 'Enter the date of the marriage'
		initialAnswer: ((Date fromString: '1/1/1') asString).
	(return = '') ifFalse: [
		[
			date _ (Date fromString: return).
			menu _ MenuMorph new.
			menu add: ('Were they divorced?')
				target: model
				selector: #hasSibling:
				argument: nil.
			menu addLine.
			menu add: ('Yes')
				target: self
				selector: #married:on:
				argumentList: (Array with: spouse with: date).
			menu add: ('No')
				target: model
				selector: #married:on:
				argumentList: (Array with: spouse with: date).
			menu position: 300@300.
			menu openInWorld.
		] ifError:[.]
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:07'!
popUpSurNameEdit
	"called when user wants to set the sur name"

	| return |

	return := FillInTheBlankMorph request: 'Enter new sur name' initialAnswer: (model surName).
	"self chooseMagnification."
	(return = '') ifFalse: [
		model surName: return.
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:07'!
popUpaddAliasEdit
	"called when user wants to add an alias"

	| return |

	return := FillInTheBlankMorph request: 'Enter new alias' initialAnswer: (model givenName).
	(return = '') ifFalse: [
		model addAlias: return.
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:07'!
popUpaddMiscEdit
	"called when user wants to add miscellaneous information"

	| value key |

	key := FillInTheBlankMorph request: 'Enter item to record' initialAnswer: ('key').
	(key = '') ifFalse: [
		value := FillInTheBlankMorph request: 'Enter value to record' initialAnswer: ('value').
		(value = '') ifFalse: [
			model record: key as: value.
		].
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:07'!
popUpaddSiblingEdit
	"called when user wants to add a sibling"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == model]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: model
			selector: #hasSibling:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:08'!
resetText
	"redisplays the text about the model"

	| |
	model ifNotNil:[
		givenNameField contents: 'Given Name: ',(model givenName).
		surNameField contents: 'Sur Name: ',(model surName).
		birthdateField contents: 'Birthdate: ', (model bornDate asString).
		birthplaceField contents: 'Birthplace: ', (model bornLocation asString).
		deathdateField contents: 'Deathdate: ', (model deathDate asString).
		deathplaceField contents: 'Death Location: ', (model deathLocation asString).
		genderField contents: 'Gender: ', (model isFemaleGender ifNotNilDo:[: isFemale | 
			isFemale ifTrue: ['Female'] ifFalse: ['Male']]).
	]
! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 13:15'!
selectAlias: index
	(index = 0) ifFalse: [
		selectAliasIndex _ index.
		self changed: #selectedAlias
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 00:29'!
selectMarriage: index
	(index = 0) ifFalse: [
		selectMarriageIndex _ index.
		self changed: #selectedMarriage
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 14:36'!
selectMisc: index
	(index = 0) ifFalse: [
		selectMiscIndex _ index.
		self changed: #selectedMisc
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 21:03'!
selectSibling: index
	(index = 0) ifFalse: [
		selectSiblingIndex _ index.
		self changed: #selectedSibling
	].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 13:17'!
selectedAlias
	^ model aliases at: selectAliasIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 13:22'!
selectedAliasIndex
	^ selectAliasIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 00:28'!
selectedMarriage
	^ self marriages at: selectMarriageIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 00:27'!
selectedMarriageIndex
	^ selectMarriageIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 14:37'!
selectedMisc
	^ model miscRecordsCollection at: selectMiscIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 14:38'!
selectedMiscIndex
	^ selectMiscIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 21:02'!
selectedSibling
	^ Person new.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 21:01'!
selectedSiblingIndex
	^ selectSiblingIndex! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 21:35'!
siblings
	| toRet |

	toRet _ OrderedCollection new.

	model familialRelationships do: [: aFamily | (aFamily hasChild: model)
		ifTrue: [toRet addAll: (aFamily children reject: [: aPerson | aPerson == model])]].

	^ toRet! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'TEO 10/22/2002 06:08'!
update: symbol
	"called when something this object is dependent on changes"

	symbol = #data ifTrue: [ self resetText. self changed: #aliases.self changed: #miscRecords.self changed: #siblings.self changed: #marriages.].! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 22:46'!
windowOwner
	^windowOwner.! !

!PersonDetailedMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 22:46'!
windowOwner: wOwner
	windowOwner _ wOwner.! !

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

PersonDetailedMorph class
	instanceVariableNames: ''!

!PersonDetailedMorph class methodsFor: 'as yet unclassified' stamp: 'tss 10/20/2002 23:13'!
on: aModel
	"comment stating purpose of message"

	| toRet |
	toRet := super new.
	toRet model: aModel.
	^toRet.! !

!PersonDetailedMorph class methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 01:23'!
openOn: aModel
	"comment stating purpose of message"

	| toRet |
	toRet := super new.
	toRet model: aModel.
	toRet position: 300@300.
	toRet openInWorld.
	^toRet.! !

!PersonDetailedMorph class methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 01:55'!
openOn: aModel owner: wOwner
	"comment stating purpose of message"

	| toRet |
	toRet := super new.
	toRet windowOwner: wOwner.
	toRet model: aModel.
	toRet position: 300@20.
	toRet openInWorld.
	^toRet.! !


EllipseMorph subclass: #PersonMorph
	instanceVariableNames: 'givenNameLabel surNameLabel person windowOwner special '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!PersonMorph commentStamp: '' prior: 0!
This is the graphical represenation of a person.

Most of the morph is showing a person's name and a color indicating gender.

It also handles the basic functionality of the menu that is popped up when a user clicks on it.!


!PersonMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/17/2002 19:39'!
model: aModel
	""

	|  |
	aModel addDependent: self.
	person _ aModel.
	self setLabels! !

!PersonMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/20/2002 20:20'!
notSpecial
	special _ false.! !

!PersonMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/20/2002 20:20'!
special
	special _ true.! !

!PersonMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/21/2002 22:38'!
windowOwner
	""

	|  |
	^windowOwner! !

!PersonMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/20/2002 20:07'!
windowOwner: aModel
	""

	|  |
	windowOwner _ aModel.! !


!PersonMorph methodsFor: 'events' stamp: 'tss 10/31/2002 11:57'!
check
	"creates a Text Window that displays the check info for the person"

	| |

	CheckMorph from: (person checkResults) on: person.



	"win _ SystemWindow labelled: 'Check Results'.
	win addMorph: (PluggableTextMorph on: person text: #check accept: #check) frame: (0@0 extent: 1@01).
	win position: 300@50.
	win paneColor: (Color yellow).
	win openInWorld."! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/17/2002 23:27'!
handlesMouseOver: evt
	^ true.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:02'!
married: spouse on: date1
	"requests date of divorce and adds a marriage based on parameters and input to model"

	| return date |

	return := FillInTheBlankMorph request: 'Enter the date of the divorce'
		initialAnswer: ((Date fromString: '1/1/1') asString).
	(return = '') ifFalse: [
		[
			date _ (Date fromString: return).
			person married: spouse on: date1 divorced: date
		] ifError:[.]
	].! !

!PersonMorph methodsFor: 'events' stamp: 'tss 12/3/2002 22:21'!
mouseDown: evt
	| menu mergeMenu |
	menu _ MenuMorph entitled: 'Person Menu'.
	menu add: ('Center on ', person givenName, ' ', person surName)
		target: windowOwner
		selector: #selectThisPerson:
		argument: person.
	menu add: 'Edit/View vital information'
		target: PersonDetailedMorph
		selector: #openOn:owner:
		argumentList: (Array with:person with:windowOwner).
	menu add: 'Add Alias' target: self selector: #popUpaddAliasEdit.
	menu add: 'Record Misc Information' target: self selector: #popUpaddMiscEdit.
	menu add: 'Add Sibling' target: self selector: #popUpaddSiblingEdit.
	menu add: 'Set Father' target: self selector: #popUpHasFatherEdit.
	menu add: 'Set Mother' target: self selector: #popUpHasMotherEdit.
	menu add: 'Had Child With' target: self selector: #popUpHasChildEdit.
	menu add: 'Add Marriage' target: self selector: #popUpAddMarriageEdit.
	menu add: 'Check for missing/incorrect info' target: self selector: #check.
	menu add: 'Search Web for Information' target: self selector: #queryWeb.
	menu add: 'Make a Query'
		target: QueryInputMorph
		selector: #openOn:owner:
		argumentList: (Array with:person with:windowOwner).
	(windowOwner isMerging) ifTrue: [
		"Merge"
		mergeMenu _ MenuMorph new.
		mergeMenu add: 'Select a Person'
			target: windowOwner
			selector: #doNothing.
		((windowOwner merging) otherPeople: windowOwner) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner merging)
				selector: #merge:with:
				argumentList: (Array with:person with:aPerson).
		].
		((windowOwner merging) justPeople) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner merging)
				selector: #merge:with:
				argumentList: (Array with:person with:aPerson).
		].
		menu add: 'Merge With Another Person' subMenu: mergeMenu.
		
		"Check score"
		mergeMenu _ MenuMorph new.
		mergeMenu add: 'Select a Person'
			target: windowOwner
			selector: #doNothing.
		((windowOwner merging) otherPeople: windowOwner) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner merging)
				selector: #match:with:
				argumentList: (Array with:person with:aPerson).
		].
		((windowOwner merging) justPeople) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner merging)
				selector: #match:with:
				argumentList: (Array with:person with:aPerson).
		].
		menu add: 'Compare With Another Person' subMenu: mergeMenu.
	].
	(person isKindOf: MergedPerson) ifTrue:[
		"Merge"
		mergeMenu _ MenuMorph new.
		mergeMenu add: 'Select a Person'
			target: windowOwner
			selector: #doNothing.
		(windowOwner justPeople reject: [: per | per == person]) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner)
				selector: #merge:with:
				argumentList: (Array with:person with:aPerson).
		].
		menu add: 'Merge With Another Person' subMenu: mergeMenu.
		
		"Check score"
		mergeMenu _ MenuMorph new.
		mergeMenu add: 'Select a Person'
			target: windowOwner
			selector: #doNothing.
		(windowOwner justPeople reject: [: per | per == person]) do: [: aPerson |
			mergeMenu add: (aPerson asStringOrText)
				target: (windowOwner)
				selector: #match:with:
				argumentList: (Array with:person with:aPerson).
		].
		menu add: 'Compare With Another Person' subMenu: mergeMenu.
	].
	menu popUpInWorld.
	! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/20/2002 18:20'!
mouseEnter: evt
	|  toolTip |
	super mouseEnter: evt.
	(person isFemaleGender) ifTrue: [self borderColor: Color red] ifFalse: [self borderColor: Color blue].
	self borderWidth: 3.
	            toolTip := ''.

            (person givenName) ifNotNil: [

                        toolTip := toolTip,(person givenName).

                        (person surName) ifNotNil: [

                                    toolTip := toolTip,' '.

                        ].

            ].

            (person surName) ifNotNil: [

                        toolTip := toolTip,(person surName).

            ].

            (person bornDate) ifNotNil: [

                        toolTip := toolTip,'  Born on ',(person bornDate asString).

                        (person bornLocation) ifNotNil: [

                                    toolTip := toolTip,' in ',(person bornLocation).

                        ].

                        toolTip := toolTip,'.'.

            ].

            (person deathDate) ifNotNil: [

                        toolTip := toolTip,'  Died on ',(person deathDate asString).

                        (person deathLocation) ifNotNil: [

                                    toolTip := toolTip,' in ',(person deathLocation).

                        ].

                        toolTip := toolTip,'.'.

            ].

            (person aliases size > 0) ifTrue: [

                        toolTip := toolTip,'  Also known as:'.

            ].

            (person aliases) do: [ :alias | toolTip := toolTip,' ',alias. ].

 

            (person miscRecords keys size > 0) ifTrue: [

                        toolTip := toolTip,'  Other information:'.

            ].

            person miscRecords keys do: [ :key |

                        toolTip := toolTip,' ',(key asString),'=',((person miscRecords at: key) asString).

            ].

            self setBalloonText: toolTip.

	! !

!PersonMorph methodsFor: 'events' stamp: 'tss 11/24/2002 13:54'!
mouseLeave: evt
	|  |
	super mouseLeave: evt.
	(person isKindOf: MergedPerson) ifTrue: [
		self borderColor: Color green.
		self borderWidth: 4.
	] ifFalse: [
		self borderColor: Color black.
		self borderWidth: 1.
	].! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/17/2002 22:42'!
mouseUp: evt
	| cp |
	cp _ evt cursorPoint.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:03'!
popUpAddMarriageEdit
	"called when user wants to add a marriage"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select Spouse')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == person]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #popUpMarriedOn:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:03'!
popUpHasChildEdit
	"called when user wants to add a child"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select the other parent')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == person]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #popUpwith:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:03'!
popUpHasFatherEdit
	"called when user wants to set the father"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == person]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: person
			selector: #hasFather:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:03'!
popUpHasMotherEdit
	"called when user wants to set the mother"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == person]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: person
			selector: #hasMother:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:03'!
popUpMarriedOn: spouse
	"called when user wants to add a marriage"

	| return menu date |

	return := FillInTheBlankMorph request: 'Enter the date of the marriage'
		initialAnswer: ((Date fromString: '1/1/1') asString).
	(return = '') ifFalse: [
		[
			date _ (Date fromString: return).
			menu _ MenuMorph new.
			menu add: ('Were they divorced?')
				target: person
				selector: #hasSibling:
				argument: nil.
			menu addLine.
			menu add: ('Yes')
				target: self
				selector: #married:on:
				argumentList: (Array with: spouse with: date).
			menu add: ('No')
				target: person
				selector: #married:on:
				argumentList: (Array with: spouse with: date).
			menu position: 300@300.
			menu openInWorld.
		] ifError:[.]
	].! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/22/2002 06:04'!
popUpaddAliasEdit
	"called when user wants to add an alias"

	| return |

	return := FillInTheBlankMorph request: 'Enter new alias' initialAnswer: (person givenName).
	(return = '') ifFalse: [
		person addAlias: return.
	].! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/22/2002 05:55'!
popUpaddMiscEdit
	"prompts twice
	once for the key another time for the value"

	| value key |

	key := FillInTheBlankMorph request: 'Enter item to record' initialAnswer: ('key').
	(key = '') ifFalse: [
		value := FillInTheBlankMorph request: 'Enter value to record' initialAnswer: ('value').
		(value = '') ifFalse: [
			person record: key as: value.
		].
	].! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/22/2002 05:55'!
popUpaddSiblingEdit
	"pops up a list of people
	limits based on this person"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | p == person]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: person
			selector: #hasSibling:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/22/2002 05:55'!
popUpwith: parent
	"pops up a list of people
	limits based on this person"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select their child')
		target: person
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people reject: [: p | (p == person) or: [p == parent]]) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: person
			selector: #hasChild:with:
			argumentList: (Array with: aPerson with: parent).
	].
	menu popUpInWorld.! !

!PersonMorph methodsFor: 'events' stamp: 'TEO 10/31/2002 21:10'!
queryWeb
	"comment stating purpose of message"

	PersonWebResultsMorph from: person.! !

!PersonMorph methodsFor: 'events' stamp: 'tss 11/24/2002 13:55'!
setLabels
	" sets all the lables
	they still need to be redrawn"

	| labelColor e |
	special ifTrue:[
		 e _ 1.
		person isFemaleGender ifTrue: [ labelColor _ Color red.] ifFalse: [ labelColor _ Color blue]
	] ifFalse: [labelColor _ Color black.  e _ 0].
	
	givenNameLabel contents: (person givenName).
	givenNameLabel color: labelColor; emphasis: e.
	surNameLabel contents: (person surName).
	surNameLabel color: labelColor; emphasis: e.
	(person isFemaleGender) ifTrue: [self color: Color paleRed] ifFalse: [self color: Color lightBlue].
	(person isKindOf: MergedPerson) ifTrue: [
		self borderColor: Color green.
		self borderWidth: 4.
	] ifFalse: [
		self borderColor: Color black.
		self borderWidth: 1.
	].! !

!PersonMorph methodsFor: 'events' stamp: 'tss 10/22/2002 05:52'!
update: aspect
	"if the model's data has changed then
	all the labels need to be redrawn"

	| |
	(aspect = #data) ifTrue:[self setLabels].	! !


!PersonMorph methodsFor: 'initialization' stamp: 'tss 10/20/2002 23:08'!
initialize
	""

	| |
	super initialize.
	givenNameLabel _ StringMorph contents: ''.
	surNameLabel _ StringMorph contents: ''.
	self addMorph: givenNameLabel.
	givenNameLabel position: (15@8).
	self addMorph: surNameLabel.
	surNameLabel position: (15@18).! !

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

PersonMorph class
	instanceVariableNames: ''!

!PersonMorph class methodsFor: 'instance creation' stamp: 'tss 10/20/2002 20:27'!
fromPerson: aPerson
	"creates a PersonMorph from a person"

	|  |
	^ (self new) extent: 80@40; notSpecial; model: aPerson.! !

!PersonMorph class methodsFor: 'instance creation' stamp: 'tss 10/20/2002 20:27'!
fromPerson: aPerson owner: aModel
	"creates a PersonMorph from a person"

	|  |
	^ (self new) extent: 80@40; windowOwner: aModel; notSpecial; model: aPerson.! !

!PersonMorph class methodsFor: 'instance creation' stamp: 'tss 10/20/2002 20:27'!
specialFromPerson: aPerson owner: aModel
	"creates a PersonMorph from a person"

	|  |
	^ (self new) extent: 80@40; windowOwner: aModel; special; model: aPerson.! !


SystemWindow subclass: #PersonWebResultsMorph
	instanceVariableNames: 'person '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!PersonWebResultsMorph commentStamp: '' prior: 0!
This morph contains submorphs that allows the user to select results from a web search to fill in the information about a person.  Create this morph by passing in a Person object.!


!PersonWebResultsMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:27'!
initializeFrom: newPerson
	"initialize the morph based on the person passed in"

	| webQuery webQueryMorphContainer y menu | 
	person := newPerson.

	webQuery := WebQuery from: person.

	[

	[ webQuery execute.


	self paneColor: (Color yellow).
	self setLabel: 'Web Query Results'.
	self openInWorld.
	self extent: (400@500); position: 250@20.
	
	webQueryMorphContainer := WebQueryMorphContainer new.
	webQueryMorphContainer color: (Color yellow veryMuchLighter); borderWidth: 0; model: self.

	self addMorph: (webQueryMorphContainer inATwoWayScrollPane) frame: (0@0 extent: 1@1).

	webQueryMorphContainer addMorph: 
		( (StringMorph new) position: (50@5); contents: 
			('Web Results for ',(person givenName),' ',(person surName))).

	y := 20.

"iteration of all aspects supported in web search"
	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #bornDate title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #bornLocation title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #deathDate title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #deathLocation title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #SSN title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #address title: '') position: (0@y)).
	y := y+120.

	webQueryMorphContainer addMorph: ( (WebQueryMorph from: webQuery aspect: #phoneNumber title: '') position: (0@y)).
	y := y+120.

	y := y+5.
	webQueryMorphContainer addMorph: (
		(PluggableButtonMorph on: self getState: nil action: #delete) label: 'Close'; position: (125@y)).


	] ifError: [ " catches inaccessibility error in a 'nice' way"
		menu _ MenuMorph entitled: 'Cannot connect to internet!!'.
			menu add: ('OK')
			target: GenealogyMap
			selector: #DoNothing.
		menu popUpInWorld.
		"self error: 'BALRG'."
	].

	] fork.! !

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

PersonWebResultsMorph class
	instanceVariableNames: ''!

!PersonWebResultsMorph class methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 12:55'!
from: newPerson
	"create this morph using the person passed in"

	| toRet |
	toRet := super new.
	toRet initializeFrom: newPerson.
	^ toRet.! !


Object subclass: #Query
	instanceVariableNames: 'givenName surName male alias sibling parent child marriedTo birthDate birthLocation deathDate deathLocation propName propValue livedIn livedOn generalSearch '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!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.!


!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.! !


RectangleMorph subclass: #QueryInputMorph
	instanceVariableNames: 'windowOwner model '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!QueryInputMorph commentStamp: '' prior: 0!
This morph allows the user to select a type of information about a person to search for in people and then input the specfic information to search for.!


!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:49'!
initializeNow
	"init all the gui components
	creates them and places them"

	| givenNameQuery surNameQuery birthDateQuery birthLocationQuery deathDateQuery deathLocationQuery aliasQuery recordQuery genderQuery childQuery parentQuery siblingQuery spouseQuery globalLivedOnQuery globalLivedInQuery globalSearchQuery closeButton |
	
	self extent: 400@375.
	givenNameQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryGivenName.
	givenNameQuery label: 'Query based on given name'.
	self addMorph: (givenNameQuery position: 5@7).

	surNameQuery := PluggableButtonMorph on: self
						getState: nil
						action: #querySurName.
	surNameQuery label: 'Query based on sur name'.
	self addMorph: (surNameQuery position: 5@28).

	birthDateQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryBirthDate.
	birthDateQuery label: 'Query based on birthdate'.
	self addMorph: (birthDateQuery position: 5@49).
	
	birthLocationQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryBirthLocation.
	birthLocationQuery label: 'Query based on birth location'.
	self addMorph: (birthLocationQuery position: 5@70).

	deathDateQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryDeathDate.
	deathDateQuery label: 'Query based on deathdate'.
	self addMorph: (deathDateQuery position: 5@91).
	
	deathLocationQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryDeathLocation.
	deathLocationQuery label: 'Query based on death location'.
	self addMorph: (deathLocationQuery position: 5@112).

	aliasQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryAlias.
	aliasQuery label: 'Query based on alias'.
	self addMorph: (aliasQuery position: 5@133).

	recordQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryMisc.
	recordQuery label: 'Query based on miscellaneous information'.
	self addMorph: (recordQuery position: 5@154).

	genderQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryGender.
	genderQuery label: 'Query based on gender'.
	self addMorph: (genderQuery position: 5@175).

	childQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryChild.
	childQuery label: 'Query based on child'.
	self addMorph: (childQuery position: 5@196).

	parentQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryParent.
	parentQuery label: 'Query based on parent'.
	self addMorph: (parentQuery position: 5@217).

	siblingQuery := PluggableButtonMorph on: self
						getState: nil
						action: #querySibling.
	siblingQuery label: 'Query based on sibling'.
	self addMorph: (siblingQuery position: 5@238).

	spouseQuery := PluggableButtonMorph on: self
						getState: nil
						action: #querySpouse.
	spouseQuery label: 'Query based on spouse'.
	self addMorph: (spouseQuery position: 5@259).

	globalLivedOnQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryLivedOn.
	globalLivedOnQuery label: 'Query based on living on a date'.
	self addMorph: (globalLivedOnQuery position: 5@280).

	globalLivedInQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryLivedIn.
	globalLivedInQuery label: 'Query based on ever living in a location'.
	self addMorph: (globalLivedInQuery position: 5@301).

	globalSearchQuery := PluggableButtonMorph on: self
						getState: nil
						action: #queryGlobalSearch.
	globalSearchQuery label: 'Query based on global search'.
	self addMorph: (globalSearchQuery position: 5@322).

	closeButton := PluggableButtonMorph on: self
					getState: nil
					action: #delete.
	closeButton label: 'Close'.
	self addMorph: (closeButton position: 180@350).! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:49'!
model: aModel
	

	| |
	model := aModel.
	self initializeNow.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:48'!
queryAlias
	" querys for a alias
	closes window"

	| queryAlias |

	queryAlias := FillInTheBlankMorph request: 'Enter alias to query' initialAnswer: 'alias'.
	(queryAlias = '') ifFalse: [
		(GenealogyMap withOutRelatives: (model searchFor: (Query hasAlias: queryAlias))) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:48'!
queryBirthDate
	" querys for a birth date
	closes window"

	| birthDateQuery |

	birthDateQuery := FillInTheBlankMorph request: 'Enter birth date to query' initialAnswer: '9/8/81'.
	(birthDateQuery = '') ifFalse: [
		[(GenealogyMap withOutRelatives: (model searchFor: (Query born: (Date fromString: birthDateQuery)))) open] ifError:[.]
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:48'!
queryBirthLocation
	" querys for a birth location
	closes window"

	| queryBirthLocation |

	queryBirthLocation := FillInTheBlankMorph request: 'Enter birth location to query' initialAnswer: 'birth location'.
	(queryBirthLocation = '') ifFalse: [
		(GenealogyMap withOutRelatives: (model searchFor: (Query bornIn: queryBirthLocation))) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:48'!
queryChild
	" querys for a child
	closes window"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people ) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #queryChildWith:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:47'!
queryChildWith: child
	" querys for a child
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query hasChild: child))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:47'!
queryDeathDate
	" querys for a death date
	closes window"

	| queryDeathDate |

	queryDeathDate := FillInTheBlankMorph request: 'Enter death date to query' initialAnswer: '9/8/81'.
	(queryDeathDate = '') ifFalse: [
		[(GenealogyMap withOutRelatives: (model searchFor: (Query died: (Date fromString: queryDeathDate)))) open] ifError:[.]
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:47'!
queryDeathLocation
	" querys for a death location
	closes window"

	| queryDeathLocation |

	queryDeathLocation := FillInTheBlankMorph request: 'Enter death location to query' initialAnswer: 'death location'.
	(queryDeathLocation = '') ifFalse: [
		(GenealogyMap withOutRelatives: (model searchFor: (Query diedIn: queryDeathLocation))) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:47'!
queryFemale
	" querys for females
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query isFemale))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:47'!
queryGender
	" querys for a gender
	closes window"

	| menu |
	menu _ MenuMorph new.
			menu add: ('Select Gender to Query')
				target: model
				selector: #hasSibling:
				argument: nil.
			menu addLine.
			menu add: ('Male')
				target: self
				selector: #queryMale.
			menu add: ('Female')
				target: self
				selector: #queryFemale.
			menu position: 300@300.
			menu openInWorld.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:46'!
queryGivenName
	" querys for a given name
	closes window"

	| givenName |

	givenName := FillInTheBlankMorph request: 'Enter given name to query' initialAnswer: 'given name'.
	(givenName = '') ifFalse: [
		(GenealogyMap withOutRelatives: (model searchFor: (Query givenName: givenName))) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:46'!
queryGlobalSearch
	" querys everything
	closes window"

	| queryAlias |

	queryAlias := FillInTheBlankMorph request: 'Enter data to query' initialAnswer: 'alias'.
	(queryAlias = '') ifFalse: [
		(GenealogyMap withOutRelatives: (Query generalSearch: queryAlias)) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:46'!
queryLivedIn
	" querys for when one has lived
	closes window"

	| queryBirthLocation |

	queryBirthLocation := FillInTheBlankMorph request: 'Enter location to query' initialAnswer: 'birth location'.
	(queryBirthLocation = '') ifFalse: [
		(GenealogyMap withOutRelatives: (Query livedIn: queryBirthLocation)) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:46'!
queryLivedOn
	" querys for where one has lived
	closes window"

	| birthDateQuery |

	birthDateQuery := FillInTheBlankMorph request: 'Enter date to query' initialAnswer: '9/8/81'.
	(birthDateQuery = '') ifFalse: [
		[(GenealogyMap withOutRelatives: (Query livedOn: (Date fromString: birthDateQuery))) open] ifError:[.]
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:46'!
queryMale
	" querys for males
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query isMale))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
queryMisc
	" querys for a misc
	closes window"

	| key value |

	key := FillInTheBlankMorph request: 'Enter key information to query' initialAnswer: 'key'.
	(key = '') ifFalse: [
		value := FillInTheBlankMorph request: 'Enter value information to query' initialAnswer: 'value'.
		(value = '') ifFalse: [
			(GenealogyMap withOutRelatives: (model searchFor: (Query hasInfo: key as: value))) open.
		].
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
queryParent
	" querys for a parent
	closes window"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people ) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #queryParentWith:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
queryParentWith: parent
	" querys for a parent
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query hasParent: parent))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
querySibling
	" querys for a sibling
	closes window"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people ) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #querySiblingWith:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
querySiblingWith: sibling
	" querys for a sibling
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query hasSibling: sibling))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:45'!
querySpouse
	" querys for a spouse
	closes window"

	| menu |
	menu _ MenuMorph new.
	menu add: ('Select a Person')
		target: model
		selector: #hasSibling:
		argument: nil.
	menu addLine.
	(self windowOwner people ) do:[: aPerson |
		menu add: (aPerson asStringOrText)
			target: self
			selector: #querySpouseWith:
			argument: aPerson.
	].
	menu popUpInWorld.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:44'!
querySpouseWith: spouse
	" querys for a spouse
	closes window"

	|  |

	(GenealogyMap withOutRelatives: (model searchFor: (Query married: spouse))) open.
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:44'!
querySurName
	" querys for a sur name
	closes window"

	| querySurName |

	querySurName := FillInTheBlankMorph request: 'Enter sur name to query' initialAnswer: 'sur name'.
	(querySurName = '') ifFalse: [
		(GenealogyMap withOutRelatives: (model searchFor: (Query surName: querySurName))) open.
	].
	self delete.! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 05:12'!
windowOwner ^windowOwner
! !

!QueryInputMorph methodsFor: 'as yet unclassified' stamp: 'tss 10/22/2002 03:45'!
windowOwner: w
	windowOwner _ w.! !

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

QueryInputMorph class
	instanceVariableNames: ''!

!QueryInputMorph class methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 12:57'!
openOn: aModel owner: wOwner
	"create this morph with given model and owner morph"

	| toRet |
	toRet := super new.
	toRet windowOwner: wOwner.
	toRet model: aModel.
	toRet position: 300@20.
	toRet openInWorld.
	^toRet.! !


EllipseMorph subclass: #RadioButtonMorph
	instanceVariableNames: 'callbackObject callbackSymbol innerEllipse '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!RadioButtonMorph commentStamp: '' prior: 0!
This morph is a radio button that can be changed between two states, set and not set.!


!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:53'!
callbackObject ^callbackObject! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:53'!
callbackSymbol ^callbackSymbol! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:53'!
callbackSymbol: aSymbol callbackSymbol _ aSymbol! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:49'!
handlesMouseDown: evt
	^ true.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:33'!
initialize
	super initialize.
	self extent: 10@10.
	self color: Color green.
	innerEllipse _ EllipseMorph new.
	innerEllipse extent: 4@4.
	innerEllipse color: Color red.
	innerEllipse borderWidth: 0.
	self addMorph: innerEllipse.
	innerEllipse position: 3@3.
	innerEllipse visible: false.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:35'!
isSet
	^ innerEllipse visible.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:55'!
mouseDown: evt
	callbackObject perform: callbackSymbol.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:20'!
mouseEnter: evt
	|  |
	super mouseEnter: evt.
	self borderColor: Color red.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:16'!
mouseLeave: evt
	|  |
	super mouseLeave: evt.
	self borderColor: Color black.! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:33'!
set
	innerEllipse visible: true! !

!RadioButtonMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:33'!
unset
	innerEllipse visible: false! !


!RadioButtonMorph methodsFor: 'nil' stamp: 'tss 12/4/2002 15:53'!
callbackObject: anObject callbackObject _ anObject! !

!RadioButtonMorph methodsFor: 'nil' stamp: 'tss 12/4/2002 15:47'!
handlesMouseOver: evt
	^ true.! !

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

RadioButtonMorph class
	instanceVariableNames: ''!

!RadioButtonMorph class methodsFor: 'nil' stamp: 'tss 12/4/2002 15:52'!
on: object selector: symbol

	| toRet |
	
	toRet _ self new.
	toRet callbackObject: object.
	toRet callbackSymbol: symbol.
	^ toRet.! !


RectangleMorph subclass: #RadioButtonPairMorph
	instanceVariableNames: 'zeroOn radioButton1 radioButton2 '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!RadioButtonPairMorph commentStamp: '' prior: 0!
This has two radioButtonMoprhs.  It allows a user to select one or the other.  It can also be queried to see which one is currently selected.!


!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:27'!
initialize
	||
	super initialize.
	self extent: 50@16.
	radioButton1 _ RadioButtonMorph on: self selector: #zeroPressed.
	"radioButton1 set."
	radioButton2 _ RadioButtonMorph on: self selector: #onePressed.
	"radioButton2 unset."
	self zeroPressed.
	self addMorph: (radioButton1 position: 8@3).
	self addMorph: (radioButton2 position: 32@3).! !

!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:21'!
mouseDown: evt
	self set.! !

!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:37'!
mouseEnter: evt
	self set.! !

!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:57'!
onePressed
	radioButton1 unset.
	radioButton2 set.! !

!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 16:36'!
zeroIsSet
	^radioButton1 isSet! !

!RadioButtonPairMorph methodsFor: 'as yet unclassified' stamp: 'tss 12/4/2002 15:57'!
zeroPressed
	radioButton1 set.
	radioButton2 unset.! !


Object subclass: #WebPage
	instanceVariableNames: 'doc url baseUrl data '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!WebPage commentStamp: '' prior: 0!
A class that acts as an abstract class in the system. It defines some of the common behaviours for th efive pages that were parsed. Most of its methods are overriden in the subclasses, but a few methods apply to all webpages in question, therefore these methods were placed in here. !


!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:41'!
SSN
	"Ment to be overridden if the page will parse for and return SSN data from the page."
	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:42'!
address
	"Ment to be overridden if the page will parse for and return address data from the page."

	^SortedCollection new! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:42'!
birthdate
	"Ment to be overridden if the page will parse for and return birthdate data from the page."

	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:44'!
bornLocation
	"Ment to be overridden if the page will parse for and return birth location data from the page."

	^SortedCollection new! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:45'!
check
	"Common method that checks if any listings were found on any of the sites. If more specific cheking needs to be done, then override this method."

	|tokens token |

	tokens _ HtmlTokenizer on: doc.
	[(token_tokens next) = nil] whileFalse:
	[
		((token isText) and:[ token text = 'Sorry, no listings were found. '
						or:[	token text = 'Nothing found matching your search criteria'
						or:[ token text = 'Nothing found'
						or:[ token text = 'Your search has returned no results.'
						or:[ token text = 'No Matches']]]]]) ifTrue:
		[
			^false.
		]
	].
	^true.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:43'!
children
	"Ment to be overridden if the page will parse for and return children data from the page."

	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:46'!
data
	"Common method that returns the table with the parsed information. The information is NOT formatted for displaying."
	^data! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:44'!
deathLocation
	"Ment to be overridden if the page will parse for and return death location data from the page."

	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:44'!
deathdate
	"Ment to be overridden if the page will parse for and return death date data from the page."
	
	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:48'!
formatData: aCollection
	"I remove the '{Html***:' parts of all the tokens that Squeak inserts when getting information from the web using our method."
	|l dt|
	dt _ OrderedCollection new.
	aCollection do: [ :i | l _ i size. dt addLast: (i collect: [ :s | s.] from: 11 to: (l - 1))]. 
	^ dt.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:44'!
marriages
	"Ment to be overridden if the page will parse for and return marriage data from the page."

	^SortedCollection new.! !

!WebPage methodsFor: 'general' stamp: 'Dino 11/3/2002 21:44'!
phoneNumber
	"Ment to be overridden if the page will parse for and return phone number data from the page."

	^SortedCollection new.! !


WebPage subclass: #FifthPage
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!FifthPage commentStamp: '' prior: 0!
Parses the first page out of the total five pages. The url that it gets information from is 'http://www.familysearch.org/Eng/Search/'. !


!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:06'!
birthdate
	"Assumes all formating has been done on the data in the data field. It extracts birthdays out of the table and returns them as a collection."

	|retCollection index cr|
	retCollection _ OrderedCollection new.
	index _ 1.
	cr _ String with:(Character cr).
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[
		((data at:index) beginsWith:(cr, 'Gender:')) ifTrue: 
		[
			retCollection addLast:(data at:index). " add only those lines that contain the information within the body..."
		].
		index _ index + 1.
	].
	retCollection _ self extractDate. " ... and then extract the date from that body..."
	retCollection  _ self removeRepeats: retCollection.
	^ retCollection! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:00'!
bornLocation
	"Assumes all formating has been done on the data in the data field. It extracts birth locations out of the table and returns them as a collection."

	|index retCollection cr |
	index _ 1.
	cr _ String with:(Character cr).
	retCollection _ OrderedCollection new.
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[
		((data at:index) beginsWith:(cr, 'Gender:')) ifTrue:
		[
			retCollection addLast:(data at:index).
		].
		index _ index + 1.
	].
	retCollection _ self extractBirthLocation. "call the extracting method"
	retCollection _ retCollection reject:[ :i | i =''].
	retCollection _ retCollection reject:[ :i | i includesSubString:'<'].
	retCollection _ retCollection reject:[ :i | i includesSubString:'Of'].
	retCollection _ self removeRepeats: retCollection.
	^retCollection

	! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:08'!
containsNumber: aCollection
	"Answers positive if aCollction contains at least one number in it. Assumes that all entries in aCollection are strings."

	|index|
	index _ 1.
	[index > aCollection size] whileFalse:
	[
		((aCollection at: index) isAllDigits) ifTrue:[^true].
		index _ index + 1.
	].
	^false.! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:53'!
extract
	"Tokenizes the document contained in the doc field. Then stores into data field the table with all of the information. Very specific to the web page, but it gets the work done - untill they change the layout of the page; then it will fail -- miserably."

	|tokens token|
	(self check) ifTrue:
	[
		tokens _ HtmlTokenizer on: doc.
		token _ tokens next.
		[token = nil] whileFalse:
		[
			((token isText) and:[token text = 'International Genealogical Index / NA']) ifTrue: 
			[
				[(token isText) and: [token text beginsWith:'Matches:']] whileFalse:
				[
					(token isText)ifTrue:
					[
						data ifNil:[ data _ OrderedCollection new].
						data addLast: token asString.
						token _ tokens next.
					]
					ifFalse:
					[		
						token _ tokens next.
					]
				]
			].
			token _ tokens next.
		].
	 	self organizeData.
	]
! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:01'!
extractBirthLocation
	"Assumes that all entries in the data table are correct and performs extraction of dates from the table -- not a pretty method."

	|temp index retCollection|
	retCollection _ OrderedCollection new.
	temp _ String new.
	index _ 1.
	[index > data size] whileFalse:
	[
		temp _ data at: index.
		retCollection addFirst:(self getBirthLocation:temp). "acctual extractor"
		index _ index + 1.
	].
	^retCollection! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:57'!
extractDate
	"Assumes that all entries in the data table are correct and performs extraction of dates from the table -- not a pretty method."

	|temp index retCollection|
	retCollection _ OrderedCollection new.
	temp _ String new.
	index _ 1.
	[index > data size] whileFalse:
	[
		temp _ data at: index.
		retCollection addLast:(self getDate:temp). " extract the acctual date"
		index _ index + 1.
	].
	"Following lines do some post rejecting, sorting kind of stuff..."
	retCollection _ retCollection reject:[ :i | i isKindOf: FifthPage].
	retCollection _ retCollection reject:[ :i | (i includesSubString:'Of')].
	retCollection _ retCollection reject:[ :i | (i endsWith:',')].
	^retCollection " ... and finally the collection with only dates is returned.."! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:03'!
getBirthLocation: aString
	"forms the location from th etokens that are found and returns the locationa as a collection."

	|tokens entry index cr|
	entry _ String new.
	cr _ String with:(Character cr).
	tokens _ aString findTokens: cr, ':-, '."tokenize the string"
	index _ tokens size. "set the index to the last token"
	(index > 1) ifTrue: 
	[
		(self containsNumber: tokens) ifTrue: " make sure we are dealing with a string that has atleast one number in it"
		[
			[(index < 1) or:[(tokens at: index) isAllDigits]] whileFalse:
			[
				entry _ (tokens at:index)asString, ' ', entry. "form the entry"
				index _ index - 1.
			].
		]
	].
	^entry "finally return the entry that was found"
	
		! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:59'!
getDate: aString
	"Acctual extraction method -- see extractBirthLocation"

	|tokens position entry |
	entry _ String new.
	position _ 1.
	tokens _ aString findTokens: ': '. "split the string into tokens"
	[(position > tokens size)] whileFalse:
	[
		[(position > tokens size) or:[(tokens at:position) isAllDigits]] whileFalse:
		[
			position _ position + 1.
		].
		(position+3 > tokens size) ifFalse:
		[
			^entry, (tokens at: position), ' ',  (tokens at: position + 1), ' ',  (tokens at: position + 2). " add the three tokens forming the data and return it"
		].
		position _ position + 1.
		
	]. 
! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:45'!
organizeData
	"Removes all entries from the data field that are not needed."

	|cr|
	cr _ String with:(Character cr).
	(data isNil) ifFalse:
	[
		data _ data reject:[ :i | i = '{HtmlText: }'].
		data _ data reject:[ :i | i = '{HtmlText:International Genealogical Index / NA}'].
		data _ data reject:[ :i | i endsWith: (cr, '}')].
		data _ self formatData: data.
	].! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:53'!
queryFifthPage: givenName lName: surName
	"Sets the base url and from it builds the url of the page that is queried and parsed."

	baseUrl _ 	'http://www.familysearch.org/Eng/Search/ancestorsearchresults.asp?first_name='.
	url _ baseUrl asString, givenName, '&last_name=', surName.
	self queryWeb.! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:45'!
queryWeb
	"Grabs the contents of the page and stores them in the doc field."

	doc _ (HTTPSocket httpGet: url) contents.
	self extract.! !

!FifthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 23:04'!
removeRepeats: aCollection
	"Removes repeating entries from a collection"

	|newCollection index temp temp2 |
	index _ 1.
	newCollection _ OrderedCollection new.
	[index+1 > aCollection size] whileFalse:
	[
		temp _ aCollection at: index.
		temp2 _ aCollection at: index+1.
		(temp = temp2) ifFalse:
		[
			newCollection addLast: temp
		].
		index _ index + 1.
	].
	^newCollection! !

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

FifthPage class
	instanceVariableNames: ''!

!FifthPage class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 22:52'!
with: givenName with: surName
	"Sets the given name field --gName. It also calls the initial query function."
	|o|
	o _ super new.
	o queryFifthPage: givenName lName: surName.
	^o! !


WebPage subclass: #FirstPage
	instanceVariableNames: 'gName '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!FirstPage commentStamp: '' prior: 0!
Parses the first page out of the total five pages. The url that it gets information from is 'http://ssdi.rootsweb.com'. !


!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:10'!
SSN
	"Assumes all the formating and organizing on the data table has been performed. Extracts the SSN fields out of the table and returns them as a collection.Very specific to the data obtained from this wepage."

	|index retCollection|
	retCollection _ OrderedCollection new.
	index _ 1.
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[ 
		((data at: index) beginsWith: (gName asUppercase)) ifTrue:
		[
			index _ index + 1.
			[(index > data size) or:[(data at: index) beginsWith: (gName asUppercase)]] whileFalse:
			[
				index _ index + 1.
			].
			retCollection addLast: (data at: index - 2)
		].
	].
	^retCollection
	! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:12'!
birthdate
	"Assumes all formating has been done on the data in the data field. It extracts birthdays out of the table and returns them as a collection."

	|index retCollection l ret |
	retCollection _ OrderedCollection new.
	ret _ OrderedCollection new.
	index _ 1.
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[ 
		((data at: index) beginsWith: (gName asUppercase)) ifTrue:
		[
			retCollection addLast: (data at: (index+1)).
		].
	index _ index + 1.
	].
	retCollection do:[ :i | l _ i size. ret addLast: (i collect: [ :s | s] from:1 to: (l - 3))].			
	^ret

	! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:12'!
deathLocation
	"Assumes all formating has been done on the data in the data field. It extracts death locations out of the table and returns them as a collection."

	|index retCollection temp|
	temp _ String new.
	retCollection _ OrderedCollection new.
	index _ 1.
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[ 
		((data at: index) beginsWith: (gName asUppercase)) ifTrue:
		[
			((data at: (index + 4)) endsWith: 'specified)') ifTrue:
			[ 	
				temp _ 'none specified'.
			]
			ifFalse:
			[
				temp _ ((data at:(index+3))asString, (data at: (index +4))asString).
			].
			retCollection addLast: (temp).
		].
	index _ index + 1.
	].			
	^retCollection
! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:12'!
deathdate
	"Assumes all formating has been don on the data in the data field. It extracts deathdates out of the table."

	|index retCollection l ret|
	retCollection _ OrderedCollection new.
	ret _ OrderedCollection new.
	index _ 1.
	(data isNil) ifTrue:[^nil].
	[index > data size] whileFalse:
	[ 
		((data at: index) beginsWith: (gName asUppercase)) ifTrue:
		[
			retCollection addLast: (data at: (index+2)).
		].
	index _ index + 1.
	].		
	retCollection do: [ :i | l _ i size. ret addLast: (i collect: [ :s | s] from:1 to:(l -3))]. 	
	^ret! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:05'!
extract
	"Tokenizes the document contained in the doc field. Then stores into data field the table with all of the information. Very specific to the web page, but it gets the work done - untill they change the layout of the page; then it will fail -- miserably."

	|tokens token|
	(self check) ifTrue: "check if any hits were returned"
	[
		tokens _ HtmlTokenizer on: doc. "tokenize the page."
		token _ tokens next.
		[token = nil] whileFalse:
		[
			((token isText) and:[token text = 'Name']) ifTrue: "'Name' token is start of data we need" 
			[
				[(token isTag) and: [token name = 'p']] whileFalse: "'p' tag is the end of data we need"
				[
					(token isText) ifTrue: "in between those two grab every text token found"
					[
						data ifNil: [data _ OrderedCollection new].
						data addLast: token asString. 
						token _ tokens next.
					]
					ifFalse:
					[
						token _ tokens next.
					].
				].
			].
			token _ tokens next.
		].
		self organizeData. "once done, organize the data in the data field"
	]
	ifFalse: "no hits"
	[
		Transcript show: 'Nothing found'.
	]! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:17'!
gName: aName
	"Sets the first name field used by some methods."
	gName _ aName.! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:08'!
organizeData
	"Removes all entries from the data field that are not needed."

	| cr |
	cr _ String with:(Character cr).
	(data isNil) ifFalse:
	[
		9 timesRepeat: [data removeFirst].
		data _ data reject:[ :index |  index = '{HtmlText:SS-5 Letter}'  "Fields with any of these entries...."
							   or: [ index = '{HtmlText:Add Post-em}' " ... are not needed .... "
							   or: [ index = '{HtmlText:Search Ancestry.com}' " ... and they are discarded..."
					    


        or: [ index = '{HtmlText: }'  " .... leaving only tokens of interest..."
							   or: [ index = '{HtmlText: }'        " ... in the data field of the class."
							   or: [ index = '{HtmlText:)}']]]]] ].
		data _ data reject:[ :index | index endsWith: (cr, '}')].
		data _ self formatData: data. "remove the annoying '{Html**:' stuff from the tokens"
	]! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 21:57'!
queryFirstPage: givenName lName: surName
	"Sets the base url and from it builds the url of the page that is queried and parsed."

	baseUrl _ 'http://ssdi.rootsweb.com/cgi-bin/ssdi.cgi?'.
	url _ baseUrl asString, 'lastname=', surName, '&firstname=', givenName, '&nt=exact'.
	self queryWeb.! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:00'!
queryWeb
	"Grabs the contents of the page and stores them in the doc field."

	doc := (HTTPSocket httpGet: url) contents.
	self extract.! !

!FirstPage methodsFor: 'specifics' stamp: 'Dino 10/30/2002 19:45'!
surName: aName
	surName _ aName.! !

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

FirstPage class
	instanceVariableNames: ''!

!FirstPage class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 22:44'!
with: givenName with: surName
	"Sets the given name field --gName. It also calls the initial query function."

	|o|
	o _ super new.
	o queryFirstPage: givenName lName: surName.
	o gName: givenName.
	^o.! !


WebPage subclass: #FourthPage
	instanceVariableNames: 'sName '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!FourthPage commentStamp: '' prior: 0!
Parses the first page out of the total five pages. The url that it gets information from is 'http://phone.people.yahoo.com'. !


!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:51'!
address
	"Assumes all formating has been done on the data in the data field. It extracts addresses out of the table and returns them as a collection."

	|position temp entry aCollection |
	position _ 1.
	entry _ String new.
	aCollection _ OrderedCollection new.
	temp _ OrderedCollection new.
	(data isNil) ifTrue:[^nil].
	[position > data size] whileFalse:
	[
		((data at: position) endsWith: sName) ifTrue:
		[			
			[self phoneNumber:(data at: position)] whileFalse:
			[
				temp addLast:(data at:position).
				position _ position + 1.
				(position > data size) ifTrue:
				[
					"temp _ aCollection addAll: temp.Transcript show: temp."					
					^ aCollection.
				]
			].
			temp do:[ :i | ((i endsWith: sName)not)ifTrue:[entry _ (entry, i)]]. "do some comressing of tokens into single entries ..."
			aCollection addLast: entry. " ... that are added to the collection"
			temp _ OrderedCollection new.
			entry _ ''.
			position _ position + 1.
		]
	].
	^aCollection	




	"[position > data size] whileFalse:
	[
		[self phoneNumber:(data at: position)] whileFalse:
		[
			temp addLast:(data at:position).
			position _ position + 1.
			(position >data size) ifTrue:
			[
				^temp.
			]
		].
		temp do:[ :i | ((i endsWith:sName)not)ifTrue:[entry _ (entry, i)]].
		temp _ OrderedCollection new.
		aCollection addLast:entry.
		entry _ ''.
		position _ position + 1.
	].
	^aCollection."














"[position > data size] whileFalse:
	[
		((data at: position) endsWith: sName) ifTrue:
		[		
			position _ position + 1.			
			[(data at: position) endsWith: sName] whileFalse:
			[
				[position > data size] whileFalse:
				[
					temp addLast:(data at: position)asString.
					position _ position + 1.
					(position > data size) ifTrue:
					[
						^(retCollection addLast: (temp)).
					]
				].
			position _ position + 1.
			].
			retCollection addLast: temp.
		].
		position _ position + 1.
	].
	^retCollection."





! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:48'!
extractFourth
	"Tokenizes the document contained in the doc field. Then stores into data field the table with all of the information. Very specific to the web page, but it gets the work done - untill they change the layout of the page; then it will fail -- miserably."

	|token tokens |
	(self check) ifTrue: "check for no listing error"
	[
		tokens _ HtmlTokenizer on: doc.
		token _ tokens next.
		[token = nil] whileFalse:
		[
			((token isText) and:[ token text = 'Phone']) ifTrue: " Look for the beginning token ... "
			[
				[(token isText) and:[ token text = 'ADVERTISEMENT']] whileFalse: "... untill the ending token found"
				[ 
					(token isText) ifTrue:  " ... add all the text tokens between the two"
					[	
						data ifNil:[ data _ OrderedCollection new].
						data addLast: token asString.
						token _ tokens next.
					]
					ifFalse:
					[
						token _ tokens next.
					].
				].
			].
			token _ tokens next.
		].
		self organizeDataIV.
	]
	ifFalse: "listiong error occured"
	[
		Transcript show: 'Sorry, nothing matched your criteria.'
	]! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:45'!
organizeDataIV
	"Removes all entries from the data field that are not needed."
	
	|return|
	return _ String with:(Character cr).
	(data isNil) ifFalse:
	[ 
		data _ data reject:[ :i | i = '{HtmlText: }'
							or:[ i = '{HtmlText:Next}']].
		data _ data reject:[ :i | i endsWith: (':', return, '}')].
		data _ data reject:[ :i | i endsWith: (':', return, return, '}')].
		data _ data reject:[ :i | i endsWith:(':', return, return, return, return, '}')].
		data _ data reject:[ :i | i endsWith:'Phone}'].
		data _ data reject:[ :i | i endsWith: '(click to call)}'].
		data _ data reject:[ :i | i endsWith: ' }'].
		data _ data reject:[ :i | i endsWith: 'Want more information?}'].
		data _ data reject:[ :i | i endsWith:'Get a "US Search"}'].
		data _ data reject:[ :i | i includesSubString: 'Previous'].
		data _ data reject:[ :i | i includesSubString: '|'].
		2 timesRepeat:[ data removeLast]..
		data _ self formatData: data.
	]! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:50'!
phoneNumber: aString
	"Answers whether or not aString is a phone number or not. It expects to find all numbers delimited by '-' in which case it returns true. Otherwise it returns false."

	|temp count str|
	count _ 0.
	str _ String with:(Character cr).
	str _ str, '()- '. "tokenize the string"
	temp _ aString findTokens: str.
	(temp isNil) ifFalse:
	[
		temp do:[ :i | (i isAllDigits) ifTrue:[ count _ count +1]].
		(count = temp size) ifTrue:
		[
			^true.
		]
	].
	^false.
	! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:44'!
queryFourthPage:givenName lName: surName
	"Sets the base url and from it builds the url of the page that is queried and parsed."
	
	baseUrl _ 'http://phone.people.yahoo.com/py/psPhoneSearch.py?FirstName='.
	url _ (baseUrl asString, givenName, '&LastName=', surName, '&City=&State=').
	self queryWebFourth.! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:45'!
queryWebFourth
	"Grabs the contents of the page and stores them in the doc field."

	doc _ (HTTPSocket httpGet: url) contents.
	self extractFourth.! !

!FourthPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:49'!
sName: aName
	"Sets the sName"

	sName _ aName.! !

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

FourthPage class
	instanceVariableNames: ''!

!FourthPage class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 22:44'!
with: givenName with: surName
	"Sets the given name field --gName. It also calls the initial query function."

	|o|
	o _ super new.
	o queryFourthPage: givenName lName: surName.
	o sName: surName.
	^o.! !


WebPage subclass: #SecondPage
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!SecondPage commentStamp: '' prior: 0!
Parses the second page out of the total five pages. The url that it gets information from is 'http://worldconnect.rootsweb.com'.!


!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:28'!
children
	"Assumes all formating has been done on the data in the data field. It extracts children information out of the table."

	|position limit temp offset str|
	position _ 1.
	offset _ 3.
	str _ String with:(Character cr).
	str _ str , 'Children'.
	limit _ data size.
	temp _ OrderedCollection new.
	[position > data size] whileFalse:
	[
		((data at: position) = str) ifTrue:
		[
			[(offset + position) <= limit] whileTrue:
			[
				temp addLast: (data at:(position + offset)).
				offset _ offset + 1.
			]
		].
	position _ position + 1.
	].
	^temp.
			! !

!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:27'!
extractSecond
	"parses the second page obtained from the table on the previous page. It extracts teh acctual tokens used by the rest of the system. "

	|tokens token|
	doc := (HTTPSocket httpGet: url) contents. "grabs the page"
	tokens _ HtmlTokenizer on: doc. "tokenize the page"

	token _ tokens next.
	[token = nil] whileFalse:
	[ 
		((token isText) and:[token text = 'Name:']) ifTrue: "look for start token"
		[
			[(token isText) and: [token text = 'Index']] whileFalse: "once we found the start token we go on until we find the Index -- end -- token."
			[
				(token isText) ifTrue: " add all text tokens before we hit the end token"
				[
					data ifNil: [data _ OrderedCollection new].
					data addLast: token asString. 
					token _ tokens next.
				]
				ifFalse:
				[
					token _ tokens next.
				].
			].
		].
		token _ tokens next.
	].
	self organizeDataII. "organize the tokens -- remove once not needed and remove tags from them"! !

!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:28'!
marriages
	"Assumes all formating has been done on the data in the data field. It extracts marriage information out of the table."

	|position count temp|
	position _ 1.
	temp _ OrderedCollection new.
	[position > data size] whileFalse:
	[
		((data at: position) = 'Marriage') ifTrue:
		[
			count _ (data at: position+1) asInteger.
			[count = 0] whileFalse:
			[
				temp addLast: (data at:(position + (count+1))).
				count _ count - 1.
			]
		].
		position _ position + 1.
	].
	^temp	! !

!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:27'!
organizeDataII
	"Removes all entries from the dataII field that are not needed. Ending order of entries is: Name, Birth date, Death date, Spouse name, rest of entries are children."

	|ret|
	ret _ String with:(Character cr).
	(data isNil) ifFalse:
	[
		data removeFirst.
		data _ data reject:[ :i | i endsWith: 'Sex:}'].
		data _ data reject:[ :i | i endsWith: 'M', ret, '}'].
		data _ data reject:[ :i | i endsWith: 'F', ret, '}'].
		data _ data reject:[ :i | i beginsWith:'{HtmlText: b:'].
		data _ data reject:[ :i | i = '{HtmlText: }'].
		data _ self formatData: data. 
	]! !

!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:20'!
querySecondPage: givenName lName: surName
	"Sets the base url and from it builds the url of the page that is queried and parsed."

	baseUrl _ 'http://worldconnect.rootsweb.com/cgi-bin/igm.cgi?'.
	url _ baseUrl asString, 'surname=', surName, '&given=', givenName, '&start=1'.
	self queryWebSecond.! !

!SecondPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:23'!
queryWebSecond
	"Tokenizes the first page of the Second Webpage object. It obtains a table of entries from the query and then it follows the first link inthe table to get to the information."

	|token tokens c piece rest l rst |
	c _ 1.
	piece _ String new.
	rst _ OrderedCollection new.
	doc := (HTTPSocket httpGet: url) contents. "grabs contents"
	(self check) ifTrue: "checks to see if hits were returned"
	[
		tokens _ HtmlTokenizer on: doc."tokenizes the page"
		baseUrl _ (baseUrl, 'op=GET').
	
		token _ tokens next.
		[token = nil] whileFalse:
		[ 
			((token isText) and:[token text = 'Database']) ifTrue:
			[
				[c = 2] whileFalse:
				[
					((token isTag) and:[token name = 'a']) ifTrue:
					[
						c _ c + 1.
						piece _ token asString.
						token _ tokens next.
					]
					ifFalse:
					[
						token _ tokens next.
					]
				].
			].
		token _ tokens next.
		].
		piece _ piece collect:[ :i | i ]from: 42 to: (piece size - 3).
		rest _ piece findTokens: '&'.		
		rest do: [ :i | l _ i size. rst addLast: (i collect:[ :s | s ] from:5 to: l) ].
		url _ baseUrl, '&', (rst at:1), '&', (rst at:2).
		self extractSecond. "extracts info from the second page"
	]
	ifFalse: "no hits"
	[
		Transcript show: 'Nothing matched your criteria'; cr.
	]! !

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

SecondPage class
	instanceVariableNames: ''!

!SecondPage class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 22:19'!
with: givenName with: surName
	"invokes the query method with proper params."

	|o|
	o _ super new.
	o querySecondPage: givenName lName: surName.
	^o! !


WebPage subclass: #ThirdPage
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!ThirdPage commentStamp: '' prior: 0!
Parses the third page out of the total five pages. The url that it gets information from is 'http://theultimates.whitepages.com/'. !


!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:38'!
address
	"Assumes all formating has been done on the data in the data field. It extracts addresses out of the table and returns them as a collection."

	|temp position addr aCollection entry|
	position _ 1.
	addr _OrderedCollection new.
	aCollection _ OrderedCollection new.
	temp _ OrderedCollection new.
	entry _ String new.
	(data isNil) ifTrue:[^nil].
	[position > data size] whileFalse: " while not at the end of table"
	[
		[self phoneNumber:(data at: position)] whileFalse: "until we have not seen a phone number continue ..."
		[
			temp addLast: (data at: position). " ... add the info in the table at this position..."
			position _ position + 1.
			(position > data size) ifTrue: "If we are at the end of table just..."
			[
				^(temp addLast: addr)." .. return what we got so far"
			].			
		].
		temp do:[:i | entry _ (entry, i)]. "From all entries in temp create one and .... "
		temp _ OrderedCollection new.
		aCollection addLast: entry. "... add it to the collection which is ..."
		entry _ ''.
		position _ position + 1.
	].
	^aCollection. "... returned"! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:33'!
extractThird
	"Tokenizes the document contained in the doc field. Then stores into data field the table with all of the information. Very specific to the web page, but it gets the work done - untill they change the layout of the page; then it will fail -- miserably."

	|token tokens|
	(self check) ifTrue: "check for no listing error"
	[
		tokens _ HtmlTokenizer on: doc. "tokenize the page"
		token _ tokens next.
		[token = nil] whileFalse: "while not at the end of list"
		[
			((token isTag) and:[token name = 'span']) ifTrue: "if start of info seen -- span token"
			[
				token _ tokens next.
				[(token isTag) and: [token name = 'span']] whileFalse: "continue untill the closing span token is not seen"
				[
					(token isText) ifTrue: " add all text tokens to the data table"
					[
						data ifNil: [data _ OrderedCollection new].
						data addLast: token asString.
						token _ tokens next.
					]
					ifFalse:
					[
						token _ tokens next.
					].
				].
			].
			token _ tokens next.
		].
		self organizeDataIII. "organize the table"
	]
	ifFalse: "no listing error occured"
	[
		Transcript show: 'No listings found :('; cr.
	]! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:34'!
organizeDataIII
	"Removes all entries from the data field that are not needed."	

	(data isNil) ifFalse:
	[
		data _ data reject:[ :i | i = '{HtmlText: }'
								or:[ i beginsWith: '{HtmlText:Would you']].
		data _ data reject:[ :i | i beginsWith:'{HtmlText:Want to find'].
		data _ data reject:[ :i | i beginsWith:'{HtmlText:More Info'].
		data _ data reject:[ :i | i endsWith:'Search public records}'].
		data _ data reject:[ :i | i beginsWith: '{HtmlText:Find all info'].
		data _ data reject:[ :i | i = '{HtmlText:Map this location}'].
		data _ self formatData: data.
	]
								
	! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:39'!
phoneNumber
	"Assumes all formating has been done on the data in the data field. It extracts phone numbers out of the table and returns them as a collection."

	|temp position addr|
	position _ 1.
	addr _ OrderedCollection new.
	temp _ OrderedCollection new.
	(data isNil) ifTrue:[^nil].
	[position > data size] whileFalse:
	[
		[self phoneNumber:(data at: position)] whileFalse:
		[
			position _ position + 1.
			(position > data size) ifTrue:
			[
				^(temp addLast: addr).
			].
			addr _ ''.
			addr _ addr,  (data at: position)asString.
		].
		temp addLast: addr.		
		position _ position + 1.
	].
	^temp.! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:42'!
phoneNumber: aString
	"Answers whether or not aString is a phone number or not. It expects to find all numbers delimited by '-' in which case it returns true. Otherwise it returns false."

	|temp count str|
	count _ 0.
	str _ String with:(Character cr).
	str _ str, '-'.
	temp _ aString findTokens: str. "tokenize the string "
	(temp isNil) ifFalse:
	[
		temp do:[ :i | (i isAllDigits) ifTrue:[count _ count + 1]]. "count how many all-digit tokens we got from tokenizing the string and if ...."
		(count = temp size) ifTrue: " ... all were numbers then ..."
		[
			^true  " return true otherwise ...."
		].
	].
	^false. "....return false"! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:30'!
queryThirdPage: givenName lName: surName
	"Sets the base url and from it builds the url of the page that is queried and parsed."

	baseUrl _ 'http://theultimates.whitepages.com/find_person_results.pl?l='.
	url _ ((baseUrl asString), surName, '&f=', givenName, 										'&c=&s=&fid=n&ft=b<=b').
	self queryWebThird.
! !

!ThirdPage methodsFor: 'specifics' stamp: 'Dino 11/3/2002 22:30'!
queryWebThird
	"Grabs the contents of the page and stores them in the doc field."

	doc _ (HTTPSocket httpGet: url) contents.
	self extractThird.! !

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

ThirdPage class
	instanceVariableNames: ''!

!ThirdPage class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 22:29'!
with: givenName with: surName
"Invokes the query method with proper params."

	|o|
	o _ super new.
	o queryThirdPage: givenName lName: surName.
	^o.! !


Object subclass: #WebQuery
	instanceVariableNames: 'pageI pageII pageIII pageIV pageV searchGivenName searchSurName person '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!WebQuery commentStamp: '' prior: 0!
Acts as a buffer class between the GUI part of the system and the webpage parsing module. When instantiated, the method execute needs to be invoked in odrer for it to get the five pages parsed. It keeps pointers to these five pages through its instance variables: pageI, pageII, pageIII, pageIV, pageV. 


!


!WebQuery methodsFor: 'initialization' stamp: 'Dino 11/3/2002 21:25'!
searchGivenName: aName






	"Sets the last name field to hte param."

	searchGivenName _ aName.! !

!WebQuery methodsFor: 'initialization' stamp: 'Dino 11/3/2002 21:25'!
searchSurName: aName



	"Sets the first name field to the param."




	searchSurName _ aName.! !


!WebQuery methodsFor: 'testing' stamp: 'Dino 11/3/2002 21:27'!
page



	"Method used during testing. It returns the table with all the information that is parsed from the first page."
	
	^pageI data.! !

!WebQuery methodsFor: 'testing' stamp: 'Dino 11/3/2002 21:29'!
pageII



	"Method used during testing. It returns the table with all the information that is parsed from the fifth page."




	^pageII data.! !

!WebQuery methodsFor: 'testing' stamp: 'Dino 11/3/2002 21:28'!
pageIII






	"Method used during testing. It returns the table with all the information that is parsed from the third page."

	^pageIII data! !

!WebQuery methodsFor: 'testing' stamp: 'Dino 11/3/2002 21:29'!
pageIV
	"Method used during testing. It returns the table with all the information that is parsed from the fourth page."




	^pageII data.! !

!WebQuery methodsFor: 'testing' stamp: 'Dino 11/3/2002 21:29'!
pageV
	"Method used during testing. It returns the table with all the information that is parsed from the fifth page."




	^pageV data.! !


!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:30'!
SSN
	"Collects all SSNs returned from all of the pages and returns the overall collection."

	|temp aCollection|



	temp _ SortedCollection new.



	((aCollection _ pageI SSN) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII SSN) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII SSN) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV SSN) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:30'!
address
	"Collects all addresses returned from all of the pages and returns the overall collection."




	|temp aCollection|



	temp _ SortedCollection new.



	((aCollection _ pageI address) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII address) isNil) ifFalse:



	[




		temp addAll: aCollection.



	].



	((aCollection _ pageIII address) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV address) isNil) ifFalse:



	[



		temp addAll: aCollection.


	
	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 10/31/2002 16:05'!
birthdate
	|temp aCollection|
	temp _ OrderedCollection new.
	((aCollection _ pageI birthdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageII birthdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageIII birthdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageIV birthdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:31'!
bornDate
	"Collects all born dates returned from all of the pages and returns the overall collection."




	|temp aCollection|



	temp _ SortedCollection new.
	aCollection _ SortedCollection new.



	((aCollection _ pageI birthdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII birthdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII birthdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV birthdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:31'!
bornLocation
	"Collects all birth locations returned from all of the pages and returns the overall collection."

	|temp aCollection|



	temp _ SortedCollection new.
	aCollection _ SortedCollection new.



	((aCollection _ pageI bornLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII bornLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII bornLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV bornLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:31'!
children
	"Collects all children returned from all of the pages and returns the overall collection."




	|temp aCollection|



	temp _ OrderedCollection new.



	((aCollection _ pageI children) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII children) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII children) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV children) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.


! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:32'!
deathDate
	"Collects all death dates returned from all of the pages and returns the overall collection."

	|temp aCollection|



	temp _ SortedCollection new.



	((aCollection _ pageI deathdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII deathdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII deathdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV deathdate) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:32'!
deathLocation
	"Collects all death locations returned from all of the pages and returns the overall collection."







	|temp aCollection|



	temp _ SortedCollection new.



	((aCollection _ pageI deathLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII deathLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII deathLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV deathLocation) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 10/31/2002 16:09'!
deathdate

		|temp aCollection|
	temp _ OrderedCollection new.
	((aCollection _ pageI deathdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageII deathdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageIII deathdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	((aCollection _ pageIV deathdate) isNil) ifFalse:
	[
		temp addAll: aCollection.
	].
	^ temp.! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:36'!
execute
	"I execute the parsing of the webpages."







	pageI _ FirstPage with: searchGivenName with: searchSurName.



	pageII _ SecondPage with: searchGivenName with: searchSurName.



	pageIII _ ThirdPage with: searchGivenName with: searchSurName.



	pageIV _ FourthPage with: searchGivenName with: searchSurName.



	pageV _ FifthPage with: searchGivenName with: searchSurName


	! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:32'!
marriages
	"Collects all marriages returned from all of the pages and returns the overall collection."

	|temp aCollection |



	temp _ SortedCollection new.



	((aCollection _ pageI marriages) size = 0) ifFalse:




	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII marriages) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII marriages) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV marriages) size = 0) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.


	! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:33'!
person
	"Returns person field."
	 ^person! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:33'!
person: aPerson
	"Sets person field."
	 person_aPerson! !

!WebQuery methodsFor: 'execution' stamp: 'Dino 11/3/2002 21:32'!
phoneNumber
	"Collects all phone numbers returned from all of the pages and returns the overall collection."



	
	|temp aCollection|



	temp _ SortedCollection new.



	((aCollection _ pageI phoneNumber)isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageII phoneNumber) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIII phoneNumber)isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	((aCollection _ pageIV phoneNumber) isNil) ifFalse:



	[



		temp addAll: aCollection.



	].



	^ temp.! !

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

WebQuery class
	instanceVariableNames: ''!

!WebQuery class methodsFor: 'as yet unclassified' stamp: 'Dino 11/3/2002 21:24'!
from: aPerson
	"Sets the name fields from the Person's object. The rest of the methods use these name values as the main information for querying the five webpages."
		






	|o|



	o _ super new.



	o person: aPerson.



	o searchGivenName: aPerson givenName.



	o searchSurName: aPerson surName.



	^ o.	! !

!WebQuery class methodsFor: 'as yet unclassified' stamp: 'Dino 10/30/2002 15:23'!
new: aPerson

	|o|
	o _ super new.
	o searchGivenName: aPerson givenName.
	o searchSurName: aPerson surName..
	^ o.	! !


Morph subclass: #WebQueryMorph
	instanceVariableNames: 'person webQuery aspect selectedIndex currentField '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!WebQueryMorph commentStamp: '' prior: 0!
This morph allows the user to fill in information from the given WebQuery instance on a given aspect of the Person from the WebQuery.!


!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:02'!
initializeFrom: wq aspect: newAspect
	"initialize morph with the title being the full name of the person the WebQuery is using"

	| title |

	title := (wq person givenName),' ',(wq person surName).
	self initializeFrom: wq aspect: newAspect title: title.


"DO NOT EDIT THE BELOW....IT IS NOT EXECUTED"
"	
	self selectedIndex: 0.

	self extent: 400@200.

	webQuery := wq.
	person := webQuery person.
	person addDependent: self.
	aspect := newAspect.

	self addMorph: ((StringMorph new) position: (180@5);
										contents: (person givenName),' ',(person surName)).

	self addMorph: ((StringMorph new) position: (5@30); contents: 'Current: ').

	currentField := StringMorph new.
	self setCurrentText.

	self addMorph: (currentField position: 80@30).

	selectionButton := PluggableButtonMorph on: self
		getState: nil
		action: #selectionMade.
	selectionButton label: 'Change'.
	self addMorph: (selectionButton position: 5@50).

	scrollList := PluggableListMorph on: self
		list: #list
		selected: #selectedIndex
		changeSelected: #selectedIndex:
		.
	scrollList scrollBarOnLeft: true.
	scrollList extent: 180@50.
	self addMorph: (scrollList position: 80@50).

"! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:04'!
initializeFrom: wq aspect: newAspect title: title
	"initialize this morph using the given WebQuery, symbol(aspect), and title"

	| scrollList selectionButton labelAspect |
	
	self selectedIndex: 0.

	self extent: 350@120.
	self color: (Color yellow veryMuchLighter).

	webQuery := wq.
	person := webQuery person.
	person addDependent: self.
	aspect := newAspect.

	self addMorph: ((StringMorph new) position: (60@5); contents: title).

	self addMorph: ((StringMorph new) position: (5@30); contents: 'Current').

	"set a label based on aspect of person used"
	labelAspect := 'Unknown Type'.
	(#bornDate = aspect) ifTrue: [
		labelAspect := 'Birthday'.
	].
	(#bornLocation = aspect) ifTrue: [
		labelAspect := 'Birth place'.
	].
	(#deathLocation = aspect) ifTrue: [
		labelAspect := 'Death location'.
	].
	(#deathDate = aspect) ifTrue: [
		labelAspect := 'Date of death'.
	].
	(#SSN = aspect) ifTrue: [
		labelAspect := 'SSN'.
	].
	(#address = aspect) ifTrue: [
		labelAspect := 'Address'.
	].
	(#phoneNumber = aspect) ifTrue: [
		labelAspect := 'Phone Number'.
	].
	self addMorph: ((StringMorph new) position: (5@45); contents: labelAspect,':').

	"get current information in aspect of person"
	currentField := StringMorph new.
	self setCurrentText.

	self addMorph: (currentField position: 100@40).

	self addMorph: ((StringMorph new) position: (5@70); contents: 'Web Results:').

	selectionButton := PluggableButtonMorph on: self
		getState: nil
		action: #selectionMade.
	selectionButton label: 'Change'.
	self addMorph: (selectionButton position: 10@90).

	scrollList := PluggableListMorph on: self
		list: #list
		selected: #selectedIndex
		changeSelected: #selectedIndex:
		.
	scrollList scrollBarOnLeft: true.
	scrollList extent: 250@50.
	self addMorph: (scrollList position: 80@70).! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:05'!
list
	"returns data from WebQuery object as model for the ListMorph using aspect used in
	 initialization"

	| |
	^ webQuery perform: aspect.! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:06'!
selectedIndex
	"returns index of list"

	| |
	^ selectedIndex.! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:06'!
selectedIndex: index
	"sets index of list"

	| |
	selectedIndex := index.
	"Transcript show: 'index to: ',(index asString);cr."
	self changed: #selectedIndex.! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:07'!
selectionMade
	"makes change to Person object"

	| |
	
	(selectedIndex = 0) ifFalse: [ "nothing selected"
		(#SSN = aspect) ifTrue: [
			person record: 'SSN' as: ((self list at: selectedIndex) asString).
		].
		(#address = aspect) ifTrue: [
			person record: 'address' as: ((self list at: selectedIndex) asString).
		].
		(#bornDate = aspect) ifTrue: [
			[person born: (Date fromString:((self list at: selectedIndex) asString))
				location: (person bornLocation)] ifError: [ ]. "error in case bad information"
		].
		(#bornLocation = aspect) ifTrue: [
			person born: (person bornDate)
				location: ((self list at: selectedIndex) asString).
		].
		(#deathDate = aspect) ifTrue: [
			[person died: (Date fromString:((self list at: selectedIndex) asString))] ifError: [.].
			 "error in case bad information"
		].
		(#deathLocation = aspect) ifTrue: [
			person died: (person deathDate) location:((self list at: selectedIndex) asString).
		].
		(#phoneNumber = aspect) ifTrue: [
			person record: 'Phone Number' as: ((self list at: selectedIndex) asString).
		].

	].! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:08'!
setCurrentText
	"sets label indication current value of the aspect of the Person"

	| value |
	(#bornDate = aspect) ifTrue: [
		value := person bornDate.
	].
	(#bornLocation = aspect) ifTrue: [
		value := person bornLocation.
	].
	(#deathDate = aspect) ifTrue: [
		value := person deathDate.
	].
	(#deathLocation = aspect) ifTrue: [
		value := person deathLocation.
	].
	(#SSN = aspect) ifTrue: [
		value := person miscRecords at: 'SSN' ifAbsent: [ '' ]. 
	].
	(#address = aspect) ifTrue: [
		value := person miscRecords at: 'address' ifAbsent: [ '' ]. 
	].
	(#phoneNumber = aspect) ifTrue: [
		value := person miscRecords at: 'Phone Number' ifAbsent: [ '' ]. 
	].
	value ifNotNil: [ value := value asString ] ifNil: [ value := '' ].

	currentField contents: value.! !

!WebQueryMorph methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:08'!
update: newAspect
	"receives notification when Person changes"

	(#data = newAspect) ifTrue: [
		self setCurrentText.
	].! !

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

WebQueryMorph class
	instanceVariableNames: ''!

!WebQueryMorph class methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:01'!
from: wq aspect: newAspect
	"create this morph using the given WebQuery and symbol"

	| toRet |
	toRet := super new.
	toRet initializeFrom: wq aspect: newAspect.
	^ toRet.	! !

!WebQueryMorph class methodsFor: 'as yet unclassified' stamp: 'TEO 11/4/2002 13:02'!
from: wq aspect: newAspect title: title
	"create this morph using the given WebQuery and symbol and title for morph"

	| toRet |
	toRet := super new.
	toRet initializeFrom: wq aspect: newAspect title: title.
	^ toRet.	! !


RectangleMorph subclass: #WebQueryMorphContainer
	instanceVariableNames: 'model owningWindow '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm7'!
!WebQueryMorphContainer commentStamp: '' prior: 0!
This morph contains WebQueryMorphs.

It main purpose is to capture mouse clicks and do the appropriate things with them.

i.e. display a menu or pass it along to a contained morph.!


!WebQueryMorphContainer methodsFor: 'events' stamp: 'tss 11/4/2002 11:35'!
mouseMove: evt

	" Sends the mouse move event to the proper submorphs"

	|  |
	super mouseMove: evt.
	submorphs do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m mouseMove: evt]].! !

!WebQueryMorphContainer methodsFor: 'events' stamp: 'tss 11/4/2002 11:35'!
mouseUp: evt

	" Sends the mouse up event to the proper submorphs"	

	|  |
	super mouseUp: evt.
	submorphs do: [:m | (m containsPoint: evt cursorPoint) ifTrue: [m mouseUp: evt]].! !


!WebQueryMorphContainer methodsFor: 'accessing' stamp: 'tss 11/4/2002 11:36'!
model: aModel

	model _ aModel.! !

!WebQueryMorphContainer methodsFor: 'accessing' stamp: 'tss 11/4/2002 11:36'!
mouseDown: evt

	" Sends the mouse down event to the proper submorphs"

	| menu subMorphsPoint |

		subMorphsPoint _ false.
		submorphs do: [:m | (m containsPoint: evt cursorPoint) 
			ifTrue: [subMorphsPoint _ true. m mouseDown: evt]].
		(subMorphsPoint not) ifTrue: [
			menu _ MenuMorph new.
			menu add: 'Close' target: model action: #delete.
			menu popUpInWorld.
		].! !

m7UML Monkeys with Vertigo

Link to this Page