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

Monkeys with Vertigo M4

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

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


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

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

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

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

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

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

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

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

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

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

'.


	"People Sets"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

CheckResults class
	instanceVariableNames: ''!

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

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


Object subclass: #Family
	instanceVariableNames: 'father mother children '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!
!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: 'init' stamp: 'TEO 9/13/2002 16:49'!
initialize
	"comment stating purpose of message"

	children := IdentitySet new.! !

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

Family class
	instanceVariableNames: ''!

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

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


Object subclass: #GenealogyMap
	instanceVariableNames: 'people gMapMorph selectedIndex title '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!

!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: 'TEO 10/21/2002 14:53'!
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"
	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 10/22/2002 03:57'!
initialize
	"initializes the GenealogyMap"

	| |
	
	selectedIndex _ 1.
	people _ SortedCollection sortBlock: [:x :y| (x asStringOrText) <= (y asStringOrText)].
	"gMapMorph addMorph: (PersonMorph new position: 1000@1000)."! !

!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: '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: 'TEO 10/22/2002 06:23'!
selectThisPerson: aPerson
	"set the selected person in a list"

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

!GenealogyMap methodsFor: 'accessors' stamp: 'TEO 10/22/2002 06:23'!
selectedPerson
	"returns the selected person in the list"

	|   |
	(selectedIndex > (people size)) ifFalse:[^ 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: 'as yet unclassified' stamp: 'tss 10/6/2002 18:51'!
doNothing
	"does nothing"! !

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

GenealogyMap class
	instanceVariableNames: ''!

!GenealogyMap class methodsFor: 'instance creation' stamp: 'tss 10/22/2002 03:55'!
new
	"creates and initializes a new GeneologyMap"

	| |
	^ super new initialize.! !

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


SystemWindow subclass: #GenealogyMapMorph
	instanceVariableNames: 'scrollPane rectMorph genealogyMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!

!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: '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 '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!
!Marriage commentStamp: '' prior: 0!
Marriage keeps track of the information for a single marriage between a man and a woman.

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


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

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

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

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

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

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

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

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

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

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

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

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

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

Marriage class
	instanceVariableNames: ''!

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

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


Object subclass: #Person
	instanceVariableNames: 'givenName surName isFemale aliases familialRelationships marriageRelationships bornDate bornLocation deathDate deathLocation miscRecords '
	classVariableNames: 'AllPersons '
	poolDictionaries: ''
	category: 'm4'!
!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 10/22/2002 05:21'!
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 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/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 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 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 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 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 class
	instanceVariableNames: ''!

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

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

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

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

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

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


RectangleMorph subclass: #PersonContainerMorph
	instanceVariableNames: 'model owningWindow '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!

!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 10/21/2002 01:33'!
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: '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: 'm4'!

!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: 'm4'!

!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: 'TEO 10/22/2002 06:02'!
check
	"creates a Text Window that displays the check info for the person"

	| win |
	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 10/22/2002 03:44'!
mouseDown: evt
	| menu |
	menu _ MenuMorph new.
	menu add: ('Center on ', person givenName, ' ', person surName)
		target: windowOwner
		selector: #selectThisPerson:
		argument: person.
	menu addLine.
	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: 'Make a Query'
		target: QueryInputMorph
		selector: #openOn:owner:
		argumentList: (Array with:person with:windowOwner).
	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 10/17/2002 23:31'!
mouseLeave: evt
	|  |
	super mouseLeave: evt.
	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: 'tss 10/22/2002 05:53'!
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].! !

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

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

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

Possible useful expressions for doIt or printIt.

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

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


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

	^ birthDate.! !

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

	birthDate := checkDate! !

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

	^ birthLocation.! !

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

	birthLocation := checkPlace.! !

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

	^ deathDate.! !

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

	deathDate := checkDate.! !

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

	^ deathLocation.! !

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

	deathLocation := checkPlace.! !

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

	^ generalSearch.! !

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

	generalSearch := checkString.! !

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

	^ givenName.! !

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

	givenName := checkName.! !

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

	^ alias.! !

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

	alias := checkAlias.! !

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

	^ child.! !

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

	child := checkChild.! !

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

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

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

	^ propName.! !

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

	^ propValue.! !

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

	^ parent.! !

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

	parent := checkParent.! !

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

	^ sibling.! !

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

	sibling := checkSibling.! !

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

	male := false.! !

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

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

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

	male := true.! !

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

	^ male.! !

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

	^ livedIn! !

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

	livedIn := checkPlace.! !

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

	^ livedOn! !

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

	livedOn := checkDate.! !

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

	^ marriedTo.! !

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

	marriedTo := checkSpouse.! !

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

	^ surName.! !

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

	surName := checkName.! !

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

Query class
	instanceVariableNames: ''!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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


RectangleMorph subclass: #QueryInputMorph
	instanceVariableNames: 'windowOwner model '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'm4'!

!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: 'tss 10/22/2002 04:03'!
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.! !


The UML:

Link to this Page