All Pool Relatives Except Partner Ancestors.fh_lua--[[
@Title: All Pool Relatives Except Partner Ancestors
@Type: Standard
@Author: Mike Tate
@Contributors:
@Version: 1.1
@Keywords:
@LastUpdated: 26 Nov 2020
@Licence: This plugin is copyright (c) 2020 Mike Tate & contributors and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Lists all Pool relatives of selected Individuals, except the ancestral relatives of their Family Partners.
@V1.1: FH V7 Lua 3.5 IUP 3.28; progbar 3.0;
@V1.0: First published version dealing with common ancestor issues
@V0.1-0.9: Prototype versions for the FHUG
]]
if fhGetAppVersion() > 5 then fhSetStringEncoding("UTF-8") end -- Needed for Unicode
if fhGetAppVersion() > 6 then unpack = table.unpack end -- Needed for Lua 5.3
local strPluginName = " All Pool Relatives Except Partner Ancestors 1.1 "
--[[
@Module: +fh+progbar_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 27 Aug 2020
@Description: Progress Bar library module.
@V3.0: Function Prototype Closure version.
@V1.0: Initial version.
]]
local function progbar_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local tblBars = {} -- Table for optional external attributes
local strBack = "255 255 255" -- Background colour default is white
local strBody = "0 0 0" -- Body text colour default is black
local strFont = nil -- Font dialogue default is current font
local strStop = "255 0 0" -- Stop button colour default is red
local intPosX = iup.CENTER -- Show window default position is central
local intPosY = iup.CENTER
local intMax, intVal, intPercent, intStart, intDelta, intScale, strClock, isBarStop
local lblText, barGauge, lblDelta, btnStop, dlgGauge
local function doFocus() -- Bring the Progress Bar window into Focus
dlgGauge.BringFront="YES" -- If used too often, inhibits other windows scroll bars, etc
end -- local function doFocus
local function doUpdate() -- Update the Progress Gauge and the Delta % with clock
barGauge.Value = intVal
lblDelta.Title = string.format("%4d %% %s ",math.floor(intPercent),strClock)
end -- local function doUpdate
local function doReset() -- Reset all dialogue variables and Update display
intVal = 0 -- Current value of Progress Bar
intPercent= 0.01 -- Percentage of progress
intStart = os.time() -- Start time of progress
intDelta = 0 -- Delta time of progress
intScale = math.ceil( intMax / 1000 ) -- Scale of percentage per second of progress (initial guess is corrected in Step function)
strClock = "00 : 00 : 00" -- Clock delta time display
isBarStop = false -- Stop button pressed signal
doUpdate()
doFocus()
end -- local function doReset
function fh.Start(strTitle,intMaximum) -- Create & start Progress Bar window
if not dlgGauge then
strTitle = strTitle or "" -- Dialogue and button title
intMax = intMaximum or 100 -- Maximun range of Progress Bar, default is 100
local strSize = tostring( math.max( 100, string.len(" Stop "..strTitle) * 8 ) ).."x30" -- Adjust Stop button size to Title
lblText = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Progress Message"; }
barGauge = iup.progressbar { RasterSize="400x30"; Value=0; Max=intMax; Tip="Progress Bar"; }
lblDelta = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Percentage and Elapsed Time"; }
btnStop = iup.button { Title=" Stop "..strTitle; RasterSize=strSize; FgColor=strStop; Tip="Stop Progress Button"; action=function() isBarStop = true end; } -- Signal Stop button pressed return iup.CLOSE -- Often caused main GUI to close !!!
dlgGauge = iup.dialog { Title=strTitle.." Progress "; Font=strFont; FgColor=strBody; Background=strBack; DialogFrame="YES"; -- Remove Windows minimize/maximize menu
iup.vbox{ Alignment="ACENTER"; Gap="10"; Margin="10x10";
lblText;
barGauge;
lblDelta;
btnStop;
};
move_cb = function(self,x,y) tblBars.X = x tblBars.Y = y end;
close_cb = btnStop.action; -- Windows Close button = Stop button
}
if type(tblBars.GUI) == "table"
and type(tblBars.GUI.ShowDialogue) == "function" then
dlgGauge.move_cb = nil -- Use GUI library to show & move window
tblBars.GUI.ShowDialogue("Bars",dlgGauge,btnStop,"showxy")
else
dlgGauge:showxy(intPosX,intPosY) -- Show the Progress Bar window
end
doReset() -- Reset the Progress Bar display
end
end -- function Start
function fh.Message(strText) -- Show the Progress Bar message
if dlgGauge then lblText.Title = strText end
end -- function Message
function fh.Step(intStep) -- Step the Progress Bar forward
if dlgGauge then
intVal = intVal + ( intStep or 1 ) -- Default step is 1
local intNew = math.ceil( intVal / intMax * 100 * intScale ) / intScale
if intPercent ~= intNew then -- Update progress once per percent or per second, whichever is smaller
intPercent = math.max( 0.1, intNew ) -- Ensure percentage is greater than zero
if intVal > intMax then intVal = intMax intPercent = 100 end -- Ensure values do not exceed maximum
intNew = os.difftime(os.time(),intStart)
if intDelta < intNew then -- Update clock of elapsed time
intDelta = intNew
intScale = math.ceil( intDelta / intPercent ) -- Scale of seconds per percentage step
local intHour = math.floor( intDelta / 3600 )
local intMins = math.floor( intDelta / 60 - intHour * 60 )
local intSecs = intDelta - intMins * 60 - intHour * 3600
strClock = string.format("%02d : %02d : %02d",intHour,intMins,intSecs)
end
doUpdate() -- Update the Progress Bar display
end
iup.LoopStep()
end
end -- function Step
function fh.Focus() -- Bring the Progress Bar window to front
if dlgGauge then doFocus() end
end -- function Focus
function fh.Reset() -- Reset the Progress Bar display
if dlgGauge then doReset() end
end -- function Reset
function fh.Stop() -- Check if Stop button pressed
iup.LoopStep()
return isBarStop
end -- function Stop
function fh.Close() -- Close the Progress Bar window
isBarStop = false
if dlgGauge then dlgGauge:destroy() dlgGauge = nil end
end -- function Close
function fh.Setup(tblSetup) -- Setup optional table of external attributes
if tblSetup then
tblBars = tblSetup
strBack = tblBars.Back or strBack -- Background colour
strBody = tblBars.Body or strBody -- Body text colour
strFont = tblBars.Font or strFont -- Font dialogue
strStop = tblBars.Stop or strStop -- Stop button colour
intPosX = tblBars.X or intPosX -- Window position
intPosY = tblBars.Y or intPosY
end
end -- function Setup
return fh
end -- local function progbar_v3
local progbar = progbar_v3() -- To access FH progress bars module
local dicFid = {[0]=true;} -- Dictionary of Families by Rec Id
local dicRid = {[0]=true;} -- Dictionary of Relatives by Rec Id
local arrRel = {} -- Result Set of Relatives and Rec Id
local arrRid = {}
local isAsso, isArel, isWitn, isWrel, fltGen -- GetParam() returned values
function RelationCodes(ptrInd,ptrRel) -- Generations up/down for direct blood relatives
for intRel = 1, 9 do
local strCodes = fhCallBuiltInFunction("Relationship",ptrInd,ptrRel,"CODE",intRel)
if #strCodes < 9 then return -999, -999 end -- No relationship at all
local strUp, strDown, strHalf, strStart, strEnd = strCodes:match("^Gens. Up=(.-), Gens. Down=(.-), Half=(.-), Spouse Start=(.-), Spouse End=(.-)$")
if strStart == "0" and strEnd == "0" then -- Exclude indirect reationships via spouses
return tonumber(strUp) or -999, tonumber(strDown) or -999
end
end
return -999, -999 -- No relationship at all
end -- function RelationCodes
function AddRelation(ptrInd,arrRec) -- Add person to List and Result Set
local intRid = fhGetRecordId(ptrInd)
if not dicRid[intRid] then -- Only add if not already listed
dicRid[intRid] = true
table.insert(arrRel,ptrInd:Clone()) -- Update the Result Set
table.insert(arrRid,intRid)
local isInclude = true -- Signal included as unrelated to any Spouse
for intRec, dicRec in ipairs (arrRec or {}) do
for intSpou, ptrSpou in ipairs (dicRec.Spou or {}) do
local intSpouUp, intSpouDown = RelationCodes(ptrInd,ptrSpou)
if intSpouDown > intSpouUp or intSpouUp + intSpouDown == 0 then
isInclude = false -- Signal excluded as a blood ancestor of a Spouse
local intRecUp, intRecDown = RelationCodes(ptrInd,dicRec.Root)
if intRecUp + intRecDown >= 0 and intRecUp / ( intRecUp + intSpouDown ) < fltGen then
return true -- Signal included as a blood relative of a Root closer to common ancestor than to Spouse
end
end
end
end
progbar.Step(1)
if progbar.Stop() then return false end -- Break out of inner loop
return isInclude -- Signal included or excluded as per above
end
return false -- Signal excluded as already listed
end -- function AddRelation
local arrFam = { "~.FAMS"; "~.FAMC"; }
local arrTag = { "~.HUSB"; "~.WIFE"; "~.CHIL"; }
function FindFamily(ptrInd,arrRec) -- Find all family relatives recursively
local ptrTag = fhNewItemPtr()
if isAsso then
ptrTag:MoveTo(ptrInd,"~.ASSO") -- Search for Associated Person instances
while ptrTag:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrTag)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) and isArel then FindFamily(ptrRel,arrRec) end
end
ptrTag:MoveNext("SAME_TAG")
end
end
if isWitn then
local ptrWit = fhNewItemPtr()
ptrTag:MoveToFirstChildItem(ptrInd) -- Search all V6 Fact Witness instances
while ptrTag:IsNotNull() do
if fhIsFact(ptrTag) then
ptrWit:MoveTo(ptrTag,"~._SHAR")
while ptrWit:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrWit)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) and isWrel then FindFamily(ptrRel,arrRec) end
end
ptrWit:MoveNext("SAME_TAG")
end
end
ptrTag:MoveNext("ANY")
end
end
local ptrFam = fhNewItemPtr()
for intFam, strFam in ipairs (arrFam) do -- Search all FAMS and FAMC instances
ptrFam:MoveTo(ptrInd,strFam)
while ptrFam:IsNotNull() do
local ptrRec = fhGetValueAsLink(ptrFam)
local intFid = fhGetRecordId(ptrRec) -- Only search each Family once
if not dicFid[intFid] then
dicFid[intFid] = true
for intTag, strTag in ipairs (arrTag) do -- Search all HUSB, WIFE, CHIL instances
ptrTag:MoveTo(ptrRec,strTag)
while ptrTag:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrTag)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) then FindFamily(ptrRel,arrRec) end
end
ptrTag:MoveNext("SAME_TAG")
end
end
dicFid[intFid] = true
end
ptrFam:MoveNext("SAME_TAG")
end
end
end -- function FindFamily
function GetParam()
local tblForm = {} -- Format strings for iup.GetParam
local tblData = {} -- Parameter values for iup.GetParam
local function setTables(strForm,strData) -- Set those lookup table to values below
table.insert(tblForm,strForm)
table.insert(tblData,strData)
end -- local function setTables
setTables( "All relatives of selected Individuals will be included,\r"..
"except for their partner/spouse ancestral branches. \r"..
"e.g. \r"..
"Select a son and siblings, and his father and siblings,\r"..
"to obtain father's ancestral tree and his descendants. \r"..
"This is often most easily achieved using a Diagram. %t" )
setTables( "%t" )
setTables( " Include Associated Persons ? %b{Include any Associated Persons of anyone included?}" , 1 )
setTables( " Include all their Relatives ? %b{Include all relatives of those Associated Persons?}" , 1 )
if fhGetAppVersion() > 5 then
setTables( "%t" )
setTables( " Include any Fact Witnesses ? %b{Include any Fact Witnesses of anyone included?}" , 1 )
setTables( " Include all their Relatives ? %b{Include all relatives of those Fact Witnesses?}" , 1 )
end
setTables( "%t" )
setTables( "A chosen person and partner/spouse may share ancestors. \r"..
"Shared relatives nearest such ancestors can be included.\r"..
"\r Portion of shared blood relatives to include ? \r\r\r %r[0.0,1.0,0.1]{Blood relatives of chosen person should be included.\rBlood relatives of partner/spouse should be excluded.\rSo this portion resolves that conflicting requirement.}" , 0.5 )
tblData = { iup.GetParam(strPluginName,nil,table.concat(tblForm,"\n").."\n",unpack(tblData)) }
if not tblData[1] then return false end
isAsso = ( tblData[2] == 1 )
isArel = ( tblData[3] == 1 )
isWitn = ( tblData[4] == 1 )
isWrel = ( tblData[5] == 1 )
fltGen = tblData[6]
return true
end -- function GetParam()
function ShowHelp()
local tblHelp = {}
table.insert(tblHelp,"When Plugin closes it lists all Individual records requested")
table.insert(tblHelp,"Use Ctrl+A on keyboard to select entire Result Set, then ...")
table.insert(tblHelp,"'Query Menu > Add Selected Cell Records to a Named List'")
table.insert(tblHelp,"'Export > GEDCOM File' and 'Select' from 'Named Lists' tab")
table.insert(tblHelp,"Select the Named List from above and click '>> Add All'")
fhMessageBox(table.concat(tblHelp,"\n\n"))
end -- function ShowHelp
function Main()
if not GetParam() then return end
local arrRec = fhGetCurrentRecordSel("INDI") -- Get preselected root Individuals
if #arrRec == 0 then
arrRec = fhPromptUserForRecordSel("INDI") -- Prompt for the root Individuals
if #arrRec == 0 then return end
end
for intRoot, ptrRoot in ipairs (arrRec) do
local arrSpou = {} -- List of Spouses
for intSpou = 1, 99 do -- Add each Spouse to exclude their ancestors
local ptrSpou = fhGetItemPtr(ptrRoot,"~.~SPOU["..intSpou.."]>")
if ptrSpou:IsNull() then break end
table.insert(arrSpou,ptrSpou)
end
arrRec[intRoot] = { Root=ptrRoot; Spou=arrSpou; } -- List of root Individuals each with a list of their Spouses
end
local intIndi = 0
local ptrIndi = fhNewItemPtr()
ptrIndi:MoveToFirstRecord("INDI") -- Get count of individuals for progress bar
while ptrIndi:IsNotNull() do
intIndi = intIndi + 1
ptrIndi:MoveNext("SAME_TAG")
end
progbar.Setup()
if intIndi > 999 then progbar.Start("Finding Relatives",intIndi) end
local arrText = {} -- Textual list of root Individuals
for intRec, dicRec in ipairs (arrRec) do
local ptrRoot = dicRec.Root
table.insert(arrText,fhGetDisplayText(ptrRoot))
if AddRelation(ptrRoot) then FindFamily(ptrRoot,arrRec) end -- Find all family relations
end
fhOutputResultSetTitles(table.concat(arrText,", ")..strPluginName)
fhOutputResultSetColumn("Relative", "item", arrRel, #arrRel, 200, "align_left" )
fhOutputResultSetColumn("Rec Id", "integer", arrRid, #arrRel, 40, "align_mid", 1 )
progbar.Close()
ShowHelp()
end -- function Main
Main()
--[[
@Title: All Pool Relatives Except Partner Ancestors
@Type: Standard
@Author: Mike Tate
@Contributors:
@Version: 1.1
@Keywords:
@LastUpdated: 26 Nov 2020
@Licence: This plugin is copyright (c) 2020 Mike Tate & contributors and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Lists all Pool relatives of selected Individuals, except the ancestral relatives of their Family Partners.
@V1.1: FH V7 Lua 3.5 IUP 3.28; progbar 3.0;
@V1.0: First published version dealing with common ancestor issues
@V0.1-0.9: Prototype versions for the FHUG
]]
if fhGetAppVersion() > 5 then fhSetStringEncoding("UTF-8") end -- Needed for Unicode
if fhGetAppVersion() > 6 then unpack = table.unpack end -- Needed for Lua 5.3
local strPluginName = " All Pool Relatives Except Partner Ancestors 1.1 "
--[[
@Module: +fh+progbar_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 27 Aug 2020
@Description: Progress Bar library module.
@V3.0: Function Prototype Closure version.
@V1.0: Initial version.
]]
local function progbar_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local tblBars = {} -- Table for optional external attributes
local strBack = "255 255 255" -- Background colour default is white
local strBody = "0 0 0" -- Body text colour default is black
local strFont = nil -- Font dialogue default is current font
local strStop = "255 0 0" -- Stop button colour default is red
local intPosX = iup.CENTER -- Show window default position is central
local intPosY = iup.CENTER
local intMax, intVal, intPercent, intStart, intDelta, intScale, strClock, isBarStop
local lblText, barGauge, lblDelta, btnStop, dlgGauge
local function doFocus() -- Bring the Progress Bar window into Focus
dlgGauge.BringFront="YES" -- If used too often, inhibits other windows scroll bars, etc
end -- local function doFocus
local function doUpdate() -- Update the Progress Gauge and the Delta % with clock
barGauge.Value = intVal
lblDelta.Title = string.format("%4d %% %s ",math.floor(intPercent),strClock)
end -- local function doUpdate
local function doReset() -- Reset all dialogue variables and Update display
intVal = 0 -- Current value of Progress Bar
intPercent= 0.01 -- Percentage of progress
intStart = os.time() -- Start time of progress
intDelta = 0 -- Delta time of progress
intScale = math.ceil( intMax / 1000 ) -- Scale of percentage per second of progress (initial guess is corrected in Step function)
strClock = "00 : 00 : 00" -- Clock delta time display
isBarStop = false -- Stop button pressed signal
doUpdate()
doFocus()
end -- local function doReset
function fh.Start(strTitle,intMaximum) -- Create & start Progress Bar window
if not dlgGauge then
strTitle = strTitle or "" -- Dialogue and button title
intMax = intMaximum or 100 -- Maximun range of Progress Bar, default is 100
local strSize = tostring( math.max( 100, string.len(" Stop "..strTitle) * 8 ) ).."x30" -- Adjust Stop button size to Title
lblText = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Progress Message"; }
barGauge = iup.progressbar { RasterSize="400x30"; Value=0; Max=intMax; Tip="Progress Bar"; }
lblDelta = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Percentage and Elapsed Time"; }
btnStop = iup.button { Title=" Stop "..strTitle; RasterSize=strSize; FgColor=strStop; Tip="Stop Progress Button"; action=function() isBarStop = true end; } -- Signal Stop button pressed return iup.CLOSE -- Often caused main GUI to close !!!
dlgGauge = iup.dialog { Title=strTitle.." Progress "; Font=strFont; FgColor=strBody; Background=strBack; DialogFrame="YES"; -- Remove Windows minimize/maximize menu
iup.vbox{ Alignment="ACENTER"; Gap="10"; Margin="10x10";
lblText;
barGauge;
lblDelta;
btnStop;
};
move_cb = function(self,x,y) tblBars.X = x tblBars.Y = y end;
close_cb = btnStop.action; -- Windows Close button = Stop button
}
if type(tblBars.GUI) == "table"
and type(tblBars.GUI.ShowDialogue) == "function" then
dlgGauge.move_cb = nil -- Use GUI library to show & move window
tblBars.GUI.ShowDialogue("Bars",dlgGauge,btnStop,"showxy")
else
dlgGauge:showxy(intPosX,intPosY) -- Show the Progress Bar window
end
doReset() -- Reset the Progress Bar display
end
end -- function Start
function fh.Message(strText) -- Show the Progress Bar message
if dlgGauge then lblText.Title = strText end
end -- function Message
function fh.Step(intStep) -- Step the Progress Bar forward
if dlgGauge then
intVal = intVal + ( intStep or 1 ) -- Default step is 1
local intNew = math.ceil( intVal / intMax * 100 * intScale ) / intScale
if intPercent ~= intNew then -- Update progress once per percent or per second, whichever is smaller
intPercent = math.max( 0.1, intNew ) -- Ensure percentage is greater than zero
if intVal > intMax then intVal = intMax intPercent = 100 end -- Ensure values do not exceed maximum
intNew = os.difftime(os.time(),intStart)
if intDelta < intNew then -- Update clock of elapsed time
intDelta = intNew
intScale = math.ceil( intDelta / intPercent ) -- Scale of seconds per percentage step
local intHour = math.floor( intDelta / 3600 )
local intMins = math.floor( intDelta / 60 - intHour * 60 )
local intSecs = intDelta - intMins * 60 - intHour * 3600
strClock = string.format("%02d : %02d : %02d",intHour,intMins,intSecs)
end
doUpdate() -- Update the Progress Bar display
end
iup.LoopStep()
end
end -- function Step
function fh.Focus() -- Bring the Progress Bar window to front
if dlgGauge then doFocus() end
end -- function Focus
function fh.Reset() -- Reset the Progress Bar display
if dlgGauge then doReset() end
end -- function Reset
function fh.Stop() -- Check if Stop button pressed
iup.LoopStep()
return isBarStop
end -- function Stop
function fh.Close() -- Close the Progress Bar window
isBarStop = false
if dlgGauge then dlgGauge:destroy() dlgGauge = nil end
end -- function Close
function fh.Setup(tblSetup) -- Setup optional table of external attributes
if tblSetup then
tblBars = tblSetup
strBack = tblBars.Back or strBack -- Background colour
strBody = tblBars.Body or strBody -- Body text colour
strFont = tblBars.Font or strFont -- Font dialogue
strStop = tblBars.Stop or strStop -- Stop button colour
intPosX = tblBars.X or intPosX -- Window position
intPosY = tblBars.Y or intPosY
end
end -- function Setup
return fh
end -- local function progbar_v3
local progbar = progbar_v3() -- To access FH progress bars module
local dicFid = {[0]=true;} -- Dictionary of Families by Rec Id
local dicRid = {[0]=true;} -- Dictionary of Relatives by Rec Id
local arrRel = {} -- Result Set of Relatives and Rec Id
local arrRid = {}
local isAsso, isArel, isWitn, isWrel, fltGen -- GetParam() returned values
function RelationCodes(ptrInd,ptrRel) -- Generations up/down for direct blood relatives
for intRel = 1, 9 do
local strCodes = fhCallBuiltInFunction("Relationship",ptrInd,ptrRel,"CODE",intRel)
if #strCodes < 9 then return -999, -999 end -- No relationship at all
local strUp, strDown, strHalf, strStart, strEnd = strCodes:match("^Gens. Up=(.-), Gens. Down=(.-), Half=(.-), Spouse Start=(.-), Spouse End=(.-)$")
if strStart == "0" and strEnd == "0" then -- Exclude indirect reationships via spouses
return tonumber(strUp) or -999, tonumber(strDown) or -999
end
end
return -999, -999 -- No relationship at all
end -- function RelationCodes
function AddRelation(ptrInd,arrRec) -- Add person to List and Result Set
local intRid = fhGetRecordId(ptrInd)
if not dicRid[intRid] then -- Only add if not already listed
dicRid[intRid] = true
table.insert(arrRel,ptrInd:Clone()) -- Update the Result Set
table.insert(arrRid,intRid)
local isInclude = true -- Signal included as unrelated to any Spouse
for intRec, dicRec in ipairs (arrRec or {}) do
for intSpou, ptrSpou in ipairs (dicRec.Spou or {}) do
local intSpouUp, intSpouDown = RelationCodes(ptrInd,ptrSpou)
if intSpouDown > intSpouUp or intSpouUp + intSpouDown == 0 then
isInclude = false -- Signal excluded as a blood ancestor of a Spouse
local intRecUp, intRecDown = RelationCodes(ptrInd,dicRec.Root)
if intRecUp + intRecDown >= 0 and intRecUp / ( intRecUp + intSpouDown ) < fltGen then
return true -- Signal included as a blood relative of a Root closer to common ancestor than to Spouse
end
end
end
end
progbar.Step(1)
if progbar.Stop() then return false end -- Break out of inner loop
return isInclude -- Signal included or excluded as per above
end
return false -- Signal excluded as already listed
end -- function AddRelation
local arrFam = { "~.FAMS"; "~.FAMC"; }
local arrTag = { "~.HUSB"; "~.WIFE"; "~.CHIL"; }
function FindFamily(ptrInd,arrRec) -- Find all family relatives recursively
local ptrTag = fhNewItemPtr()
if isAsso then
ptrTag:MoveTo(ptrInd,"~.ASSO") -- Search for Associated Person instances
while ptrTag:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrTag)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) and isArel then FindFamily(ptrRel,arrRec) end
end
ptrTag:MoveNext("SAME_TAG")
end
end
if isWitn then
local ptrWit = fhNewItemPtr()
ptrTag:MoveToFirstChildItem(ptrInd) -- Search all V6 Fact Witness instances
while ptrTag:IsNotNull() do
if fhIsFact(ptrTag) then
ptrWit:MoveTo(ptrTag,"~._SHAR")
while ptrWit:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrWit)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) and isWrel then FindFamily(ptrRel,arrRec) end
end
ptrWit:MoveNext("SAME_TAG")
end
end
ptrTag:MoveNext("ANY")
end
end
local ptrFam = fhNewItemPtr()
for intFam, strFam in ipairs (arrFam) do -- Search all FAMS and FAMC instances
ptrFam:MoveTo(ptrInd,strFam)
while ptrFam:IsNotNull() do
local ptrRec = fhGetValueAsLink(ptrFam)
local intFid = fhGetRecordId(ptrRec) -- Only search each Family once
if not dicFid[intFid] then
dicFid[intFid] = true
for intTag, strTag in ipairs (arrTag) do -- Search all HUSB, WIFE, CHIL instances
ptrTag:MoveTo(ptrRec,strTag)
while ptrTag:IsNotNull() do
local ptrRel = fhGetValueAsLink(ptrTag)
if not ptrRel:IsSame(ptrInd) then
if AddRelation(ptrRel,arrRec) then FindFamily(ptrRel,arrRec) end
end
ptrTag:MoveNext("SAME_TAG")
end
end
dicFid[intFid] = true
end
ptrFam:MoveNext("SAME_TAG")
end
end
end -- function FindFamily
function GetParam()
local tblForm = {} -- Format strings for iup.GetParam
local tblData = {} -- Parameter values for iup.GetParam
local function setTables(strForm,strData) -- Set those lookup table to values below
table.insert(tblForm,strForm)
table.insert(tblData,strData)
end -- local function setTables
setTables( "All relatives of selected Individuals will be included,\r"..
"except for their partner/spouse ancestral branches. \r"..
"e.g. \r"..
"Select a son and siblings, and his father and siblings,\r"..
"to obtain father's ancestral tree and his descendants. \r"..
"This is often most easily achieved using a Diagram. %t" )
setTables( "%t" )
setTables( " Include Associated Persons ? %b{Include any Associated Persons of anyone included?}" , 1 )
setTables( " Include all their Relatives ? %b{Include all relatives of those Associated Persons?}" , 1 )
if fhGetAppVersion() > 5 then
setTables( "%t" )
setTables( " Include any Fact Witnesses ? %b{Include any Fact Witnesses of anyone included?}" , 1 )
setTables( " Include all their Relatives ? %b{Include all relatives of those Fact Witnesses?}" , 1 )
end
setTables( "%t" )
setTables( "A chosen person and partner/spouse may share ancestors. \r"..
"Shared relatives nearest such ancestors can be included.\r"..
"\r Portion of shared blood relatives to include ? \r\r\r %r[0.0,1.0,0.1]{Blood relatives of chosen person should be included.\rBlood relatives of partner/spouse should be excluded.\rSo this portion resolves that conflicting requirement.}" , 0.5 )
tblData = { iup.GetParam(strPluginName,nil,table.concat(tblForm,"\n").."\n",unpack(tblData)) }
if not tblData[1] then return false end
isAsso = ( tblData[2] == 1 )
isArel = ( tblData[3] == 1 )
isWitn = ( tblData[4] == 1 )
isWrel = ( tblData[5] == 1 )
fltGen = tblData[6]
return true
end -- function GetParam()
function ShowHelp()
local tblHelp = {}
table.insert(tblHelp,"When Plugin closes it lists all Individual records requested")
table.insert(tblHelp,"Use Ctrl+A on keyboard to select entire Result Set, then ...")
table.insert(tblHelp,"'Query Menu > Add Selected Cell Records to a Named List'")
table.insert(tblHelp,"'Export > GEDCOM File' and 'Select' from 'Named Lists' tab")
table.insert(tblHelp,"Select the Named List from above and click '>> Add All'")
fhMessageBox(table.concat(tblHelp,"\n\n"))
end -- function ShowHelp
function Main()
if not GetParam() then return end
local arrRec = fhGetCurrentRecordSel("INDI") -- Get preselected root Individuals
if #arrRec == 0 then
arrRec = fhPromptUserForRecordSel("INDI") -- Prompt for the root Individuals
if #arrRec == 0 then return end
end
for intRoot, ptrRoot in ipairs (arrRec) do
local arrSpou = {} -- List of Spouses
for intSpou = 1, 99 do -- Add each Spouse to exclude their ancestors
local ptrSpou = fhGetItemPtr(ptrRoot,"~.~SPOU["..intSpou.."]>")
if ptrSpou:IsNull() then break end
table.insert(arrSpou,ptrSpou)
end
arrRec[intRoot] = { Root=ptrRoot; Spou=arrSpou; } -- List of root Individuals each with a list of their Spouses
end
local intIndi = 0
local ptrIndi = fhNewItemPtr()
ptrIndi:MoveToFirstRecord("INDI") -- Get count of individuals for progress bar
while ptrIndi:IsNotNull() do
intIndi = intIndi + 1
ptrIndi:MoveNext("SAME_TAG")
end
progbar.Setup()
if intIndi > 999 then progbar.Start("Finding Relatives",intIndi) end
local arrText = {} -- Textual list of root Individuals
for intRec, dicRec in ipairs (arrRec) do
local ptrRoot = dicRec.Root
table.insert(arrText,fhGetDisplayText(ptrRoot))
if AddRelation(ptrRoot) then FindFamily(ptrRoot,arrRec) end -- Find all family relations
end
fhOutputResultSetTitles(table.concat(arrText,", ")..strPluginName)
fhOutputResultSetColumn("Relative", "item", arrRel, #arrRel, 200, "align_left" )
fhOutputResultSetColumn("Rec Id", "integer", arrRid, #arrRel, 40, "align_mid", 1 )
progbar.Close()
ShowHelp()
end -- function Main
Main()
Source:All-Pool-Relatives-Except-Partner-Ancestors-1.fh_lua