DNA Lists Helper.fh_lua--[[
@Title: DNA Lists Helper
@Author: Jane Taubman
@Version: 1.1
@LastUpdated: 18 March 2019
@Description:
Set of 4 tools to show direct lines for Male and Female Ancestors and mt-DNA and Y-DNA links, excluding people who have been Adopted or Fostered.
]]
function main()
fhInitialise(6)
fhSetStringEncoding('UTF-8')
local ptrIndi = fhPromptUserForRecordSel('INDI',1)[1]
if not(ptrIndi) then return end
local options = {"Maternal Line","Mta DNA Matches","Paternal Line","Y Chromosome Matches","X Chromosome Ancestors"}
intButton = iupButtons("DNA Lists","Please select the List you want to create","V",unpack(options))
print("Button "..intButton.." Pressed")
if intButton == 3 and fhGetItemText(ptrIndi,'~.SEX') == 'Female' then
fhMessageBox('Please note as you have select a Root Female, she will be included in the result even though she does not carry the Y Chromosome')
end
local tbl = {}
if intButton == 1 then tbl = getFemaleLine(ptrIndi) end
if intButton == 2 then tbl = getMtDNA(ptrIndi) end
if intButton == 3 then tbl = getMaleLine(ptrIndi) end
if intButton == 4 then tbl = getY(ptrIndi) end
if intButton == 5 then tbl = getX(ptrIndi) end
if #tbl > 0 then
fhOutputResultSetTitles(options[intButton]..' For '..fhGetDisplayText(ptrIndi))
local tblRelated = {}
local tblDates = {}
for i,v in ipairs(tbl) do
tblRelated[i] = fhCallBuiltInFunction('Relationship',ptrIndi,v)
tblDates[i] = fhCallBuiltInFunction('LifeDates',v)
end
fhOutputResultSetColumn("Individuals", "item",tbl,#tbl,120)
fhOutputResultSetColumn("Life Dates", "text",tblDates,#tbl,50)
fhOutputResultSetColumn("Relationship", "text",tblRelated,#tbl,120)
end
end
----------------------------------------------------------------------------------- functions
function getFemaleLine(ptrIndi)
-- Needs to check multiple Families in case first listed is adopted
local tblList = {}
local i = 0
local ptrLoop = ptrIndi:Clone()
while ptrLoop:IsNotNull() do
i = i + 1
tblList[i] = ptrLoop:Clone()
local ptrFamLink = fhNewItemPtr()
ptrFamLink:MoveTo(ptrLoop,'~.FAMC')
ptrLoop:SetNull()
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Mother is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'mother')) and ptrLoop:IsNull() then
ptrLoop:MoveTo(ptrFamLink,'~>WIFE>')
print(fhGetDisplayText(ptrLoop)..' '..fhGetRecordId(ptrLoop))
end
ptrFamLink:MoveNext('SAME_TAG')
end
end
return tblList
end
function getMaleLine(ptrIndi)
-- Needs to check multiple Families in case first listed is adopted
local tblList = {}
local i = 0
local ptrLoop = ptrIndi:Clone()
while ptrLoop:IsNotNull() do
i = i + 1
tblList[i] = ptrLoop:Clone()
local ptrFamLink = fhNewItemPtr()
ptrFamLink:MoveTo(ptrLoop,'~.FAMC')
ptrLoop:SetNull()
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Father is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'father')) and ptrLoop:IsNull() then
ptrLoop:MoveTo(ptrFamLink,'~>HUSB>')
print(fhGetDisplayText(ptrLoop)..' '..fhGetRecordId(ptrLoop))
end
ptrFamLink:MoveNext('SAME_TAG')
end
end
return tblList
end
function getMtDNA(ptrIndi)
local tblFemale = getFemaleLine(ptrIndi)
local ptrRoot = tblFemale[#tblFemale]
local i,j = 1,1
local ptrChild = fhNewItemPtr()
local ptrWork = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local tblList = {ptrRoot:Clone()}
while tblList[i] and tblList[i]:IsNotNull() do
-- if current entry is female
-- for all children add them to table
sSex = fhGetItemText(tblList[i],'~.SEX')
if sSex == 'Female' then -- If Parent is Female add the Children.
local c = 1
ptrChild:MoveTo(tblList[i],'~.~CHIL[1]>')
while ptrChild:IsNotNull() do
while ptrChild:IsNotNull() do
-- Check for Adoption
if not(adopted(tblList[i],ptrChild)) then
print(fhGetDisplayText(ptrChild)..' '..fhGetRecordId(ptrChild))
j= j + 1
tblList[j] = ptrChild:Clone()
end
c = c + 1
ptrChild:MoveTo(tblList[i],'~.~CHIL['..c..']>')
end
end
end
i = i + 1
end
return tblList
end
function getY(ptrIndi)
local tblMale = getMaleLine(ptrIndi)
local ptrRoot = tblMale[#tblMale]
local i,j = 1,1
local ptrChild = fhNewItemPtr()
local ptrWork = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local tblList = {ptrRoot:Clone()}
while tblList[i] and tblList[i]:IsNotNull() do
-- if current entry is Male
-- for all children add them to table
sSex = fhGetItemText(tblList[i],'~.SEX')
if sSex == 'Male' then -- If Parent is Male add the sons.
local c = 1
ptrChild:MoveTo(tblList[i],'~.~CHIL[1]>')
while ptrChild:IsNotNull() do
sChildSex = fhGetItemText(ptrChild,'~.SEX')
if sChildSex == 'Male' then -- If Child is Male add the sons.
-- Check for Adoption
if not(adopted(tblList[i],ptrChild)) then
print(fhGetDisplayText(ptrChild)..' '..fhGetRecordId(ptrChild))
j= j + 1
tblList[j] = ptrChild:Clone()
end
end
c = c + 1
ptrChild:MoveTo(tblList[i],'~.~CHIL['..c..']>')
end
end
i = i + 1
end
return tblList
end
function getX(ptrIndi)
local i,j = 1,1
local ptrWork = fhNewItemPtr()
local ptrMother = fhNewItemPtr()
local ptrFather = fhNewItemPtr()
local tblX = {}
tblX[1] = ptrIndi:Clone()
while tblX[i] and tblX[i]:IsNotNull() do
sSex = fhGetItemText(tblX[i],'~.SEX')
local ptrFamLink = fhNewItemPtr()
ptrMother:SetNull()
ptrFather:SetNull()
ptrFamLink:MoveTo(tblX[i],'~.FAMC')
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Mother/Father is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'mother')) and ptrMother:IsNull() then
ptrMother:MoveTo(ptrFamLink,'~>WIFE>')
end
if not(getPedi(fhGetValueAsLink(ptrFamLink),'father')) and ptrFather:IsNull() then
ptrFather:MoveTo(ptrFamLink,'~>HUSB>')
end
ptrFamLink:MoveNext('SAME_TAG')
end
if ptrMother:IsNotNull() then
j =j + 1
tblX[j] = ptrMother:Clone()
end
if ptrFather:IsNotNull() and sSex == 'Female' then
j =j + 1
tblX[j] = ptrFather:Clone()
end
i = i + 1
end
return tblX
end
------------------------------------------------------------------------ Helper Functions
function getPedi(ptrFamLink,sSide)
sSide = sSide:lower()
local ptrPedi = fhNewItemPtr()
ptrPedi:MoveTo(ptrFamLink,'~.PEDI')
while ptrPedi:IsNotNull() do
sPedi = fhGetValueAsText(ptrPedi)
print(sPedi)
if sPedi == 'Adopted' or sPedi == 'De Facto' or sPedi == 'Foster' then
return true
end
if sPedi:find(sSide) and not(sPedi:find('Birth')) then
return true
end
ptrPedi:MoveNext('SAME_TAG')
end
end
function adopted(ptrParent,ptrChild)
local function getPedi(ptrFamLink,sSide)
sSide = sSide:lower()
local ptrPedi = fhNewItemPtr()
ptrPedi:MoveTo(ptrFamLink,'~.PEDI')
while ptrPedi:IsNotNull() do
sPedi = fhGetValueAsText(ptrPedi)
print(sPedi)
if sPedi == 'Adopted' or sPedi == 'De Facto' or sPedi == 'Foster' then
return true
end
if sPedi:find(sSide) and not(sPedi:find('Birth')) then
return true
end
ptrPedi:MoveNext('SAME_TAG')
end
end
local ptrFamLink = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local ptrMother = fhNewItemPtr()
local ptrFather = fhNewItemPtr()
local bAdopted = false
local ptrWork = fhNewItemPtr()
-- Read all Family As Child Looking for Parent
-- If found check the PEDI fields for Non Birth
ptrFamLink:MoveTo(ptrChild,'~.FAMC')
while ptrFamLink:IsNotNull() do
ptrFam = fhGetValueAsLink(ptrFamLink)
ptrMother:MoveTo(ptrFam,'~.WIFE>')
ptrFather:MoveTo(ptrFam,'~.HUSB>')
if ptrMother:IsSame(ptrParent) then
bAdopted = getPedi(ptrFamLink,'mother')
else
if ptrFather:IsSame(ptrParent) then
bAdopted = getPedi(ptrFamLink,'father')
end
end
ptrFamLink:MoveNext('SAME_TAG')
end
return bAdopted
end
------------------------------------------------------------------------ Standard Functions
--[[
@Title: User Interface Buttons Snippet
@Author: Mike Tate / Jane Taubman
@LastUpdated: May 2012
@Version: 1.4
@Description: GUI dialogue for multiple buttons
@params
strTitle: Title of Message Box
strMessage: Message to show above buttons
strBoxType: Either "H" for Horizontal buttons or "V" for Vertical ones.
... : All other parameters will be treated as button titles.
]]
function iupButtons(strTitle,strMessage,strBoxType,...)
local intButton = 0 -- Returned value if X Close button is used
-- Create the GUI labels and buttons
local lblMessage = iup.label{title=strMessage,expand="YES"}
local lblLineSep = iup.label{separator="HORIZONTAL"}
local iupBox = iup.hbox{homogeneous="YES"}
if strBoxType == "V" then
iupBox = iup.vbox{homogeneous="YES"}
end
for intArgNum, strButton in ipairs(arg) do
local btnName = iup.button{title=strButton,expand="YES",padding="4",
action=function() intButton=intArgNum return iup.CLOSE end }
iup.Append(iupBox,btnName)
end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local dialogue = iup.dialog{title=strTitle,iup.vbox{lblMessage,lblLineSep,iupBox},
dialogframe="YES",background="250 250 250",gap="8",margin="8x8"}
dialogue:show()
if (iup.MainLoopLevel()==0) then iup.MainLoop() end
dialogue:destroy()
return intButton
end -- function iupButtons
-------------------------------------------------------------------------------------------- main
main()
--[[
@Title: DNA Lists Helper
@Author: Jane Taubman
@Version: 1.1
@LastUpdated: 18 March 2019
@Description:
Set of 4 tools to show direct lines for Male and Female Ancestors and mt-DNA and Y-DNA links, excluding people who have been Adopted or Fostered.
]]
function main()
fhInitialise(6)
fhSetStringEncoding('UTF-8')
local ptrIndi = fhPromptUserForRecordSel('INDI',1)[1]
if not(ptrIndi) then return end
local options = {"Maternal Line","Mta DNA Matches","Paternal Line","Y Chromosome Matches","X Chromosome Ancestors"}
intButton = iupButtons("DNA Lists","Please select the List you want to create","V",unpack(options))
print("Button "..intButton.." Pressed")
if intButton == 3 and fhGetItemText(ptrIndi,'~.SEX') == 'Female' then
fhMessageBox('Please note as you have select a Root Female, she will be included in the result even though she does not carry the Y Chromosome')
end
local tbl = {}
if intButton == 1 then tbl = getFemaleLine(ptrIndi) end
if intButton == 2 then tbl = getMtDNA(ptrIndi) end
if intButton == 3 then tbl = getMaleLine(ptrIndi) end
if intButton == 4 then tbl = getY(ptrIndi) end
if intButton == 5 then tbl = getX(ptrIndi) end
if #tbl > 0 then
fhOutputResultSetTitles(options[intButton]..' For '..fhGetDisplayText(ptrIndi))
local tblRelated = {}
local tblDates = {}
for i,v in ipairs(tbl) do
tblRelated[i] = fhCallBuiltInFunction('Relationship',ptrIndi,v)
tblDates[i] = fhCallBuiltInFunction('LifeDates',v)
end
fhOutputResultSetColumn("Individuals", "item",tbl,#tbl,120)
fhOutputResultSetColumn("Life Dates", "text",tblDates,#tbl,50)
fhOutputResultSetColumn("Relationship", "text",tblRelated,#tbl,120)
end
end
----------------------------------------------------------------------------------- functions
function getFemaleLine(ptrIndi)
-- Needs to check multiple Families in case first listed is adopted
local tblList = {}
local i = 0
local ptrLoop = ptrIndi:Clone()
while ptrLoop:IsNotNull() do
i = i + 1
tblList[i] = ptrLoop:Clone()
local ptrFamLink = fhNewItemPtr()
ptrFamLink:MoveTo(ptrLoop,'~.FAMC')
ptrLoop:SetNull()
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Mother is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'mother')) and ptrLoop:IsNull() then
ptrLoop:MoveTo(ptrFamLink,'~>WIFE>')
print(fhGetDisplayText(ptrLoop)..' '..fhGetRecordId(ptrLoop))
end
ptrFamLink:MoveNext('SAME_TAG')
end
end
return tblList
end
function getMaleLine(ptrIndi)
-- Needs to check multiple Families in case first listed is adopted
local tblList = {}
local i = 0
local ptrLoop = ptrIndi:Clone()
while ptrLoop:IsNotNull() do
i = i + 1
tblList[i] = ptrLoop:Clone()
local ptrFamLink = fhNewItemPtr()
ptrFamLink:MoveTo(ptrLoop,'~.FAMC')
ptrLoop:SetNull()
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Father is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'father')) and ptrLoop:IsNull() then
ptrLoop:MoveTo(ptrFamLink,'~>HUSB>')
print(fhGetDisplayText(ptrLoop)..' '..fhGetRecordId(ptrLoop))
end
ptrFamLink:MoveNext('SAME_TAG')
end
end
return tblList
end
function getMtDNA(ptrIndi)
local tblFemale = getFemaleLine(ptrIndi)
local ptrRoot = tblFemale[#tblFemale]
local i,j = 1,1
local ptrChild = fhNewItemPtr()
local ptrWork = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local tblList = {ptrRoot:Clone()}
while tblList[i] and tblList[i]:IsNotNull() do
-- if current entry is female
-- for all children add them to table
sSex = fhGetItemText(tblList[i],'~.SEX')
if sSex == 'Female' then -- If Parent is Female add the Children.
local c = 1
ptrChild:MoveTo(tblList[i],'~.~CHIL[1]>')
while ptrChild:IsNotNull() do
while ptrChild:IsNotNull() do
-- Check for Adoption
if not(adopted(tblList[i],ptrChild)) then
print(fhGetDisplayText(ptrChild)..' '..fhGetRecordId(ptrChild))
j= j + 1
tblList[j] = ptrChild:Clone()
end
c = c + 1
ptrChild:MoveTo(tblList[i],'~.~CHIL['..c..']>')
end
end
end
i = i + 1
end
return tblList
end
function getY(ptrIndi)
local tblMale = getMaleLine(ptrIndi)
local ptrRoot = tblMale[#tblMale]
local i,j = 1,1
local ptrChild = fhNewItemPtr()
local ptrWork = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local tblList = {ptrRoot:Clone()}
while tblList[i] and tblList[i]:IsNotNull() do
-- if current entry is Male
-- for all children add them to table
sSex = fhGetItemText(tblList[i],'~.SEX')
if sSex == 'Male' then -- If Parent is Male add the sons.
local c = 1
ptrChild:MoveTo(tblList[i],'~.~CHIL[1]>')
while ptrChild:IsNotNull() do
sChildSex = fhGetItemText(ptrChild,'~.SEX')
if sChildSex == 'Male' then -- If Child is Male add the sons.
-- Check for Adoption
if not(adopted(tblList[i],ptrChild)) then
print(fhGetDisplayText(ptrChild)..' '..fhGetRecordId(ptrChild))
j= j + 1
tblList[j] = ptrChild:Clone()
end
end
c = c + 1
ptrChild:MoveTo(tblList[i],'~.~CHIL['..c..']>')
end
end
i = i + 1
end
return tblList
end
function getX(ptrIndi)
local i,j = 1,1
local ptrWork = fhNewItemPtr()
local ptrMother = fhNewItemPtr()
local ptrFather = fhNewItemPtr()
local tblX = {}
tblX[1] = ptrIndi:Clone()
while tblX[i] and tblX[i]:IsNotNull() do
sSex = fhGetItemText(tblX[i],'~.SEX')
local ptrFamLink = fhNewItemPtr()
ptrMother:SetNull()
ptrFather:SetNull()
ptrFamLink:MoveTo(tblX[i],'~.FAMC')
while ptrFamLink:IsNotNull() do
-- Look for First Family As Child where the relationship with Mother/Father is not listed as anything other than Birth
if not(getPedi(ptrFamLink,'mother')) and ptrMother:IsNull() then
ptrMother:MoveTo(ptrFamLink,'~>WIFE>')
end
if not(getPedi(fhGetValueAsLink(ptrFamLink),'father')) and ptrFather:IsNull() then
ptrFather:MoveTo(ptrFamLink,'~>HUSB>')
end
ptrFamLink:MoveNext('SAME_TAG')
end
if ptrMother:IsNotNull() then
j =j + 1
tblX[j] = ptrMother:Clone()
end
if ptrFather:IsNotNull() and sSex == 'Female' then
j =j + 1
tblX[j] = ptrFather:Clone()
end
i = i + 1
end
return tblX
end
------------------------------------------------------------------------ Helper Functions
function getPedi(ptrFamLink,sSide)
sSide = sSide:lower()
local ptrPedi = fhNewItemPtr()
ptrPedi:MoveTo(ptrFamLink,'~.PEDI')
while ptrPedi:IsNotNull() do
sPedi = fhGetValueAsText(ptrPedi)
print(sPedi)
if sPedi == 'Adopted' or sPedi == 'De Facto' or sPedi == 'Foster' then
return true
end
if sPedi:find(sSide) and not(sPedi:find('Birth')) then
return true
end
ptrPedi:MoveNext('SAME_TAG')
end
end
function adopted(ptrParent,ptrChild)
local function getPedi(ptrFamLink,sSide)
sSide = sSide:lower()
local ptrPedi = fhNewItemPtr()
ptrPedi:MoveTo(ptrFamLink,'~.PEDI')
while ptrPedi:IsNotNull() do
sPedi = fhGetValueAsText(ptrPedi)
print(sPedi)
if sPedi == 'Adopted' or sPedi == 'De Facto' or sPedi == 'Foster' then
return true
end
if sPedi:find(sSide) and not(sPedi:find('Birth')) then
return true
end
ptrPedi:MoveNext('SAME_TAG')
end
end
local ptrFamLink = fhNewItemPtr()
local ptrFam = fhNewItemPtr()
local ptrMother = fhNewItemPtr()
local ptrFather = fhNewItemPtr()
local bAdopted = false
local ptrWork = fhNewItemPtr()
-- Read all Family As Child Looking for Parent
-- If found check the PEDI fields for Non Birth
ptrFamLink:MoveTo(ptrChild,'~.FAMC')
while ptrFamLink:IsNotNull() do
ptrFam = fhGetValueAsLink(ptrFamLink)
ptrMother:MoveTo(ptrFam,'~.WIFE>')
ptrFather:MoveTo(ptrFam,'~.HUSB>')
if ptrMother:IsSame(ptrParent) then
bAdopted = getPedi(ptrFamLink,'mother')
else
if ptrFather:IsSame(ptrParent) then
bAdopted = getPedi(ptrFamLink,'father')
end
end
ptrFamLink:MoveNext('SAME_TAG')
end
return bAdopted
end
------------------------------------------------------------------------ Standard Functions
--[[
@Title: User Interface Buttons Snippet
@Author: Mike Tate / Jane Taubman
@LastUpdated: May 2012
@Version: 1.4
@Description: GUI dialogue for multiple buttons
@params
strTitle: Title of Message Box
strMessage: Message to show above buttons
strBoxType: Either "H" for Horizontal buttons or "V" for Vertical ones.
... : All other parameters will be treated as button titles.
]]
function iupButtons(strTitle,strMessage,strBoxType,...)
local intButton = 0 -- Returned value if X Close button is used
-- Create the GUI labels and buttons
local lblMessage = iup.label{title=strMessage,expand="YES"}
local lblLineSep = iup.label{separator="HORIZONTAL"}
local iupBox = iup.hbox{homogeneous="YES"}
if strBoxType == "V" then
iupBox = iup.vbox{homogeneous="YES"}
end
for intArgNum, strButton in ipairs(arg) do
local btnName = iup.button{title=strButton,expand="YES",padding="4",
action=function() intButton=intArgNum return iup.CLOSE end }
iup.Append(iupBox,btnName)
end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local dialogue = iup.dialog{title=strTitle,iup.vbox{lblMessage,lblLineSep,iupBox},
dialogframe="YES",background="250 250 250",gap="8",margin="8x8"}
dialogue:show()
if (iup.MainLoopLevel()==0) then iup.MainLoop() end
dialogue:destroy()
return intButton
end -- function iupButtons
-------------------------------------------------------------------------------------------- main
main()Source:DNA-Lists-Helper.fh_lua