--[[ @Title: Rearrange Address and Place Parts @Type: Standard @Author: Mike Tate @Contributors: @Version: 1.8 @LastUpdated: 29 Aug 2023 @Licence: This plugin is copyright (c) 2023 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: Switch any Address and Place part columns around. @V1.8: Library V3.3; Inhibit active controls for various buttons; Cope with large projects in doDisplayFilter(); Inhibit Filter List tab selection for large projects; Restore Defaults does NOT change Sort By mode; Cope with Place names that only differ in case; @V1.7: ArrTags copes with Rich Text "_LINK_P" links in all records; Fix right justify numbers; Add collectgarbage(...) to loops, etc; Temporary fix for MoveNextSpecial bug; Fix large project memory leak; @V1.6: FH V7 Lua 3.5 IUP 3.28; TBD: Select All/None default option; Include Address fields without Place field; Postponed: Display & sort Filter by column parts and retain current row in focus; @V1.5: Fix Help & Advice page links; colour non-default Output Column Part; sort Filter by Address; @V1.4: Preset Filter based on selected Place records; @V1.3: Fix problem with deleting Address/Place when same as current ptrItem or have child fields. @V1.2: Fix problem with function strFormatFilter() width of Address. @V1.1: Erase duplicated parts toggles, toggle order = perform order, slimmed Filter list, cater for unusual re-arrangements, etc. ]] if fhGetAppVersion() > 5 then fhSetStringEncoding("UTF-8") end --[[ @Title: aa Library Functions Preamble @Author: Mike Tate @Version: 3.3 @LastUpdated: 03 May 2022 @Description: All the library functions prototype closures for Plugins. ]] --[[ @Module: +fh+stringx_v3 @Author: Mike Tate @Version: 3.0 @LastUpdated: 19 Sep 2020 @Description: Extended string functions to supplement LUA string library. @V3.0: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility; Added inert(strTxt) function; @V2.5: Support FH V6 Encoding = UTF-8; @V2.4: Tolerant of integer & nil parameters just link match & gsub; @V1.0: Initial version. ]] local function stringx_v3() local fh = {} -- Local environment table -- Supply current file encoding format -- function fh.encoding() if fhGetAppVersion() > 5 then return fhGetStringEncoding() end return "ANSI" end -- function encoding -- Split a string using "," or chosen separator -- function fh.split(strTxt,strSep) local tblFields = {} local strPattern = string.format("([^%s]+)", strSep or ",") strTxt = tostring(strTxt or "") strTxt:gsub(strPattern, function(strField) tblFields[#tblFields+1] = strField end) return tblFields end -- function split -- Split a string into numbers using " " or "," or "x" separators -- Any non-number remains as a string function fh.splitnumbers(strTxt) local tblNum = {} strTxt = tostring(strTxt or "") strTxt:gsub("([^ ,x]+)", function(strNum) tblNum[#tblNum+1] = tonumber(strNum) or strNum end) return tblNum end -- function splitnumbers local strMagic = "([%^%$%(%)%%%.%[%]%*%+%-%?])" -- UTF-8 replacement for "(%W)" -- Hide magic pattern symbols ^ $ ( ) % . [ ] * + - ? function fh.plain(strTxt) -- Prefix every magic pattern character with a % escape character, -- where %% is the % escape, and %1 is the original character capture. strTxt = tostring(strTxt or ""):gsub(strMagic,"%%%1") return strTxt end -- function plain -- matches is plain text version of string.match() function fh.matches(strTxt,strFind,intInit) strFind = tostring(strFind or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols return tostring(strTxt or ""):match(strFind,tonumber(intInit)) end -- function matches -- replace is plain text version of string.gsub() function fh.replace(strTxt,strOld,strNew,intNum) strOld = tostring(strOld or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols return tostring(strTxt or ""):gsub(strOld,function() return strNew end,tonumber(intNum)) -- Hide % capture symbols end -- function replace -- Hide % escape/capture symbols in replacement so they are inert function fh.inert(strTxt) strTxt = tostring(strTxt or ""):gsub("%%","%%%%") -- Hide all % symbols return strTxt end -- function inert -- convert is pattern without captures version of string.gsub() function fh.convert(strTxt,strOld,strNew,intNum) return tostring(strTxt or ""):gsub(tostring(strOld or ""),function() return strNew end,tonumber(intNum)) -- Hide % capture symbols end -- function convert local dicUpper = { } local dicLower = { } local dicCaseX = { } -- ASCII unaccented letter translations for Upper, Lower, and Case Insensitive for intUpper = string.byte("A"), string.byte("Z") do local strUpper = string.char(intUpper) local strLower = string.char(intUpper - string.byte("A") + string.byte("a")) dicUpper[strLower] = strUpper dicLower[strUpper] = strLower local strCaseX = "["..strUpper..strLower.."]" dicCaseX[strLower] = strCaseX dicCaseX[strUpper] = strCaseX end -- Supply character length of ANSI text -- function fh.length(strTxt) return string.len(strTxt or "") end -- function length -- Supply character substring of ANSI text -- function fh.substring(strTxt,i,j) return string.sub(strTxt or "",i,j) end -- function substring -- Translate upper/lower case ANSI letters to pattern that matches both -- function fh.caseless(strTxt) strTxt = tostring(strTxt or ""):gsub("[A-Za-z]",dicCaseX) return strTxt end -- function caseless if fh.encoding() == "UTF-8" then -- Supply character length of UTF-8 text -- function fh.length(strTxt) isFlag = fhIsConversionLossFlagSet() strTxt = fhConvertUTF8toANSI(strTxt or "") fhSetConversionLossFlag(isFlag) return string.len(strTxt) end -- function length local strUTF8 = "([%z\1-\127\194-\244][\128-\191]*)" -- Cater for Lua 5.1 %z or Lua 5.3 \0 if fhGetAppVersion() > 6 then strUTF8 = "([\0-\127\194-\244][\128-\191]*)" end -- Supply character substring of UTF-8 text -- function fh.substring(strTxt,i,j) local strSub = "" j = j or -1 if j < 0 then j = j + length(strTxt) + 1 end if i < 0 then i = i + length(strTxt) + 1 end for strChr in string.gmatch(strTxt or "",strUTF8) do if j <= 0 then break end j = j - 1 i = i - 1 if i <= 0 then strSub = strSub..strChr end end return strSub end -- function substring -- Translate lower case to upper case UTF-8 letters -- function fh.upper(strTxt) strTxt = tostring(strTxt or ""):gsub("([a-z\194-\244][\128-\191]*)",dicUpper) return strTxt end -- function upper -- Translate upper case to lower case UTF-8 letters -- function fh.lower(strTxt) strTxt = tostring(strTxt or ""):gsub("([A-Z\194-\244][\128-\191]*)",dicLower) return strTxt end -- function lower -- Translate upper/lower case UTF-8 letters to pattern that matches both -- function fh.caseless(strTxt) strTxt = tostring(strTxt or ""):gsub("([A-Za-z\194-\244][\128-\191]*)",dicCaseX) return strTxt end -- function caseless -- Following tables use ASCII numeric coding to be immune from ANSI/UTF-8 encoding -- local arrPairs = -- Upper & Lower case groups of UTF-8 letters with same prefix -- {-- { Prefix; Beg ; End ; Inc; Offset Upper > Lower }; -- These include all ANSI letters and many more { "\195"; 0x80; 0x96; 1 ; 32 }; -- 195=0xC3 À U+00C0 to Ö U+00D6 and à U+00E0 to ö U+00F6 { "\195"; 0x98; 0x9E; 1 ; 32 }; -- 195=0xC3 Ø U+00D8 to Þ U+00DE and ø U+00F8 to þ U+00FE { "\196"; 0x80; 0xB6; 2 ; 1 }; -- 196=0xC4 A U+0100 to k U+0137 in pairs { "\196"; 0xB9; 0xBD; 2 ; 1 }; -- 196=0xC4 L U+0139 to l U+013E in pairs { "\197"; 0x81; 0x87; 2 ; 1 }; -- 197=0xC5 L U+0141 to n U+0148 in pairs { "\197"; 0x8A; 0xB6; 2 ; 1 }; -- 197=0xC5 ? U+014A to y U+0177 in pairs { "\197"; 0xB9; 0xBD; 2 ; 1 }; -- 197=0xC5 Z U+0179 to ž U+017E in pairs { "\198"; 0x82; 0x84; 2 ; 1 }; -- 198=0xC6 ? U+0182 to ? U+0185 in pairs -- Add more Unicode groups here as usage increases -- } local dicPairs = -- Upper v Lower case UTF-8 letters that don't fit groups above -- { [string.char(0xC4,0xBF)] = string.char(0xC5,0x80); -- ? U+013F and ? U+0140 [string.char(0xC5,0xB8)] = string.char(0xC3,0xBF); -- Ÿ U+0178 and ÿ U+00FF } local intBeg1 = string.byte(string.sub("À",1)) local intBeg2 = string.byte(string.sub("À",2)) local intEnd1 = string.byte(string.sub("Z",1)) local intEnd2 = string.byte(string.sub("Z",2)) -- print(string.format("%#x %#x %#x %#x",intBeg1,intBeg2,intEnd1,intEnd2)) -- Useful to work out numeric coding -- Populate the UTF-8 letter translation dictionaries -- for intGroup, tblGroup in ipairs ( arrPairs ) do -- UTF-8 accented letter groups local strPrefix = tblGroup[1] for intUpper = tblGroup[2], tblGroup[3], tblGroup[4] do local strUpper = string.char(intUpper) local strLower = string.char(intUpper + tblGroup[5]) local strCaseX = strPrefix.."["..strUpper..strLower.."]" strUpper = strPrefix..strUpper strLower = strPrefix..strLower dicUpper[strLower] = strUpper dicLower[strUpper] = strLower dicCaseX[strLower] = strCaseX dicCaseX[strUpper] = strCaseX end end for strUpper, strLower in pairs ( dicPairs ) do -- UTF-8 accented letters where upper & lower have different prefix dicUpper[strLower] = strUpper dicLower[strUpper] = strLower local strCaseX = "" for intByte = 1, #strUpper do -- Matches more than just the two letters, but can't do any better strCaseX = strCaseX.."["..strUpper:sub(intByte,intByte)..strLower:sub(intByte,intByte).."]" end dicCaseX[strLower] = strCaseX dicCaseX[strUpper] = strCaseX end end -- overload fh functions into string table for strIndex, anyValue in pairs(fh) do if type(anyValue) == "function" then string[strIndex] = anyValue end end return fh end -- local function stringx_v3 local stringx = stringx_v3() -- To access FH string extension module --[[ @Module: +fh+iterate_v3 @Author: Mike Tate @Version: 3.0 @LastUpdated: 25 Aug 2020 @Description: An iterater functions module to supplement LUA functions. @V3.0: Function Prototype Closure version. @V1.2: RecordTypes() includes HEAD tag. @V1.1: ? @V1.0: Initial version. ]] local function iterate_v3() local fh = {} -- Local environment table -- Iterator for all records of one chosen type -- function fh.Records(strType) local ptrAll = fhNewItemPtr() -- Pointer to all records in turn local ptrRec = fhNewItemPtr() -- Pointer to record returned to user ptrAll:MoveToFirstRecord(strType) return function () ptrRec:MoveTo(ptrAll) ptrAll:MoveNext() if ptrRec:IsNotNull() then return ptrRec end end end -- function Records -- Iterator for all the record types -- function fh.RecordTypes() local intNext = -1 -- Next record type number local intLast = fhGetRecordTypeCount() -- Last record type number return function() intNext = intNext + 1 if intNext == 0 then -- Includes HEAD tag -- V1.2 return "HEAD" elseif intNext <= intLast then return fhGetRecordTypeTag(intNext) -- Return record type tag end end end -- function RecordTypes -- Iterator for all items in all records of chosen types -- function fh.Items(...) local arg = {...} local intType = 1 -- Integer record type number local tblType = {} -- Table of record type tags local ptrNext = fhNewItemPtr() -- Pointer to next item in turn local ptrItem = fhNewItemPtr() -- Pointer to item returned to user if #arg == 0 then for intType = 1, fhGetRecordTypeCount() do -- No parameters so use all record types tblType[intType] = fhGetRecordTypeTag(intType) end else tblType = arg -- Got parameters so use them instead end -- print(tblType[intType],intType) ptrNext:MoveToFirstRecord(tblType[intType]) -- Get first record of first type return function() repeat while ptrNext:IsNotNull() do -- Loop through all items ptrItem:MoveTo(ptrNext) ptrNext:MoveNextSpecial() if ptrItem:IsNotNull() then return ptrItem end end intType = intType + 1 -- Loop through each record type if intType <= #tblType then ptrNext:MoveToFirstRecord(tblType[intType]) end until intType > #tblType end end -- function Items -- Iterator for all facts of an individual -- function fh.Facts(ptrIndi) local ptrItem = fhNewItemPtr() -- Pointer to each item at level 1 local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user ptrItem:MoveToFirstChildItem(ptrIndi) return function () while ptrItem:IsNotNull() do ptrFact:MoveTo(ptrItem) ptrItem:MoveNext() if fhIsFact(ptrFact) then return ptrFact end end end end -- function Facts return fh end -- local function iterate_v3 local iterate = iterate_v3() -- To access FH iterate items module --[[ @Module: +fh+general_v3 @Author: Mike Tate @Version: 3.2 @LastUpdated: 10 Mar 2022 @Description: A general functions module to supplement LUA functions, where filenames use UTF-8 but for a few exceptions. @V3.2: Added function DetectOldModules(); Updated functions RenameFile(), RenameFolder() & GetFolderContents(); @V3.1: Functions derived from FH V7 fhFileUtils library using File System Objects, plus additional features; @V3.0: Function Prototype Closure version; GetDayNumber() error message reasons; @V1.5: Revised SplitFilename(strFilename) for missing extension. @V1.4: Revised EstimatedBirthDates() & EstimatedDeathDates() to fix null Dates. @V1.3: Add GetDayNumber(), EstimatedBirthDates(), EstimatedDeathDates(). @V1.2: SplitFilename() updated for directory only paths, and MakeFolder() added. @V1.1: pl.path experiment revoked. New DirTree with omit branch option. Avoid using stringx_v2. @V1.0: Initial version. ]] local function general_v3() local fh = {} -- Local environment table require("luacom") -- To create File System Object fh.FSO = luacom.CreateObject("Scripting.FileSystemObject") -- Report error message -- local function doError(strMessage,errFunction) -- strMessage ~ error message text -- errFunction ~ optional error reporting function if type(errFunction) == "function" then errFunction(strMessage) else error(strMessage) end end -- local function doError -- Convert filename to ANSI alternative and indicate success -- function fh.FileNameToANSI(strFileName,strAnsiName) -- strFileName ~ full file path -- strAnsiFile ~ ANSI file name & type -- return values ~ ANSI file path, true if original path was ANSI compatible if stringx.encoding() == "ANSI" then return strFileName, true end local isFlag = fhIsConversionLossFlagSet() fhSetConversionLossFlag(false) local strAnsi = fhConvertUTF8toANSI(strFileName) local wasAnsi = true if fhIsConversionLossFlagSet() then strAnsiName = strAnsiName or "ANSI.ANSI" strAnsi = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\"..strAnsiName wasAnsi = false end fhSetConversionLossFlag(isFlag) return strAnsi, wasAnsi end -- local function FileNameToANSI -- Get parent folder -- function fh.GetParentFolder(strFileName) -- strFileName ~ full file path -- return value ~ parent folder path local strParent = fh.FSO:GetParentFolderName(strFileName) --! Faulty in FH v6 with Unicode chars in path if fhGetAppVersion() == 6 then local _, wasAnsi = fh.FileNameToANSI(strFileName) if not wasAnsi then strParent = strFileName:match("^(.+)[\\/][^\\/]+[\\/]?$") end end return strParent end -- function GetParentFolder -- Check if file exists -- function fh.FlgFileExists(strFileName) -- strFileName ~ full file path -- return value ~ true if it exists return fh.FSO:FileExists(strFileName) end -- function FlgFileExists -- Check if folder exists -- function fh.FlgFolderExists(strFolderName) -- strFolderName ~ full file path -- return value ~ true if it exists return fh.FSO:FolderExists(strFolderName) end -- function FlgFolderExists -- Delete a file if it exists -- function fh.DeleteFile(strFileName,errFunction) -- strFileName ~ full file path -- errFunction ~ optional error reporting function -- return value ~ true if file does not exist or is deleted else false if fh.FSO:FileExists(strFileName) then fh.FSO:DeleteFile(strFileName,true) if fh.FSO:FileExists(strFileName) then doError("File Not Deleted:\n"..strFileName.."\n",errFunction) return false end end return true end -- function DeleteFile -- Delete a folder if it exists including contents -- function fh.DeleteFolder(strFolderName,errFunction) -- strFolderName ~ full folder path -- errFunction ~ optional error reporting function -- return value ~ true if folder does not exist or is deleted else false if fh.FSO:FolderExists(strFolderName) then fh.FSO:DeleteFolder(strFolderName,true) if fh.FSO:FolderExists(strFolderName) then doError("Folder Not Deleted:\n"..strFolderName.."\n",errFunction) return false end end return true end -- function DeleteFolder -- Rename a file if it exists -- function fh.RenameFile(strFileName,strNewName) -- strFileName ~ full file path -- strNewName ~ new file name & type -- return value ~ true if file exists but new name does not and rename is OK else false local strNewFile = fh.GetParentFolder(strFileName).."\\"..strNewName if fh.FSO:FileExists(strFileName) and not fh.FSO:FileExists(strNewFile) then local fileObject = fh.FSO:GetFile(strFileName) fileObject.Name = strNewName if fh.FSO:FileExists(strNewFile) then return true end end return false end -- function RenameFile -- Rename a folder if it exists -- function fh.RenameFolder(strFolderName,strNewName) -- strFolderName ~ full folder path -- strNewName ~ new folder name -- return value ~ true if folder exists but new name does not and rename is OK else false local strNewFolder = fh.GetParentFolder(strFolderName).."\\"..strNewName if fh.FSO:FolderExists(strFolderName) and not fh.FSO:FolderExists(strNewFolder) then local folderObject = fh.FSO:GetFolder(strFolderName) folderObject.Name = strNewName if fh.FSO:FolderExists(strNewFolder) then return true end end return false end -- function RenameFolder -- Copy a file if it exists and destination is not a folder -- function fh.CopyFile(strFileName,strDestination) -- strFileName ~ full source file path -- strDestination ~ full target file path -- return value ~ true if file exists and is copied else false if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then fh.FSO:CopyFile(strFileName,strDestination) if fh.FSO:FileExists(strDestination) then return true end end return false end -- function CopyFile -- Copy a folder if it exists and destination is not a file -- function fh.CopyFolder(strFolderName,strDestination) -- strFolderName ~ full source folder path -- strDestination ~ full target folder path -- return value ~ true if folder exists and is copied else false if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then fh.FSO:CopyFolder(strFolderName,strDestination) if fh.FSO:FolderExists(strDestination) then return true end end return false end -- function CopyFolder -- Move a file if it exists and destination is not a folder -- function fh.MoveFile(strFileName,strDestination) -- strFileName ~ full source file path -- strDestination ~ full target file path -- return value ~ true if file exists and is moved else false if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then if fh.DeleteFile(strDestination) then fh.FSO:MoveFile(strFileName,strDestination) if fh.FSO:FileExists(strDestination) then return true end end end return false end -- function MoveFile -- Move a folder if it exists and destination is not a file -- function fh.MoveFolder(strFolderName,strDestination) -- strFolderName ~ full source folder path -- strDestination ~ full target folder path -- return value ~ true if folder exists and is moved else false if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then if fh.DeleteFolder(strDestination) then fh.FSO:MoveFolder(strFolderName,strDestination) if fh.FSO:FolderExists(strDestination) then return true end end end return false end -- function MoveFolder -- Make subfolder recursively if does not exist -- function fh.MakeFolder(strFolderName,errFunction) -- strFolderName ~ full source folder path -- errFunction ~ optional error reporting function -- return value ~ true if folder exists or created else false if not fh.FSO:FolderExists(strFolderName) then if not fh.MakeFolder(fh.GetParentFolder(strFolderName),errFunction) then return false end fh.FSO:CreateFolder(strFolderName) if not fh.FSO:FolderExists(strFolderName) then doError("Cannot Make Folder:\n"..strFolderName.."\n",errFunction) return false end end return true end -- function MakeFolder -- Check if folder writable -- function fh.FlgFolderWrite(strFolderName) -- strFolderName ~ full source folder path -- return value ~ true if folder writable else false if fh.FlgFolderExists(strFolderName) then if fh.MakeFolder(strFolderName.."\\vwxyz") then fh.FSO:DeleteFolder(strFolderName.."\\vwxyz",true) return true end end return false end -- function FlgFolderWrite -- Open File with ANSI path and return Handle -- function fh.OpenFile(strFileName,strMode) -- strFileName ~ full file path -- strMode ~ "r", "w", "a" optionally suffixed with "+" &/or "b" -- return value ~ file handle local fileHandle, strError = io.open(strFileName,strMode) if fileHandle == nil then error("\n Unable to open file in \""..strMode.."\" mode. \n "..strFileName.." \n "..strError.." \n") end return fileHandle end -- function OpenFile -- Save string to file -- function fh.SaveStringToFile(strContents,strFileName,strFormat) -- strContents ~ text string -- strFileName ~ full file path -- strFormat ~ optional "UTF-8" or "UTF-16LE" -- return value ~ true if successful else false strFormat = strFormat or "UTF-8" if fhGetAppVersion() > 6 then return fhSaveTextFile(strFileName,strContents,strFormat) end local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName) local fileHandle = fh.OpenFile(strAnsi,"w") fileHandle:write(strContents) assert(fileHandle:close()) if not wasAnsi then fh.MoveFile(strAnsi,strFileName) end return true end -- function SaveStringToFile -- Load string from file -- function fh.StrLoadFromFile(strFileName,strFormat) -- strFileName ~ full file path -- strFormat ~ optional "UTF-8" or "UTF-16LE" -- return value ~ file contents strFormat = strFormat or "UTF-8" if fhGetAppVersion() > 6 then return fhLoadTextFile(strFileName,strFormat) end local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName) if not wasAnsi then fh.CopyFile(strFileName,strAnsi) end local fileHandle = fh.OpenFile(strAnsi,"r") local strContents = fileHandle:read("*all") assert(fileHandle:close()) return strContents end -- function StrLoadFromFile -- Returns the Path, Filename, and Extension as 3 values -- function fh.SplitFilename(strFileName) -- strFileName ~ full file path -- return values ~ path, name.type, type if fh.FSO:FolderExists(strFileName) then local strPath = strFileName:gsub("[\\/]$","") return strPath.."\\","","" end strFileName = strFileName.."." return strFileName:match("^(.-)([^\\/]-%.([^\\/%.]-))%.?$") end -- function SplitFilename -- Convert dd/mm/yyyy hh:mm:ss format to integer seconds -- (DateTime format is used in attributes returned by GetFolderContents and DirTree below) function fh.IntTime(strDateTime) -- strDateTime ~ date time string -- return value ~ integer seconds since 01/01/1970 00:00:00 local strDay,strMonth,strYear,strHour,strMin,strSec = strDateTime:match("^(%d%d)/(%d%d)/(%d+) (%d%d):(%d%d):(%d%d)") if tonumber(strYear) < 1970 then return 0 end local isDST = false if tonumber(strMonth) > 4 and tonumber(strMonth) < 11 then isDST = true end -- Approximation is sometimes wrong local intTime = os.time( { year=strYear; month=strMonth; day=strDay; hour=strHour; min=strMin; sec=strSec; isdst=isDST; } ) local tblDat = os.date("*t",intTime) if tblDat.isdst then intTime = intTime + 3600 isDST = true end return intTime end -- function IntTime -- Return table of attributes -- local function attributes(tblAttr,strMode) -- tblAttr ~ file attributes table -- strMode ~ "file" or "directory" -- return value ~ attributes table like LFS except datetimes local tblAttr = { name=tblAttr.name; created=tblAttr.DateCreated; type=tblAttr.Type; path=tblAttr.path; shortname=tblAttr.ShortName; shortpath=tblAttr.ShortPath; size=tblAttr.Size; modified=tblAttr.DateLastModified; attributes=tblAttr.Attributes; } tblAttr.mode = strMode return tblAttr end -- local function attributes -- Return attributes table of all files and folders in a specified folder -- function fh.GetFolderContents(strFolder,doRecurse) -- strFolder ~ full folder path -- doRecurse ~ true for recursion -- return value ~ attributes table local arrList = {} if fh.FSO:FolderExists(strFolder) then local function getFileList(strFolder) local tblList = fh.FSO:GetFolder(strFolder) local tblEnum = luacom.GetEnumerator(tblList.SubFolders) local tblAttr = tblEnum:Next() while tblAttr do table.insert(arrList,attributes(tblAttr,"directory")) if doRecurse then getFileList(tblAttr.path) end tblAttr = tblEnum:Next() end local tblEnum = luacom.GetEnumerator(tblList.Files) local tblAttr = tblEnum:Next() while tblAttr do table.insert(arrList,attributes(tblAttr,"file")) tblAttr = tblEnum:Next() end end getFileList(strFolder) end return arrList end -- function GetFolderContents -- Return a Directory Tree entry & attributes on each iteration -- function fh.DirTree(strDir,...) -- strDir ~ full folder path -- ... ~ list of folders to omit -- return value ~ full path, attributes table local arg = {...} assert( fh.FSO:FolderExists(strDir), "directory parameter is missing or empty" ) local function yieldtree(strDir) local tblList = fh.FSO:GetFolder(strDir) local tblEnum = luacom.GetEnumerator(tblList.SubFolders) local tblAttr = tblEnum:Next() while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.SubFolders) do -- pairs not working in FH v6 so use tblEnum code coroutine.yield(tblAttr.path,attributes(tblAttr,"directory")) local isOK = true for _,strOmit in ipairs (arg) do if tblAttr.path:match(strOmit) then -- Omit tree branch isOK = false break end end if isOK then yieldtree(tblAttr.path) end tblAttr = tblEnum:Next() end local tblEnum = luacom.GetEnumerator(tblList.Files) local tblAttr = tblEnum:Next() while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.Files) do -- pairs not working in FH v6 so use tblEnum code coroutine.yield(tblAttr.path,attributes(tblAttr,"file")) tblAttr = tblEnum:Next() end end return coroutine.wrap(function() yieldtree(strDir) end) end -- function DirTree -- Detect FH V5/6 old library modules and advise removal -- function fh.DetectOldModules() if fhGetAppVersion() > 6 then local strPath = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugins\\" local arrFile = { "compat53.lua"; "ltn12.lua"; "luasql\\sqlite3.dll"; "md5.lua"; "pl\\init.lua"; "socket.lua"; "utf8.lua"; "zip.dll"; } for _, strFile in ipairs (arrFile) do if fh.FSO:FileExists(strPath..strFile) then fhMessageBox("\n Detected some old FH V6 library modules. \n\nPlease remove them by running the plugin: \n\n 'Delete old FH6 Plugin Module Files' \n","MB_OK","MB_ICONEXCLAMATION") break end end end end -- function DetectOldModules if fhGetAppVersion() > 6 then unpack = table.unpack end -- Invoke FH Shell Execute API -- function fh.DoExecute(strExecutable,...) -- strExecutable ~ full path of executable -- ... ~ parameter list and optional error reporting function -- return value ~ true if successful else false local arg = {...} local errFunction = fhMessageBox if type(arg[#arg]) == 'function' then errFunction = arg[#arg] table.remove(arg) end local isOK, intErrorCode, strErrorText = fhShellExecute(strExecutable,unpack(arg)) if not isOK then errFunction(tostring(strErrorText).." ("..tostring(intErrorCode)..")") end return isOK end -- function DoExecute -- Obtain the Day Number for any Date Point -- -- Fix problems with invalid dates in DayNumber function function fh.GetDayNumber(datDate) -- datDate ~ date point -- return value ~ day number if datDate:IsNull() then return 0 end local intDay = fhCallBuiltInFunction("DayNumber",datDate) -- Only works for Gregorian dates that were not skipped nor BC dates if not intDay then local strError = "because " -- Error message reason -- V3.0 local calendar = datDate:GetCalendar() local oldMonth = datDate:GetMonth() local oldDayNo = datDate:GetDay() local intMonth = math.min( oldMonth, 12 ) -- Limit month to 12, and day to last of each month local intDayNo = math.min( oldDayNo, ({0;31;28;31;30;31;30;31;31;30;31;30;31;})[intMonth+1] ) local intYear = datDate:GetYear() if oldDayNo > intDayNo then strError = strError.."day "..oldDayNo.." too big " end if oldMonth > intMonth then strError = strError.."month "..oldMonth.." too big " end if calendar == "Hebrew" and intYear > 3761 then intYear = intYear - 3761 strError = strError.."Hebrew year > 3761 " elseif calendar ~= "Gregorian" then strError = strError..calendar.." disallowed " end if intYear == 1752 and intMonth == 9 and intDayNo <= 13 then -- Use 2 Sep 1752 for 3 - 13 Sep 1752 dates skipped intDayNo = 2 strError = strError.."3 - 13 Sep 1752 skipped " elseif intYear == 1582 and intMonth == 10 and intDayNo <= 14 then -- Use 4 Oct 1582 for 5 - 14 Oct 1582 dates skipped intDayNo = 4 strError = strError.."5 - 14 Oct 1582 skipped " end local setDate = fhNewDatePt(intYear,intMonth,intDayNo,datDate:GetYearDD()) intDay = fhCallBuiltInFunction("DayNumber",setDate) -- Remove BC and Julian, Hebrew, French calendars if not intDay then intDay = 0 end local oldDate = fhNewDate() oldDate:SetSimpleDate(datDate) -- Report problem to user local newDate = fhNewDate() newDate:SetSimpleDate(setDate) local strIsBC = "" if datDate:GetBC() then strError = strError.." B.C. disallowed " intDay = -intDay strIsBC = "and Day Number negated" end fhMessageBox("\n Get Day Number issue for date \n "..oldDate:GetDisplayText().." \n "..strError.." \n So replaced it with date \n "..newDate:GetDisplayText().." \n "..strIsBC,"MB_OK","MB_ICONEXCLAMATION") end return intDay end -- function GetDayNumber local dtpYearMin = fhNewDatePt(1000) -- Minimum year to use when earliest estimate is null local dtpYearMax = fhNewDatePt(2000) -- Maximum year to use when latest estimate is null function fh.GetYearToday() -- Get the Year for Today -- return value ~ integer year today local intYearToday = fhCallBuiltInFunction("Year",fhCallBuiltInFunction("Today")) dtpYearMax = fhNewDatePt(intYearToday) -- Set maximum year date point return intYearToday end -- function GetYearToday() local function getDeathFacts(ptrIndi) -- Iterate Death, Burial, Cremation facts -- ptrIndi ~ pointer to individual -- return value ~ pointer to fact local arrFact = { "~.DEAT"; "~.BURI"; "~.CREM"; } local intFact = 0 local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user return function () while intFact < #arrFact do intFact = intFact + 1 ptrFact = fhGetItemPtr(ptrIndi,arrFact[intFact]) if ptrFact:IsNotNull() then return ptrFact end end end end -- local function getDeathFacts -- Ensure Estimated Date EARLIEST <= LATEST <= Fact Date -- -- Fix errors in EstimatedBirth/DeathDate function local function estimatedDates(strFunc,ptrIndi,intGens,getFact,intYrs) -- strFunc ~ "EstimatedBirthDate" or "EstimatedDeathDate" -- ptrIndi ~ Individual of interest -- intGens ~ Number of generations (may be nil) -- getFact ~ Iterator function for facts -- intYrs ~ Years to add to After dates -- return values ~ EARLIEST, MID, LATEST dates intGens = intGens or 2 local dtpMin = fhCallBuiltInFunction(strFunc,ptrIndi,"EARLIEST",intGens) local dtpMax = fhCallBuiltInFunction(strFunc,ptrIndi,"LATEST",intGens) local dtpMid = fhNewDatePt() if not ( dtpMin:IsNull() and dtpMax:IsNull() ) then -- Skip if both null if dtpMax:IsNull() then dtpMax = dtpYearMax elseif dtpMin:IsNull() then dtpMin = dtpYearMin end for ptrFact in getFact(ptrIndi) do local datFact = fhGetValueAsDate(fhGetItemPtr(ptrFact,"~.DATE")) if not datFact:IsNull() then -- Find 1st Fact Date local dtpLast = datFact:GetDatePt1() -- Last date = DatePt1 for Simple, Range, and Before local strType = datFact:GetSubtype() -- Between = DatePt2 and After = DatePt1 + intYrs if strType == "Between" then dtpLast = datFact:GetDatePt2() elseif strType == "After" then dtpLast = fhNewDatePt(dtpLast:GetYear()+intYrs,dtpLast:GetMonth(),dtpLast:GetDay()) end -- Compare only uses Year, Month, Day so omitted ,dtpLast:GetYearDD(),dtpLast:GetBC(),dtpLast:GetCalendar() if dtpMax:Compare(dtpLast) > 0 then dtpMax = dtpLast end if dtpMin:Compare(dtpMax) > 0 then dtpMin = dtpMax end if strType ~= "After" then break end -- Now EARLIEST <= LATEST <= Last date end end local intDays = ( fh.GetDayNumber(dtpMax) - fh.GetDayNumber(dtpMin) ) / 2 local intYear,remYear = math.modf( intDays / 365.2422 ) -- Offset year @ 365.2422 days per year, and remainder fraction local intMnth = math.floor( ( remYear * 12 ) + 0.1 ) -- Offset month is remainder fraction of year * 12 dtpMid = fhCallBuiltInFunction("CalcDate",dtpMin,intYear,intMnth) -- Need approximate MID year & month end return { Min=dtpMin; Mid=dtpMid; Max=dtpMax; } -- Return EARLIEST, MID, LATEST dates end -- local function estimatedDates -- Make EstimatedBirthDate EARLIEST <= LATEST <= 1st Fact Date -- -- Fix errors in EstimatedBirthDate function function fh.EstimatedBirthDates(ptrIndi,intGens) -- ptrInd ~ pointer to individual -- intGens ~ generations to include -- return values ~ EARLIEST, MID, LATEST dates return estimatedDates("EstimatedBirthDate",ptrIndi,intGens,iterate.Facts,10) end -- function EstimatedBirthDates -- Make EstimatedDeathDate EARLIEST <= LATEST <= DEAT/BURI/CREM Date -- -- Fix errors in EstimatedDeathDate function function fh.EstimatedDeathDates(ptrIndi,intGens) -- ptrInd ~ pointer to individual -- intGens ~ generations to include -- return values ~ EARLIEST, MID, LATEST dates return estimatedDates("EstimatedDeathDate",ptrIndi,intGens,getDeathFacts,100) end -- function EstimatedDeathDates --[[ @function: BuildDataRef @description: Get Full Data Reference for Pointer @parameters: Item Pointer @returns: Data Reference String, Record Id Integer, Record Type Tag String @requires: None ]] function fh.BuildDataRef(ptrRef) local strDataRef = "" -- Data Reference with instance indices e.g. INDI.RESI[2].ADDR local intRecId = 0 -- Record Id for associated Record local strRecTag = "" -- Record Tag of associated Record type i.e. INDI, FAM, NOTE, SOUR, etc -- getDataRef() is called recursively per level of the Data Ref -- ptrRef points to the upper Data Ref levels yet to be analysed -- strRef compiles the lower Data Ref levels including instances local function getDataRef(ptrRef,strRef) local ptrTag = ptrRef:Clone() local strTag = fhGetTag(ptrTag) -- Current level Tag ptrTag:MoveToParentItem(ptrTag) if ptrTag:IsNotNull() then -- Parent level exists local intSib = 1 local ptrSib = ptrRef:Clone() -- Pointer to siblings with same Tag ptrSib:MovePrev("SAME_TAG") while ptrSib:IsNotNull() do -- Count previous siblings with same Tag intSib = intSib + 1 ptrSib:MovePrev("SAME_TAG") end if intSib > 1 then strTag = strTag.."["..intSib.."]" end getDataRef(ptrTag,"."..strTag..strRef) -- Now analyse the parent level else strDataRef = strTag..strRef -- Record level reached, so set return values intRecId = fhGetRecordId(ptrRef) strRecTag = strTag if not fhIsValidDataRef(strDataRef) then print("BuildDataRef: "..strDataRef.." is Invalid") end end end -- local function getDataRef if type(ptrRef) == "userdata" then getDataRef(ptrRef,"") end return strDataRef, intRecId, strRecTag end -- function BuildDataRef --[[ @function: GetDataRefPtr @description: Get Pointer for Full Data Reference @parameters: Data Reference String, Record Id Integer, Record Type Tag String (optional) @returns: Item Pointer which IsNull() if any parameters are invalid @requires: None ]] function fh.GetDataRefPtr(strDataRef,intRecId,strRecTag) strDataRef = strDataRef or "" if not strRecTag then strRecTag = strDataRef:gsub("^(%u+).*$","%1") -- Extract Record Tag from Data Ref end local ptrRef = fhNewItemPtr() ptrRef:MoveToRecordById(strRecTag,intRecId or 0) -- Lookup the Record by Id ptrRef:MoveTo(ptrRef,strDataRef) -- Move to the Data Ref return ptrRef end -- function GetDataRefPtr function fh.TblDataRef(ptrRef) local tblRef = {} tblRef.DataRef, tblRef.RecId, tblRef.RecTag = BuildDataRef(ptrRef) return tblRef end -- function TblDataRef function fh.PtrDataRef(tblRef) local tblRef = tblRef or {} -- Ensure table and its fields exist return GetDataRefPtr(tblRef.DataRef or "",tblRef.RecId or 0,tblRef.RecTag or "") end -- function PtrDataRef return fh end -- local function general_v3 local general = general_v3() -- To access FH general tools module --[[ @Module: +fh+tablex_v3 @Author: Mike Tate @Version: 3.1 @LastUpdated: 08 Jan 2022 @Description: A Table Load Save Module. @V3.1: Cater for full UTF-8 filenames. @V3.0: Function Prototype Closure version. @V1.2: Added local definitions of _ to ensure nil gets returned on error. @V1.1: ? @V1.0: Initial version 0.94 is Lua 5.1 compatible. ]] local function tablex_v3() local fh = {} -- Local environment table ------------------------------------------------------ Start Table Load Save -- require "_tableloadsave" --[[ Save Table to File/Stringtable Load Table from File/Stringtable v 0.94 Lua 5.1 compatible Userdata and indices of these are not saved Functions are saved via string.dump, so make sure it has no upvalues References are saved ---------------------------------------------------- table.save( table [, filename] ) Saves a table so it can be called via the table.load function again table must a object of type 'table' filename is optional, and may be a string representing a filename or true/1 table.save( table ) on success: returns a string representing the table (stringtable) (uses a string as buffer, ideal for smaller tables) table.save( table, true or 1 ) on success: returns a string representing the table (stringtable) (uses io.tmpfile() as buffer, ideal for bigger tables) table.save( table, "filename" ) on success: returns 1 (saves the table to file "filename") on failure: returns as second argument an error msg ---------------------------------------------------- table.load( filename or stringtable ) Loads a table that has been saved via the table.save function on success: returns a previously saved table on failure: returns as second argument an error msg ---------------------------------------------------- chillcode, http://lua-users.org/wiki/SaveTableToFile Licensed under the same terms as Lua itself. ]]-- -- declare local variables --// exportstring( string ) --// returns a "Lua" portable version of the string local function exportstring( s ) s = string.format( "%q",s ) -- to replace s = string.gsub( s,"\\\n","\\n" ) s = string.gsub( s,"\r","\\r" ) s = string.gsub( s,string.char(26),"\"..string.char(26)..\"" ) return s end --// The Save Function function fh.save( tbl,filename ) local charS,charE = " ","\n" local file,err,_,stransi,wasansi -- V1.2 -- V3.1 -- Added _,stransi,wasansi --! -- create a pseudo file that writes to a string and return the string if not filename then file = { write = function( self,newstr ) self.str = self.str..newstr end, str = "" } charS,charE = "","" -- write table to tmpfile elseif filename == true or filename == 1 then charS,charE,file = "","",io.tmpfile() -- write table to file -- use io.open here rather than io.output, since in windows when clicking on a file opened with io.output will create an error else stransi,wasansi = general.FileNameToANSI(filename) -- V3.1 -- Cater for non-ANSI filename --! file,err = io.open( stransi, "w" ) if err then return _,err end end -- initiate variables for save procedure local tables,lookup = { tbl },{ [tbl] = 1 } file:write( "return {"..charE ) for idx,t in ipairs( tables ) do if filename and filename ~= true and filename ~= 1 then file:write( "-- Table: {"..idx.."}"..charE ) end file:write( "{"..charE ) local thandled = {} for i,v in ipairs( t ) do thandled[i] = true -- escape functions and userdata if type( v ) ~= "userdata" then -- only handle value if type( v ) == "table" then if not lookup[v] then table.insert( tables, v ) lookup[v] = #tables end file:write( charS.."{"..lookup[v].."},"..charE ) elseif type( v ) == "function" then file:write( charS.."loadstring("..exportstring(string.dump( v )).."),"..charE ) else local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v ) file:write( charS..value..","..charE ) end end end for i,v in pairs( t ) do -- escape functions and userdata if (not thandled[i]) and type( v ) ~= "userdata" then -- handle index if type( i ) == "table" then if not lookup[i] then table.insert( tables,i ) lookup[i] = #tables end file:write( charS.."[{"..lookup[i].."}]=" ) else local index = ( type( i ) == "string" and "["..exportstring( i ).."]" ) or string.format( "[%d]",i ) file:write( charS..index.."=" ) end -- handle value if type( v ) == "table" then if not lookup[v] then table.insert( tables,v ) lookup[v] = #tables end file:write( "{"..lookup[v].."},"..charE ) elseif type( v ) == "function" then file:write( "loadstring("..exportstring(string.dump( v )).."),"..charE ) else local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v ) file:write( value..","..charE ) end end end file:write( "},"..charE ) end file:write( "}" ) -- Return Values -- return stringtable from string if not filename then -- set marker for stringtable return file.str.."--|" -- return stringttable from file elseif filename == true or filename == 1 then file:seek ( "set" ) -- no need to close file, it gets closed and removed automatically -- set marker for stringtable return file:read( "*a" ).."--|" -- close file and return 1 else file:close() if not ( wasansi ) then -- V3.1 -- Cater for non-ANSI filename --! general.MoveFile(stransi,filename) end return 1 end end --// The Load Function function fh.load( sfile ) local tables,err,_ -- V1.2 -- Added _ -- catch marker for stringtable if string.sub( sfile,-3,-1 ) == "--|" then tables,err = loadstring( sfile ) else local stransi,wasansi = general.FileNameToANSI(sfile) -- V3.1 -- Cater for non-ANSI filename --! if not ( wasansi ) then general.CopyFile(sfile,stransi) end tables,err = loadfile( stransi ) if not ( wasansi ) then general.DeleteFile(stransi) -- V3.1 -- Cater for non-ANSI filename --! end end if err then return _,err end tables = tables() for idx = 1,#tables do local tolinkv,tolinki = {},{} for i,v in pairs( tables[idx] ) do if type( v ) == "table" and tables[v[1]] then table.insert( tolinkv,{ i,tables[v[1]] } ) end if type( i ) == "table" and tables[i[1]] then table.insert( tolinki,{ i,tables[i[1]] } ) end end -- link values, first due to possible changes of indices for _,v in ipairs( tolinkv ) do tables[idx][v[1]] = v[2] end -- link indices for _,v in ipairs( tolinki ) do tables[idx][v[2]],tables[idx][v[1]] = tables[idx][v[1]],nil end end return tables[1] end ------------------------------------------------------ End Table Load Save -- overload fh functions into table for strIndex, anyValue in pairs(fh) do if type(anyValue) == "function" then table[strIndex] = anyValue end end return fh end -- local function tablex_v3 local tablex = tablex_v3 () -- To access FH table extension module --[[ @Module: +fh+encoder_v3 @Author: Mike Tate @Version: 3.5 @LastUpdated: 25 Aug 2020 @Description: Text encoder module for HTML XHTML XML URI UTF8 UTF16 ISO CP1252/ANSI character codings. @V3.5: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility. @V3.4: Ensure expressions involving gsub return just text parameter. @V3.3: Adds UNICODE U+10000 to U+10FFFF UTF-16 Supplementary Planes. @V3.2: Update for ANSI & Unicode to ASCII for sorting, Soundex, etc. @V3.1: Update for Unicode UTF-16 & UTF-8 and fhConvertANSItoUTF8 & fhConvertUTF8toANSI, name change UTF to UTF8 & CP to ANSI. @V2.0: StrUTF8_Encode() replaced by StrUTF_CP1252() for entire UTF-8 range, plus new StrCP1252_ISO(). @V1.0: Initial version. ]] local function encoder_v3() local fh = {} -- Local environment table local fhVersion = fhGetAppVersion() local br_Tag = "
" -- Markup language break tag default local br_Lua = "
" -- Lua pattern for break tag recognition local tblCodePage = {} -- Code Page to XML/XHTML/HTML/URI/UTF8 encodings: http://en.wikipedia.org/wiki/Windows-1252 & 1250 & etc -- Control characters "\000" to "\031" for URI & Markup "[%c]" encodings are disallowed except for "\t" to "\r" tblCodePage["\000"] = "" -- NUL tblCodePage["\001"] = "" -- SOH tblCodePage["\002"] = "" -- STX tblCodePage["\003"] = "" -- ETX tblCodePage["\004"] = "" -- EOT tblCodePage["\005"] = "" -- ENQ tblCodePage["\006"] = "" -- ACK tblCodePage["\a"] = "" -- BEL tblCodePage["\b"] = "" -- BS tblCodePage["\t"] = "+" -- HT space in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["\n"] = "%0A" -- LF br_Tag in Markup tblCodePage["\v"] = "%0A" -- VT br_Tag in Markup tblCodePage["\f"] = "%0A" -- FF br_Tag in Markup tblCodePage["\r"] = "%0D" -- CR br_Tag in Markup tblCodePage["\014"] = "" -- SO tblCodePage["\015"] = "" -- SI tblCodePage["\016"] = "" -- DLE tblCodePage["\017"] = "" -- DC1 tblCodePage["\018"] = "" -- DC2 tblCodePage["\019"] = "" -- DC3 tblCodePage["\020"] = "" -- DC4 tblCodePage["\021"] = "" -- NAK tblCodePage["\022"] = "" -- SYN tblCodePage["\023"] = "" -- ETB tblCodePage["\024"] = "" -- CAN tblCodePage["\025"] = "" -- EM tblCodePage["\026"] = "" -- SUB tblCodePage["\027"] = "" -- ESC tblCodePage["\028"] = "" -- FS tblCodePage["\029"] = "" -- GS tblCodePage["\030"] = "" -- RS tblCodePage["\031"] = "" -- US -- ASCII characters "\032" to "\127" for URI "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding tblCodePage[" "] = "+" -- or "%20" Space tblCodePage["!"] = "%21" -- Reserved character tblCodePage['"'] = "%22" -- """ in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["#"] = "%23" -- Reserved character tblCodePage["$"] = "%24" -- Reserved character tblCodePage["%"] = "%25" -- Must be encoded tblCodePage["&"] = "%26" -- Reserved character -- "&" in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["'"] = "%27" -- Reserved character -- "'" in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["("] = "%28" -- Reserved character tblCodePage[")"] = "%29" -- Reserved character tblCodePage["*"] = "%2A" -- Reserved character tblCodePage["+"] = "%2B" -- Reserved character tblCodePage[","] = "%2C" -- Reserved character -- tblCodePage["-"] = "%2D" -- Unreserved character not encoded -- tblCodePage["."] = "%2E" -- Unreserved character not encoded tblCodePage["/"] = "%2F" -- Reserved character -- Digits 0 to 9 -- Unreserved characters not encoded tblCodePage[":"] = "%3A" -- Reserved character tblCodePage[";"] = "%3B" -- Reserved character tblCodePage["<"] = "%3C" -- "<" in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["="] = "%3D" -- Reserved character tblCodePage[">"] = "%3E" -- ">" in Markup see setURIEncodings() and setMarkupEncodings() below tblCodePage["?"] = "%3F" -- Reserved character tblCodePage["@"] = "%40" -- Reserved character -- Letters A to Z -- Unreserved characters not encoded tblCodePage["["] = "%5B" -- Reserved character tblCodePage["\\"]= "%5C" tblCodePage["]"] = "%5D" -- Reserved character tblCodePage["^"] = "%5E" -- tblCodePage["_"] = "%5F" -- Unreserved character not encoded tblCodePage["`"] = "%60" -- Letters a to z -- Unreserved characters not encoded tblCodePage["{"] = "%7B" tblCodePage["|"] = "%7C" tblCodePage["}"] = "%7D" -- tblCodePage["~"] = "%7E" -- Unreserved character not encoded tblCodePage["\127"] = "" -- DEL -- Code Page 1252 Unicode characters "\128" to "\255" for UTF-8 scheme "[€-ÿ]" encodings: http://en.wikipedia.org/wiki/UTF-8 tblCodePage["€"] = string.char(0xE2,0x82,0xAC) -- "€" tblCodePage["\129"] = "" -- Undefined tblCodePage["‚"] = string.char(0xE2,0x80,0x9A) tblCodePage["ƒ"] = string.char(0xC6,0x92) tblCodePage["„"] = string.char(0xE2,0x80,0x9E) tblCodePage["…"] = string.char(0xE2,0x80,0xA6) tblCodePage["†"] = string.char(0xE2,0x80,0xA0) tblCodePage["‡"] = string.char(0xE2,0x80,0xA1) tblCodePage["ˆ"] = string.char(0xCB,0x86) tblCodePage["‰"] = string.char(0xE2,0x80,0xB0) tblCodePage["Š"] = string.char(0xC5,0xA0) tblCodePage["‹"] = string.char(0xE2,0x80,0xB9) tblCodePage["Œ"] = string.char(0xC5,0x92) tblCodePage["\141"] = "" -- Undefined tblCodePage["Ž"] = string.char(0xC5,0xBD) tblCodePage["\143"] = "" -- Undefined tblCodePage["\144"] = "" -- Undefined tblCodePage["‘"] = string.char(0xE2,0x80,0x98) tblCodePage["’"] = string.char(0xE2,0x80,0x99) tblCodePage["“"] = string.char(0xE2,0x80,0x9C) tblCodePage["”"] = string.char(0xE2,0x80,0x9D) tblCodePage["•"] = string.char(0xE2,0x80,0xA2) tblCodePage["–"] = string.char(0xE2,0x80,0x93) tblCodePage["—"] = string.char(0xE2,0x80,0x94) tblCodePage["\152"] = string.char(0xCB,0x9C) -- Small Tilde tblCodePage["™"] = string.char(0xE2,0x84,0xA2) tblCodePage["š"] = string.char(0xC5,0xA1) tblCodePage["›"] = string.char(0xE2,0x80,0xBA) tblCodePage["œ"] = string.char(0xC5,0x93) tblCodePage["\157"] = "" -- Undefined tblCodePage["ž"] = string.char(0xC5,0xBE) tblCodePage["Ÿ"] = string.char(0xC5,0xB8) tblCodePage["\160"] = string.char(0xC2,0xA0) -- " " No Break Space tblCodePage["¡"] = string.char(0xC2,0xA1) -- "¡" tblCodePage["¢"] = string.char(0xC2,0xA2) -- "¢" tblCodePage["£"] = string.char(0xC2,0xA3) -- "£" tblCodePage["¤"] = string.char(0xC2,0xA4) -- "¤" tblCodePage["¥"] = string.char(0xC2,0xA5) -- "¥" tblCodePage["¦"] = string.char(0xC2,0xA6) tblCodePage["§"] = string.char(0xC2,0xA7) tblCodePage["¨"] = string.char(0xC2,0xA8) tblCodePage["©"] = string.char(0xC2,0xA9) tblCodePage["ª"] = string.char(0xC2,0xAA) tblCodePage["«"] = string.char(0xC2,0xAB) tblCodePage["¬"] = string.char(0xC2,0xAC) tblCodePage["­"] = string.char(0xC2,0xAD) -- "­" Soft Hyphen tblCodePage["®"] = string.char(0xC2,0xAE) tblCodePage["¯"] = string.char(0xC2,0xAF) tblCodePage["°"] = string.char(0xC2,0xB0) tblCodePage["±"] = string.char(0xC2,0xB1) tblCodePage["²"] = string.char(0xC2,0xB2) tblCodePage["³"] = string.char(0xC2,0xB3) tblCodePage["´"] = string.char(0xC2,0xB4) tblCodePage["µ"] = string.char(0xC2,0xB5) tblCodePage["¶"] = string.char(0xC2,0xB6) tblCodePage["·"] = string.char(0xC2,0xB7) tblCodePage["¸"] = string.char(0xC2,0xB8) tblCodePage["¹"] = string.char(0xC2,0xB9) tblCodePage["º"] = string.char(0xC2,0xBA) tblCodePage["»"] = string.char(0xC2,0xBB) tblCodePage["¼"] = string.char(0xC2,0xBC) tblCodePage["½"] = string.char(0xC2,0xBD) tblCodePage["¾"] = string.char(0xC2,0xBE) tblCodePage["¿"] = string.char(0xC2,0xBF) tblCodePage["À"] = string.char(0xC3,0x80) tblCodePage["Á"] = string.char(0xC3,0x81) tblCodePage["Â"] = string.char(0xC3,0x82) tblCodePage["Ã"] = string.char(0xC3,0x83) tblCodePage["Ä"] = string.char(0xC3,0x84) tblCodePage["Å"] = string.char(0xC3,0x85) tblCodePage["Æ"] = string.char(0xC3,0x86) tblCodePage["Ç"] = string.char(0xC3,0x87) tblCodePage["È"] = string.char(0xC3,0x88) tblCodePage["É"] = string.char(0xC3,0x89) tblCodePage["Ê"] = string.char(0xC3,0x8A) tblCodePage["Ë"] = string.char(0xC3,0x8B) tblCodePage["Ì"] = string.char(0xC3,0x8C) tblCodePage["Í"] = string.char(0xC3,0x8D) tblCodePage["Î"] = string.char(0xC3,0x8E) tblCodePage["Ï"] = string.char(0xC3,0x8F) tblCodePage["Ð"] = string.char(0xC3,0x90) tblCodePage["Ñ"] = string.char(0xC3,0x91) tblCodePage["Ò"] = string.char(0xC3,0x92) tblCodePage["Ó"] = string.char(0xC3,0x93) tblCodePage["Ô"] = string.char(0xC3,0x94) tblCodePage["Õ"] = string.char(0xC3,0x95) tblCodePage["Ö"] = string.char(0xC3,0x96) tblCodePage["×"] = string.char(0xC3,0x97) tblCodePage["Ø"] = string.char(0xC3,0x98) tblCodePage["Ù"] = string.char(0xC3,0x99) tblCodePage["Ú"] = string.char(0xC3,0x9A) tblCodePage["Û"] = string.char(0xC3,0x9B) tblCodePage["Ü"] = string.char(0xC3,0x9C) tblCodePage["Ý"] = string.char(0xC3,0x9D) tblCodePage["Þ"] = string.char(0xC3,0x9E) tblCodePage["ß"] = string.char(0xC3,0x9F) tblCodePage["à"] = string.char(0xC3,0xA0) tblCodePage["á"] = string.char(0xC3,0xA1) tblCodePage["â"] = string.char(0xC3,0xA2) tblCodePage["ã"] = string.char(0xC3,0xA3) tblCodePage["ä"] = string.char(0xC3,0xA4) tblCodePage["å"] = string.char(0xC3,0xA5) tblCodePage["æ"] = string.char(0xC3,0xA6) tblCodePage["ç"] = string.char(0xC3,0xA7) tblCodePage["è"] = string.char(0xC3,0xA8) tblCodePage["é"] = string.char(0xC3,0xA9) tblCodePage["ê"] = string.char(0xC3,0xAA) tblCodePage["ë"] = string.char(0xC3,0xAB) tblCodePage["ì"] = string.char(0xC3,0xAC) tblCodePage["í"] = string.char(0xC3,0xAD) tblCodePage["î"] = string.char(0xC3,0xAE) tblCodePage["ï"] = string.char(0xC3,0xAF) tblCodePage["ð"] = string.char(0xC3,0xB0) tblCodePage["ñ"] = string.char(0xC3,0xB1) tblCodePage["ò"] = string.char(0xC3,0xB2) tblCodePage["ó"] = string.char(0xC3,0xB3) tblCodePage["ô"] = string.char(0xC3,0xB4) tblCodePage["õ"] = string.char(0xC3,0xB5) tblCodePage["ö"] = string.char(0xC3,0xB6) tblCodePage["÷"] = string.char(0xC3,0xB7) tblCodePage["ø"] = string.char(0xC3,0xB8) tblCodePage["ù"] = string.char(0xC3,0xB9) tblCodePage["ú"] = string.char(0xC3,0xBA) tblCodePage["û"] = string.char(0xC3,0xBB) tblCodePage["ü"] = string.char(0xC3,0xBC) tblCodePage["ý"] = string.char(0xC3,0xBD) tblCodePage["þ"] = string.char(0xC3,0xBE) tblCodePage["ÿ"] = string.char(0xC3,0xBF) -- Set XML/XHTML/HTML "[%c\"&'<>]" Markup encodings: http://en.wikipedia.org/wiki/XML and http://en.wikipedia.org/wiki/HTML local function setMarkupEncodings() tblCodePage["\t"] = " " -- HT "\t" to "\r" are treated as white space in Markup Languages by default tblCodePage["\n"] = br_Tag -- LF tblCodePage["\v"] = br_Tag -- VT line break tag "
" or "
" or "
" or "
" is better tblCodePage["\f"] = br_Tag -- FF tblCodePage["\r"] = br_Tag -- CR tblCodePage['"'] = """ tblCodePage["&"] = "&" tblCodePage["'"] = "'" tblCodePage["<"] = "<" tblCodePage[">"] = ">" end -- local function setMarkupEncodings -- Set URI/URL/URN "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding local function setURIEncodings() tblCodePage["\t"] = "+" -- HT space tblCodePage["\n"] = "%0A" -- LF newline tblCodePage["\v"] = "%0A" -- VT newline tblCodePage["\f"] = "%0A" -- FF newline tblCodePage["\r"] = "%0D" -- CR return tblCodePage['"'] = "%22" tblCodePage["&"] = "%26" tblCodePage["'"] = "%27" tblCodePage["<"] = "%3C" tblCodePage[">"] = "%3E" end -- local function setURIEncodings -- Encode characters according to gsub pattern & lookup table -- local function strEncode(strText,strPattern,tblPattern) return ( (strText or ""):gsub(strPattern,tblPattern) ) -- V3.4 end -- local function strEncode -- Encode CP1252/ANSI characters into UTF-8 codes -- function fh.StrANSI_UTF8(strText) if fhVersion > 5 then strText = fhConvertANSItoUTF8(strText) else strText = strEncode(strText,"[\127-ÿ]",tblCodePage) end return strText end -- function StrANSI_UTF8 function fh.StrCP_UTF(strText) -- Legacy return fh.StrANSI_UTF8(strText) end -- function StrCP1252_UTF8 function fh.StrCP1252_UTF(strText) -- Legacy return fh.StrANSI_UTF8(strText) end -- function StrCP1252_UTF -- Encode CP1252/ANSI or UTF-8 characters into UTF-8 -- function fh.StrEncode_UTF8(strText) if stringx.encoding() == "ANSI" then return fh.StrANSI_UTF8(strText) else return strText end end -- function StrEncode_UTF8 -- Encode CP1252/ANSI characters into XML/XHTML/HTML/UTF8 codes -- local strANSI_XML = "[%z\001-\031\"&'<>\127-ÿ]" if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0 strANSI_XML = "[\000-\031\"&'<>\127-ÿ]" end function fh.StrANSI_XML(strText) setMarkupEncodings() strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag strText = strEncode(strText,strANSI_XML,tblCodePage) return strText end -- function StrANSI_XML function StrCP_XML(strText) -- Legacy return fh.StrANSI_XML(strText) end -- function StrCP_XML function StrCP1252_XML(strText) -- Legacy return fh.StrANSI_XML(strText) end -- function StrCP1252_XML -- Encode UTF-8 ASCII characters into XML/XHTML/HTML codes -- local strUTF8_XML = "[%z\001-\031\"&'<>\127]" if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0 strUTF8_XML = "[\000-\031\"&'<>\127]" end function fh.StrUTF8_XML(strText) setMarkupEncodings() strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag strText = strEncode(strText,strUTF8_XML,tblCodePage) return strText end -- function StrUTF8_XML -- Encode CP1252/ANSI or UTF-8 ASCII characters into XML/XHTML/HTML codes -- function fh.StrEncode_XML(strText) if stringx.encoding() == "ANSI" then return fh.StrANSI_XML(strText) else return fh.StrUTF8_XML(strText) end end -- function StrEncode_XML -- Encode Item Text characters into XML/HTML/UTF-8 codes -- function fh.StrGetItem_XML(ptrItem,strTags) return fh.StrEncode_XML(fhGetItemText(ptrItem,strTags)) end -- function StrGetItem_XML -- Encode CP1252/ANSI characters into URI codes -- function fh.StrANSI_URI(strText) setURIEncodings() strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes %0A strText = strEncode(strText,"[^0-9A-Za-z]",tblCodePage) return strText end -- function StrANSI_URI function fh.StrCP_URI(strText) return fh.StrANSI_URI(strText) end -- function StrCP_URI function fh.StrCP1252_URI(strText) return fh.StrANSI_URI(strText) end -- function StrCP1252_URI -- Encode UTF-8 ASCII characters into URI codes -- local strUTF8_URI = "[%z\001-\127]" if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0 strUTF8_URI = "[\000-\127]" end function fh.StrUTF8_URI(strText) setURIEncodings() strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag strText = strEncode(strText,strUTF8_URI,tblCodePage) return strText end -- function StrUTF8_URI -- Encode CP1252/ANSI or UTF-8 ASCII characters into URI codes -- function fh.StrEncode_URI(strText) if stringx.encoding() == "ANSI" then return fh.StrANSI_URI(strText) else return fh.StrUTF8_URI(strText) end end -- function StrEncode_URI function fh.StrUTF8_Encode(strText) -- Legacy from V1.0 return fh.StrUTF8_ANSI(strText) end -- function StrUTF8_Encode -- Encode UTF-8 bytes into single CP1252/ANSI character V2.0 upvalues -- local strByteRange = "["..string.char(0xC0).."-"..string.char(0xFF).."]" local tblBytePoint = {0xC0;0xE0;0xF0;0xF8;0xFC;} -- Byte codes for 2-byte, 3-byte, 4-byte, 5-byte, 6-byte UTF-8 local tblUTF8 = {} for strByte = string.byte("€"), string.byte("ÿ") do local strChar = string.char(strByte) -- Use CodePage to UTF-8 table to populate UTF-8 to CodePage table local strCode = tblCodePage[strChar] tblUTF8[strCode] = strChar end -- Encode UTF-8 bytes into single CP1252/ANSI character -- function fh.StrUTF8_ANSI(strText) strText = strText or "" if fhVersion > 5 then return fhConvertUTF8toANSI(strText) end if strText:match(strByteRange) then -- If text contains characters that need translating then local intChar = 0 -- Input character index local strChar = "" -- Current character local strCode = "" -- UTF-8 multi-byte code local tblLine = {} -- Translated output line repeat intChar = intChar + 1 -- Step through each character in text strChar = strText:sub(intChar,intChar) if strChar:match(strByteRange) then -- Convert UTF-8 bytes into CP character strCode = strChar -- First UTF-8 byte code, whose top bits say how many bytes to append for intByte, strByte in ipairs(tblBytePoint) do if string.byte(strChar) >= strByte then intChar = intChar + 1 -- Append next UTF-8 byte code character strCode = strCode..strText:sub(intChar,intChar) else break end end strChar = tblUTF8[strCode] or "¿" -- Translate UTF-8 code into CP character end table.insert(tblLine,strChar) -- Accumulate output char by char until intChar >= #strText strText = table.concat(tblLine) end return strText end -- function StrUTF8_ANSI function fh.StrUTF_CP(strText) -- Legacy return fh.StrUTF8_ANSI(strText) end -- function StrUTF_CP function fh.StrUTF_CP1252(strText) -- Legacy return fh.StrUTF8_ANSI(strText) end -- function StrUTF_CP1252 -- Encode CP1252/ANSI or UTF-8 characters into ANSI -- function fh.StrEncode_ANSI(strText) if stringx.encoding() == "ANSI" then return strText or "" else return fh.StrUTF8_ANSI(strText) end end -- function StrEncode_ANSI -- Set ISO-8859-1 "[\127-Ÿ]" encodings: http://en.wikipedia.org/wiki/ISO/IEC_8859-1 local tblISO8859 = { } tblISO8859["\127"]="" -- DEL tblISO8859["€"] = "EUR" tblISO8859["\129"]="" -- Undefined tblISO8859["‚"] = "¸" tblISO8859["ƒ"] = "f" tblISO8859["„"] = "¸¸" tblISO8859["…"] = "..." tblISO8859["†"] = "+" tblISO8859["‡"] = "±" tblISO8859["ˆ"] = "^" tblISO8859["‰"] = "%" tblISO8859["Š"] = "S" tblISO8859["‹"] = "<" tblISO8859["Œ"] = "OE" tblISO8859["\141"]="" -- Undefined tblISO8859["Ž"] = "Z" tblISO8859["\143"]="" -- Undefined tblISO8859["\144"]="" -- Undefined tblISO8859["‘"] = "'" tblISO8859["’"] = "'" tblISO8859["“"] = '"' tblISO8859["”"] = '"' tblISO8859["•"] = "º" tblISO8859["–"] = "-" tblISO8859["—"] = "-" tblISO8859["\152"]="~" -- Small Tilde tblISO8859["™"] = "TM" tblISO8859["š"] = "s" tblISO8859["›"] = ">" tblISO8859["œ"] = "oe" tblISO8859["\157"]="" -- Undefined tblISO8859["ž"] = "z" tblISO8859["Ÿ"] = "Y" -- Encode CP1252/ANSI characters into ISO-8859-1 codes -- function fh.StrANSI_ISO(strText) return strEncode(strText,"[\127-Ÿ]",tblISO8859) end -- function StrANSI_ISO function fh.StrCP_ISO(strText) -- Legacy return fh.StrANSI_ISO(strText) end -- function StrCP_ISO function fh.StrCP1252_ISO(strText) -- Legacy return fh.StrANSI_ISO(strText) end -- function StrCP1252_ISO function fh.StrUTF8_ISO(strText) return fh.StrANSI_ISO(fh.StrUTF8_ANSI(strText)) end -- function StrUTF8_ISO -- Encode CP1252/ANSI or UTF-8 ASCII characters into ISO-8859-1 codes -- function fh.StrEncode_ISO(strText) if stringx.encoding() == "ANSI" then return fh.StrANSI_ISO(strText) else return fh.StrUTF8_ISO(strText) end end -- function StrEncode_ISO -- Convert UTF-8 bytes to a UTF-16 word or pair -- local tblByte = {} local tblLead = { 0x80; 0xC0; 0xE0; 0xF0; 0xF8; 0xFC; } function fh.StrUtf8toUtf16(strChar) -- Convert any UTF-8 multibytes to UTF-16 -- local function strUtf8() if #tblByte > 0 then local intUtf16 = 0 for intIndex, intByte in ipairs (tblByte) do -- Convert UTF-8 bytes to UNICODE U+0080 to U+10FFFF if intIndex == 1 then intUtf16 = intByte - tblLead[#tblByte] else intUtf16 = intUtf16 * 0x40 + intByte - 0x80 end end if intUtf16 > 0xFFFF then -- U+10000 to U+10FFFF Supplementary Planes -- V2.6 tblByte = {} intUtf16 = intUtf16 - 0x10000 local intLow10 = 0xDC00 + ( intUtf16 % 0x400 ) -- Low 16-bit Surrogate local intTop10 = 0xD800 + math.floor( intUtf16 / 0x400 ) -- High 16-bit Surrogate local intChar1 = intTop10 % 0x100 local intChar2 = math.floor( intTop10 / 0x100 ) local intChar3 = intLow10 % 0x100 local intChar4 = math.floor( intLow10 / 0x100 ) return string.char(intChar1,intChar2,intChar3,intChar4) -- Surrogate 16-bit Pair end if intUtf16 < 0xD800 -- U+0080 to U+FFFF (except U+D800 to U+DFFF) -- V2.6 or intUtf16 > 0xDFFF then -- Basic Multilingual Plane tblByte = {} local intChar1 = intUtf16 % 0x100 local intChar2 = math.floor( intUtf16 / 0x100 ) return string.char(intChar1,intChar2) -- BPL 16-bit end local strUtf8 = "" -- U+D800 to U+DFFF Reserved Code Points -- V2.6 for intIndex, intByte in ipairs (tblByte) do strUtf8 = strUtf8..string.format("%.2X ",intByte) end local strUtf16 = string.format("%.4X ",intUtf16) fhMessageBox("\n UTF-16 Reserved Code Point U+D800 to U+DFFF \n UTF-16 = "..strUtf16.." UTF-8 = "..strUtf8.."\n Character will be replaced by a question mark. \n","MB_OK","MB_ICONEXCLAMATION") tblByte = {} return "?\0" end return "" end -- local function strUtf8 local intUtf8 = string.byte(strChar) if intUtf8 < 0x80 then -- U+0000 to U+007F (ASCII) return strUtf8()..strChar.."\0" -- Previous UTF-8 multibytes + current ASCII char end if intUtf8 >= 0xC0 then -- Next UTF-8 multibyte start local strUtf16 = strUtf8() table.insert(tblByte,intUtf8) return strUtf16 -- Previous UTF-8 multibytes end table.insert(tblByte,intUtf8) return "" end -- function StrUtf8toUtf16 -- Encode UTF-8 bytes into UTF-16 words -- function fh.StrUTF8_UTF16(strText) tblByte = {} -- (0xFF) flushes last UTF-8 character return ( ((strText or "")..string.char(0xFF)):gsub("(.)",fh.StrUtf8toUtf16) ) -- V3.4 end -- function StrUTF8_UTF16 -- Encode CP1252/ANSI or UTF-8 characters into UTF-16 words -- function fh.StrEncode_UTF16(strText) if stringx.encoding() == "ANSI" then strText = fh.StrANSI_UTF8(strText) end return fh.StrUTF8_UTF16(strText) end -- function StrEncode_UTF16 local intTop10 = 0 -- Convert a UTF-16 word or pair to UTF-8 bytes -- function fh.StrUtf16toUtf8(strChar1,strChar2) local intUtf16 = string.byte(strChar2) * 0x100 + string.byte(strChar1) if intUtf16 < 0x80 then -- U+0000 to U+007F (ASCII) return string.char(intUtf16) end if intUtf16 < 0x800 then -- U+0080 to U+07FF local intByte1 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte2 = intUtf16 return string.char( intByte2 + 0xC0, intByte1 + 0x80 ) end if intUtf16 < 0xD800 -- U+0800 to U+FFFF or intUtf16 > 0xDFFF then local intByte1 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte2 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte3 = intUtf16 return string.char( intByte3 + 0xE0, intByte2 + 0x80, intByte1 + 0x80 ) end if intUtf16 < 0xDC00 then -- U+10000 to U+10FFFF High 16-bit Surrogate Supplementary Planes -- V2.6 intTop10 = ( intUtf16 - 0xD800 ) * 0x400 + 0x10000 return "" end intUtf16 = intUtf16 - 0xDC00 + intTop10 -- U+10000 to U+10FFFF Low 16-bit Surrogate Supplementary Planes -- V2.6 local intByte1 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte2 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte3 = intUtf16 % 0x40 intUtf16 = math.floor( intUtf16 / 0x40 ) local intByte4 = intUtf16 return string.char( intByte4 + 0xF0, intByte3 + 0x80, intByte2 + 0x80, intByte1 + 0x80 ) end -- function StrUtf16toUtf8 -- Encode UTF-16 words into UTF-8 bytes -- function fh.StrUTF16_UTF8(strText) return ( (strText or ""):gsub("(.)(.)",fh.StrUtf16toUtf8) ) -- V3.4 end -- function StrUTF16_UTF8 -- Encode UTF-16 words into ANSI characters -- function fh.StrUTF16_ANSI(strText) return fh.StrUTF8_ANSI(fh.StrUTF16_UTF8(strText)) end -- function StrUTF16_ANSI -- Read UTF-16/UTF-8/ANSI file converted to chosen encoding via line iterator -- local strUtf16 = "^.%z" if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0 strUtf16 = "^.\0" end function fh.FileLines(strFileName,strEncoding) -- Derived from http://lua-users.org/wiki/EnhancedFileLines local bomUtf16= "^"..string.char(0xFF,0xFE) -- "ÿþ" local bomUtf8 = "^"..string.char(0xEF,0xBB,0xBF) -- "" local fncConv = tostring -- Function to convert input to current encoding local intHead = 1 -- Index to start of current text line local intLump = 1024 local fHandle = general.OpenFile(strFileName,"rb") local strText = fHandle:read(1024) -- Read first lump from file local intBOM = 0 strEncoding = strEncoding or string.encoding() if strText:match(bomUtf16) or strText:match(strUtf16) then strText,intBOM = strText:gsub(bomUtf16,"") -- Strip UTF-16 BOM if strEncoding == "ANSI" then -- Define UTF-16 conversion to current encoding fncConv = fh.StrUTF16_ANSI else fncConv = fh.StrUTF16_UTF8 end elseif strText:match(bomUtf8) then strText,intBOM = strText:gsub(bomUtf8,"") -- Strip UTF-8 BOM if strEncoding == "ANSI" then -- Define UTF-8 conversion to current encoding fncConv = fh.StrUTF8_ANSI end else if strEncoding == "UTF-8" then -- Define ANSI conversion to current encoding fncConv = fh.StrANSI_UTF8 end end strText = fncConv(strText) -- Convert first lump of text return function() -- Iterator function local intTail,strTail -- Index to end of current text line, and terminating characters while true do intTail, strTail = strText:match("()([\r\n].)",intHead) if intTail or not fHandle then if intHead > 1 then intLump = 0 end break -- End of line or end of file elseif fHandle then local strLump = fHandle:read(1024) -- Read next lump from file if strLump then -- Strip old text and add converted lump strText = strText:sub(intHead)..fncConv(strLump) intHead = 1 intLump = 1024 else assert(fHandle:close()) -- End of file fHandle = nil end end end if not intTail then intTail = #strText -- Last fragment of file elseif strTail == "\r\n" then intTail = intTail + 1 -- Adjust tail for both \r & \n end local strLine = strText:sub(intHead,intTail) -- Extract line from text intHead = intTail + 1 if #strLine > 0 then -- Return pruned line, tail chars, lump bytes read local strBody, strTail = strLine:match("^(.-)([\r\n]+)$") return strBody, strTail, intLump end end end -- function FileLines -- Set "[€-ÿ]" ASCII encodings same as Unidecode below local tblASCII = { } tblASCII["€"] = "=E" tblASCII["\129"]="" -- Undefined tblASCII["‚"] = "," tblASCII["ƒ"] = "f" tblASCII["„"] = ",," tblASCII["…"] = "..." tblASCII["†"] = "|+" tblASCII["‡"] = "|++" tblASCII["ˆ"] = "^" tblASCII["‰"] = "%0" tblASCII["Š"] = "S" tblASCII["‹"] = "<" tblASCII["Œ"] = "OE" tblASCII["\141"]="" -- Undefined tblASCII["Ž"] = "Z" tblASCII["\143"]="" -- Undefined tblASCII["\144"]="" -- Undefined tblASCII["‘"] = "'" tblASCII["’"] = "'" tblASCII["“"] = "\"" tblASCII["”"] = "\"" tblASCII["•"] = "*" tblASCII["–"] = "-" tblASCII["—"] = "--" tblASCII["\152"]="~" -- Small Tilde tblASCII["™"] = "TM" tblASCII["š"] = "s" tblASCII["›"] = ">" tblASCII["œ"] = "oe" tblASCII["\157"]="" -- Undefined tblASCII["ž"] = "z" tblASCII["Ÿ"] = "Y" tblASCII["\160"]=" " -- " " No Break Space tblASCII["¡"] = "!" -- "¡" tblASCII["¢"] = "=c" -- "¢" tblASCII["£"] = "=L" -- "£" tblASCII["¤"] = "=$" -- "¤" tblASCII["¥"] = "=Y" -- "¥" tblASCII["¦"] = "|" tblASCII["§"] = "=SS" tblASCII["¨"] = "\"" tblASCII["©"] = "(C)" tblASCII["ª"] = "a" tblASCII["«"] = "<<" tblASCII["¬"] = "-" tblASCII["­"] = "-" -- "­" Soft Hyphen tblASCII["®"] = "(R)" tblASCII["¯"] = "-" tblASCII["°"] = "=o" tblASCII["±"] = "+-" tblASCII["²"] = "2" tblASCII["³"] = "3" tblASCII["´"] = "'" tblASCII["µ"] = "=u" tblASCII["¶"] = "=p" tblASCII["·"] = "*" tblASCII["¸"] = "," tblASCII["¹"] = "1" tblASCII["º"] = "o" tblASCII["»"] = ">>" tblASCII["¼"] = "1/4" tblASCII["½"] = "1/2" tblASCII["¾"] = "3/4" tblASCII["¿"] = "?" tblASCII["À"] = "A" tblASCII["Á"] = "A" tblASCII["Â"] = "A" tblASCII["Ã"] = "A" tblASCII["Ä"] = "A" tblASCII["Å"] = "A" tblASCII["Æ"] = "AE" tblASCII["Ç"] = "C" tblASCII["È"] = "E" tblASCII["É"] = "E" tblASCII["Ê"] = "E" tblASCII["Ë"] = "E" tblASCII["Ì"] = "I" tblASCII["Í"] = "I" tblASCII["Î"] = "I" tblASCII["Ï"] = "I" tblASCII["Ð"] = "D" tblASCII["Ñ"] = "N" tblASCII["Ò"] = "O" tblASCII["Ó"] = "O" tblASCII["Ô"] = "O" tblASCII["Õ"] = "O" tblASCII["Ö"] = "O" tblASCII["×"] = "*" tblASCII["Ø"] = "O" tblASCII["Ù"] = "U" tblASCII["Ú"] = "U" tblASCII["Û"] = "U" tblASCII["Ü"] = "U" tblASCII["Ý"] = "Y" tblASCII["Þ"] = "TH" tblASCII["ß"] = "ss" tblASCII["à"] = "a" tblASCII["á"] = "a" tblASCII["â"] = "a" tblASCII["ã"] = "a" tblASCII["ä"] = "a" tblASCII["å"] = "a" tblASCII["æ"] = "ae" tblASCII["ç"] = "c" tblASCII["è"] = "e" tblASCII["é"] = "e" tblASCII["ê"] = "e" tblASCII["ë"] = "e" tblASCII["ì"] = "i" tblASCII["í"] = "i" tblASCII["î"] = "i" tblASCII["ï"] = "i" tblASCII["ð"] = "d" tblASCII["ñ"] = "n" tblASCII["ò"] = "o" tblASCII["ó"] = "o" tblASCII["ô"] = "o" tblASCII["õ"] = "o" tblASCII["ö"] = "o" tblASCII["÷"] = "/" tblASCII["ø"] = "o" tblASCII["ù"] = "u" tblASCII["ú"] = "u" tblASCII["û"] = "u" tblASCII["ü"] = "u" tblASCII["ý"] = "y" tblASCII["þ"] = "th" tblASCII["ÿ"] = "y" -- Encode CP1252/ANSI characters into ASCII codes [\000-\127] -- function fh.StrANSI_ASCII(strText) return strEncode(strText,"[€-ÿ]",tblASCII) end -- function StrANSI_ASCII --[=[ Unidecode converts each codepoint into a few ASCII characters. Lookup table indexed by codepoint [0x0000]-[0xFFFF] gives an ASCII string. i.e. strASCII = Unidecode[intByte2][intByte1] or "=?" allowing for partially populated table. See http://search.cpan.org/dist/Text-Unidecode/ and follow Browse to: See http://cpansearch.perl.org/src/SBURKE/Text-Unidecode-1.22/lib/Text/Unidecode/ where each x??.pm gives 256 ASCII conversions. Start with the first few European accented characters, and add the others later. --]=] local Unidecode = { } function fh.StrUnidecode(strChar1,strChar2) -- Decode UTF-16 byte pair into ASCII characters return Unidecode[string.byte(strChar2)][string.byte(strChar1)] or "=?" end -- function StrUnidecode -- Encode UTF-8 characters into ASCII codes [\000-\126] -- function fh.StrUTF8_ASCII(strText) strText = fh.StrUTF8_UTF16(strText) -- Convert to UTF-16 Unicode and then to ASCII return ( strText:gsub("(.)(.)",fh.StrUnidecode) ) end -- function StrUTF8_ASCII -- Encode CP1252/ANSI or UTF-8 into ASCII codes [\000-\126] -- function fh.StrEncode_ASCII(strText) if stringx.encoding() == "ANSI" then return fh.StrANSI_ASCII(strText) else return fh.StrUTF8_ASCII(strText) end end -- function StrEncode_ASCII -- Set markup language break tag -- function fh.SetBreakTag(br_New) if not (br_New or ""):match(br_Lua) then -- Ensure new break tag is "
" or "
" or "
" or "
" br_New = "
" end br_Tag = br_New end -- function SetBreakTag for intByte = 0x00, 0xFF do Unidecode[intByte] = { } end Unidecode[0x00] = {[0]="\00";"\01";"\02";"\03";"\04";"\05";"\06";"\a";"\b";"\t";"\n";"\v";"\f";"\r";"\14";"\15";"\16";"\17";"\18";"\19";"\20";"\21";"\22";"\23";"\24";"\25";"\26";"\27";"\28";"\29";"\30";"\31"; " ";"!";'"';"#";"$";"%";"&";"'";"(";")";"*";"+";",";"-";".";"/";"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";":";";";"<";"=";">";"?"; -- 0x20 to 0x3F "@";"A";"B";"C";"D";"E";"F";"G";"H";"I";"J";"K";"L";"M";"N";"O";"P";"Q";"R";"S";"T";"U";"V";"W";"X";"Y";"Z";"[";"\\";"]";"^";"_"; -- 0x40 to 0x5F "`";"a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z";"{";"|";"}";"~";"\127"; -- 0x60 to 0x7F ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; -- 0x80 to 0x9F " ";"!";"=c";"=L";"=$";"=Y";"|";"=SS";'"';"(C)";"a";"<<";"-";"-";"(R)";"-";"=o";"+-";"2";"3";"'";"=u";"=P";"*";",";"1";"o";">>";"1/4";"1/2";"3/4";"?"; -- 0xA0 to 0xBF "A";"A";"A";"A";"A";"A";"AE";"C";"E";"E";"E";"E";"I";"I";"I";"I";"D";"N";"O";"O";"O";"O";"O";"*";"O";"U";"U";"U";"U";"Y";"TH";"ss"; -- 0xC0 to 0xDF "a";"a";"a";"a";"a";"a";"ae";"c";"e";"e";"e";"e";"i";"i";"i";"i";"d";"n";"o";"o";"o";"o";"o";"/";"o";"u";"u";"u";"u";"y";"th";"y"; -- 0xE0 to 0xFF } Unidecode[0x01] = {[0]="A";"a";"A";"a";"A";"a";"C";"c";"C";"c";"C";"c";"C";"c";"D";"d";"D";"d";"E";"e";"E";"e";"E";"e";"E";"e";"E";"e";"G";"g";"G";"g"; -- 0x00 to 0x1F "G";"g";"G";"g";"H";"h";"H";"h";"I";"i";"I";"i";"I";"i";"I";"i";"I";"i";"IJ";"ij";"J";"j";"K";"k";"k";"L";"l";"L";"l";"L";"l";"L"; -- 0x20 to 0x3F "l";"L";"l";"N";"n";"N";"n";"N";"n";"'n";"ng";"NG";"O";"o";"O";"o";"O";"o";"OE";"oe";"R";"r";"R";"r";"R";"r";"S";"s";"S";"s";"S";"s"; -- 0x40 to 0x5F "S";"s";"T";"t";"T";"t";"T";"t";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"W";"w";"Y";"y";"Y";"Z";"z";"Z";"z";"Z";"z";"s"; -- 0x60 to 0x7F "b";"B";"B";"b";"6";"6";"O";"C";"c";"D";"D";"D";"d";"d";"3";"@";"E";"F";"f";"G";"G";"hv";"I";"I";"K";"k";"l";"l";"W";"N";"n";"O"; -- 0x80 to 0x9F "O";"o";"OI";"oi";"P";"p";"YR";"2";"2";"SH";"sh";"t";"T";"t";"T";"U";"u";"Y";"V";"Y";"y";"Z";"z";"ZH";"ZH";"zh";"zh";"2";"5";"5";"ts";"w"; -- 0xA0 to 0xBF "|";"||";"|=";"!";"DZ";"Dz";"dz";"LJ";"Lj";"lj";"NJ";"Nj";"nj";"A";"a";"I";"i";"O";"o";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"@";"A";"a"; -- 0xC0 to 0xDF "A";"a";"AE";"ae";"G";"g";"G";"g";"K";"k";"O";"o";"O";"o";"ZH";"zh";"j";"DZ";"Dz";"dz";"G";"g";"HV";"W";"N";"n";"A";"a";"AE";"ae";"O";"o"; -- 0xE0 to 0xFF } Unidecode[0x02] = {[0]="A";"a";"A";"a";"E";"e";"E";"e";"I";"i";"I";"i";"O";"o";"O";"o";"R";"r";"R";"r";"U";"u";"U";"u";"S";"s";"T";"t";"Y";"y";"H";"h"; -- 0x00 to 0x1F "N";"d";"OU";"ou";"Z";"z";"A";"a";"E";"e";"O";"o";"O";"o";"O";"o";"O";"o";"Y";"y";"l";"n";"t";"j";"db";"qp";"A";"C";"c";"L";"T";"s"; -- 0x20 to 0x3F "z";"[?]";"[?]";"B";"U";"^";"E";"e";"J";"j";"q";"q";"R";"r";"Y";"y";"a";"a";"a";"b";"o";"c";"d";"d";"e";"@";"@";"e";"e";"e";"e";"j"; -- 0x40 to 0x5F "g";"g";"g";"g";"u";"Y";"h";"h";"i";"i";"I";"l";"l";"l";"lZ";"W";"W";"m";"n";"n";"n";"o";"OE";"O";"F";"r";"r";"r";"r";"r";"r";"r"; -- 0x60 to 0x7F "R";"R";"s";"S";"j";"S";"S";"t";"t";"u";"U";"v";"^";"w";"y";"Y";"z";"z";"Z";"Z";"?";"?";"?";"C";"@";"B";"E";"G";"H";"j";"k";"L"; -- 0x80 to 0x9F "q";"?";"?";"dz";"dZ";"dz";"ts";"tS";"tC";"fN";"ls";"lz";"WW";"]]";"h";"h";"h";"h";"j";"r";"r";"r";"r";"w";"y";"'";'"';"`";"'";"`";"`";"'"; -- 0xA0 to 0xBF "?";"?";"<";">";"^";"V";"^";"V";"'";"-";"/";"\\";",";"_";"\\";"/";":";".";"`";"'";"^";"V";"+";"-";"V";".";"@";",";"~";'"';"R";"X"; -- 0xC0 to 0xDF "G";"l";"s";"x";"?";"";"";"";"";"";"";"";"V";"=";'"';"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF } Unidecode[0x03] = { } Unidecode[0x04] = { } Unidecode[0x20] = {[0]=" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";"";"";"";"";"-";"-";"-";"-";"--";"--";"||";"_";"'";"'";",";"'";'"';'"';",,";'"'; -- 0x00 to 0x1F "|+";"|++";"*";"*>";".";"..";"...";".";"\n";"\n\n";"";"";"";"";"";" ";"%0";"%00";"'";"''";"'''";"`";"``";"```";"^";"<";">";"*";"!!";"!?";"-";"_"; -- 0x20 to 0x3F "-";"^";"***";"--";"/";"-[";"]-";"[?]";"?!";"!?";"7";"PP";"(]";"[)";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x40 to 0x5F "[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"0";"";"";"";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"n"; -- 0x60 to 0x7F "0";"1";"2";"3";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x80 to 0x9F "ECU";"CL";"Cr";"FF";"L";"mil";"N";"Pts";"Rs";"W";"NS";"D";"=E";"K";"T";"Dr";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xA0 to 0xBF "[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"";"";"";"";"";"";"";"";"";""; -- 0xC0 to 0xDF "";"";"";"";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF } Unidecode[0x21] = {[34]="TM"; } return fh end -- local function encoder_v3 local encoder = encoder_v3() -- To access FH encoder chars module --[[ @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 --[[ @Module: +fh+iup_gui_v3 @Author: Mike Tate @Version: 4.1 @LastUpdated: 03 May 2022 @Description: Graphical User Interface Library Module @V4.1: CheckVersionInStore() save & retrieve latest version in file; Remove old wiki Help features; @V4.0: Cater for full UTF-8 filenames; @V3.9: ShowDialogue() popup closure fhSleep() added; CheckVersionInStore() at monthly intervals; @V3.8: Function Prototype Closure version. @V3.7: AssignAttributes(tblControls) now allows any string attribute to invoke a function. @V3.6: anyMemoDialogue() sets TopMost attribute. @V3.5: Replace IsNormalWindow(iupDialog) with SetWindowCoord(tblName) and update CheckWindowPosition(tblName) to prevent negative values freezing main dialog. @V3.4: Use general.MakeFolder() to ensure key folders exist, add Get/PutRegKey(), check Registry IE Shell Version in HelpDialogue(), better error handling in LoadSettings(). @V3.3: LoadFolder() and SaveFolder() use global folder as default for local folder to improve synch across PC. @V3.2: Load & Save settings now use a single clipboard so Local PC settings are preserved across synchronised PC. @V3.1: IUP 3.11.2 iup.GetGlobal("VERSION") to top, HelpDialogue conditional ExpandChildren="YES/NO", RefreshDialogue uses NaturalSize, SetUtf8Mode(), Load/SaveFolder(), etc @V3.0: ShowDialogue "dialog" mode for Memo, new DestroyDialogue, NewHelpDialogue tblAttr for Font, AssignAttributes intSkip, CustomDialogue iup.CENTERPARENT+, IUP Workaround, BalloonToggle, Initialise test Plugin file exists. @V2.0: Support for Plugin Data scope, new FontDialogue, RefreshDialogue, AssignAttributes, httpRequest handler, keep "dialog" mode. @V1.0: Initial version. ]] local function iup_gui_v3() local fh = {} -- Local environment table require "iuplua" -- To access GUI window builder require "iupluacontrols" -- To access GUI window controls require "lfs" -- To access LUA filing system require "iupluaole" -- To access OLE subsystem require "luacom" -- To access COM subsystem iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28 local iupVersion = iup.GetGlobal("VERSION") -- Obtain IUP module version -- "iuplua" Omitted Constants Workaround -- iup.TOP = iup.LEFT iup.BOTTOM = iup.RIGHT iup.RED = iup.RGB(1,0,0) iup.GREEN = iup.RGB(0,1,0) iup.BLUE = iup.RGB(0,0,1) iup.BLACK = iup.RGB(0,0,0) iup.WHITE = iup.RGB(1,1,1) iup.YELLOW = iup.RGB(1,1,0) -- Shared Interface Attributes & Functions -- fh.Version = " " -- Plugin Version fh.History = fh.Version -- Version History fh.Red = "255 0 0" -- Color attributes (must exclude leading zeros & spaces to allow value comparisons) fh.Maroon = "128 0 0" fh.Amber = "250 160 0" fh.Orange = "255 165 0" fh.Yellow = "255 255 0" fh.Olive = "128 128 0" fh.Lime = "0 255 0" fh.Green = "0 128 0" fh.Cyan = "0 255 255" fh.Teal = "0 128 128" fh.Blue = "0 0 255" fh.Navy = "0 0 128" fh.Magenta = "255 0 255" fh.Purple = "128 0 128" fh.Black = "0 0 0" fh.Gray = "128 128 128" fh.Silver = "192 192 192" fh.Smoke = "240 240 240" fh.White = "255 255 255" fh.Risk = fh.Red -- Risk colour for hazardous controls such as Close/Delete buttons fh.Warn = fh.Magenta -- Warn colour for caution controls and warnings fh.Safe = fh.Green -- Safe colour for active controls such as most buttons fh.Info = fh.Black -- Info colour for text controls such as labels/tabs fh.Head = fh.Black -- Head colour for headings fh.Body = fh.Black -- Body colour for body text fh.Back = fh.White -- Background colour for all windows fh.Gap = "8" -- Layout attributes Gap was "10" fh.Border = "8x8" -- was BigMargin="10x10" fh.Margin = "1x1" -- was MinMargin fh.Balloon = "NO" -- Tooltip balloon mode fh.FontSet = 0 -- Legacy GUI font set assigned by FontAssignment but used globally fh.FontHead = "" fh.FontBody = "" local GUI = { } -- Sub-table for GUI Dialogue attributes to allow any "Name" --[[ GUI.Name table of dialogue attributes, where Name is Font, Help, Main, Memo, Bars, etc GUI.Name.CoordX x co-ordinate ( Loaded & Saved by default ) GUI.Name.CoordY y co-ordinate ( Loaded & Saved by default ) GUI.Name.Dialog dialogue handle GUI.Name.Focus focus button handle GUI.Name.Frame dialogframe mode, "normal" = dialogframe="NO" else "YES", "showxy" = showxy(), "popup" or "keep" = popup(), default is "normal & showxy" GUI.Name.Height height GUI.Name.Raster rastersize ( Loaded & Saved by default ) GUI.Name.Width width GUI.Name.Back ProgressBar background colour GUI.Name.Body ProgressBar body text colour GUI.Name.Font ProgressBar font style GUI.Name.Stop ProgressBar Stop button colour GUI.Name.GUI Module table usable by other modules e.g. progbar.Setup --]] -- tblScrn[1] = origin x, tblScrn[2] = origin y, tblScrn[3] = width, tblScrn[4] = height local tblScrn = stringx.splitnumbers(iup.GetGlobal("VIRTUALSCREEN")) -- Used by CustomDialogue() and CheckWindowPosition() and ShowDialogue() below local intMaxW = tblScrn[3] local intMaxH = tblScrn[4] function fh.BalloonToggle() -- Toggle tooltips Balloon mode local tblToggle = { YES="NO"; NO="YES"; } fh.Balloon = tblToggle[fh.Balloon] fh.SaveSettings() end -- function BalloonToggle iup.SetGlobal("UTF8MODE","NO") iup.SetGlobal("UTF8MODE_FILE","NO") -- V4.0 function fh.SetUtf8Mode() -- Set IUP into UTF-8 mode if iupVersion == "3.5" or stringx.encoding() == "ANSI" then return false end iup.SetGlobal("UTF8MODE","YES") iup.SetGlobal("UTF8MODE_FILE","YES") -- V4.0 return true end -- function SetUtf8Mode local function tblOfNames(...) -- Get table of dialogue Names including "Font","Help","Main" by default local arg = {...} local tblNames = {"Font";"Help";"Main";} for intName, strName in ipairs(arg) do if type(strName) == "string" and strName ~= "Font" and strName ~= "Help" and strName ~= "Main" then table.insert(tblNames,strName) end end return tblNames end -- local function tblOfNames local function tblNameFor(strName) -- Get table of parameters for chosen dialogue Name strName = tostring(strName) if not GUI[strName] then -- Need new table with default minimum & raster size, and X & Y co-ordinates GUI[strName] = { } local tblName = GUI[strName] tblName.Raster = "x" tblName.CoordX = iup.CENTER tblName.CoordY = iup.CENTER end return GUI[strName] end -- local function tblNameFor local function intDimension(intMin,intVal,intMax) -- Return a number bounded by intMin and intMax if not intVal then return 0 end -- Except if no value then return 0 intVal = tonumber(intVal) or (intMin+intMax)/2 return math.max(intMin,math.min(intVal,intMax)) end -- local function intDimension function fh.CustomDialogue(strName,strRas,intX,intY) -- GUI custom window raster size, and X & Y co-ordinates -- strRas nil = old size, "x" or "0x0" = min size, "999x999" = new size -- intX/Y nil = central, "99" = co-ordinate position local tblName = tblNameFor(strName) local tblSize = {} local intWide = 0 local intHigh = 0 strRas = strRas or tblName.Raster if strRas then -- Ensure raster size is between minimum and screen size tblSize = stringx.splitnumbers(strRas) intWide = intDimension(intWide,tblSize[1],intMaxW) intHigh = intDimension(intHigh,tblSize[2],intMaxH) strRas = tostring(intWide.."x"..intHigh) end if intX and intX < iup.CENTERPARENT then intX = intDimension(0,intX,intMaxW-intWide) -- Ensure X co-ordinate positions window on screen end if intY and intY < iup.CENTERPARENT then intY = intDimension(0,intY,intMaxH-intHigh) -- Ensure Y co-ordinate positions window on screen end tblName.Raster = strRas or "x" tblName.CoordX = tonumber(intX) or iup.CENTER tblName.CoordY = tonumber(intY) or iup.CENTER end -- function CustomDialogue function fh.DefaultDialogue(...) -- GUI default window minimum & raster size, and X & Y co-ordinates for intName, strName in ipairs(tblOfNames(...)) do fh.CustomDialogue(strName) end end -- function DefaultDialogue function fh.DialogueAttributes(strName) -- Provide named Dialogue Attributes local tblName = tblNameFor(strName) -- tblName.Dialog = dialog handle, so any other attributes could be retrieved local tblSize = stringx.splitnumbers(tblName.Raster or "x") -- Split Raster Size into width=tblSize[1] and height=tblSize[2] tblName.Width = tblSize[1] tblName.Height= tblSize[2] tblName.Back = fh.Back -- Following only needed for NewProgressBar tblName.Body = fh.Body tblName.Font = fh.FontBody tblName.Stop = fh.Risk tblName.GUI = fh -- Module table return tblName end -- function DialogueAttributes local strDefaultScope = "Project" -- Default scope for Load/Save data is per Project/User/Machine as set by PluginDataScope() local tblClipProj = { } local tblClipUser = { } -- Clipboards of sticky data for each Plugin Data scope -- V3.2 local tblClipMach = { } local function doLoadData(strParam,strDefault,strScope) -- Load sticky data for Plugin Data scope strScope = tostring(strScope or strDefaultScope):lower() local tblClipData = tblClipProj if strScope:match("user") then tblClipData = tblClipUser elseif strScope:match("mach") then tblClipData = tblClipMach end return tblClipData[strParam] or strDefault end -- local function doLoadData function fh.LoadGlobal(strParam,strDefault,strScope) -- Load Global Parameter for all PC return doLoadData(strParam,strDefault,strScope) end -- function LoadGlobal function fh.LoadLocal(strParam,strDefault,strScope) -- Load Local Parameter for this PC return doLoadData(fh.ComputerName.."-"..strParam,strDefault,strScope) end -- function LoadLocal local function doLoadFolder(strFolder) -- Use relative paths to let Paths change -- V3.3 strFolder = strFolder:gsub("^FhDataPath",function() return fh.FhDataPath end) -- Full path to .fh_data folder strFolder = strFolder:gsub("^PublicPath",function() return fh.PublicPath end) -- Full path to Public folder strFolder = strFolder:gsub("^FhProjPath",function() return fh.FhProjPath end) -- Full path to project folder return strFolder end -- local function doLoadFolder function fh.LoadFolder(strParam,strDefault,strScope) -- Load Folder Parameter for this PC -- V3.3 local strFolder = doLoadFolder(fh.LoadLocal(strParam,"",strScope)) if not general.FlgFolderExists(strFolder) then -- If no local folder try global folder strFolder = doLoadFolder(fh.LoadGlobal(strParam,strDefault,strScope)) end return strFolder end -- function LoadFolder function fh.LoadDialogue(...) -- Load Dialogue Parameters for "Font","Help","Main" by default for intName, strName in ipairs(tblOfNames(...)) do local tblName = tblNameFor(strName) --# tblName.Raster = tostring(fh.LoadLocal(strName.."S",tblName.Raster)) -- Legacy of "S" becomes "R" tblName.Raster = tostring(fh.LoadLocal(strName.."R",tblName.Raster)) tblName.CoordX = tonumber(fh.LoadLocal(strName.."X",tblName.CoordX)) tblName.CoordY = tonumber(fh.LoadLocal(strName.."Y",tblName.CoordY)) fh.CheckWindowPosition(tblName) end end -- function LoadDialogue function fh.LoadSettings(...) -- Load Sticky Settings from File for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do strFileName = fh[strFileName] if general.FlgFileExists(strFileName) then -- Load Settings File in table lines with key & val fields local tblField = {} local strClip = general.StrLoadFromFile(strFileName) --! -- V4.0 for strLine in strClip:gmatch("[^\r\n]+") do --! -- V4.0 --! for strLine in io.lines(strFileName) do if #tblField == 0 and strLine:match("^return {") -- Unless entire Sticky Data table was saved --! and type(table.load) == "function" then local tblClip, strErr = table.load(strFileName) -- Load Settings File table if strErr then error(strErr.."\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.") end for i,j in pairs (tblClip) do tblClipData[i] = tblClip[i] end break end tblField = stringx.split(strLine,"=") if tblField[1] then tblClipData[tblField[1]] = tblField[2] end end else for i,j in pairs (tblClipData) do tblClipData[i] = nil --! Restore defaults and clear any junk -- V4.0 end end end fh.Safe = tostring(fh.LoadGlobal("SafeColor",fh.Safe)) fh.Warn = tostring(fh.LoadGlobal("WarnColor",fh.Warn)) fh.Risk = tostring(fh.LoadGlobal("RiskColor",fh.Risk)) fh.Head = tostring(fh.LoadGlobal("HeadColor",fh.Head)) fh.Body = tostring(fh.LoadGlobal("BodyColor",fh.Body)) fh.FontHead= tostring(fh.LoadGlobal("FontHead" ,fh.FontHead)) fh.FontBody= tostring(fh.LoadGlobal("FontBody" ,fh.FontBody)) fh.FontSet = tonumber(fh.LoadGlobal("Fonts" ,fh.FontSet)) -- Legacy only fh.FontSet = tonumber(fh.LoadGlobal("FontSet" ,fh.FontSet)) -- Legacy only fh.History = tostring(fh.LoadGlobal("History" ,fh.History)) fh.Balloon = tostring(fh.LoadGlobal("Balloon" ,fh.Balloon, "Machine")) fh.LoadDialogue(...) if fh.FontSet > 0 then fh.FontAssignment(fh.FontSet) end -- Legacy only end -- function LoadSettings local function doSaveData(strParam,anyValue,strScope) -- Save sticky data for Plugin Data scope strScope = tostring(strScope or strDefaultScope):lower() local tblClipData = tblClipProj if strScope:match("user") then tblClipData = tblClipUser elseif strScope:match("mach") then tblClipData = tblClipMach end tblClipData[strParam] = anyValue end -- local function doSaveData function fh.SaveGlobal(strParam,anyValue,strScope) -- Save Global Parameter for all PC doSaveData(strParam,anyValue,strScope) end -- function SaveGlobal function fh.SaveLocal(strParam,anyValue,strScope) -- Save Local Parameter for this PC doSaveData(fh.ComputerName.."-"..strParam,anyValue,strScope) end -- function SaveLocal function fh.SaveFolder(strParam,strFolder,strScope) -- Save Folder Parameter for this PC strFolder = stringx.replace(strFolder,fh.FhDataPath,"FhDataPath") -- Full path to .fh_data folder strFolder = stringx.replace(strFolder,fh.PublicPath,"PublicPath") -- Full path to Public folder strFolder = stringx.replace(strFolder,fh.FhProjPath,"FhProjPath") -- Full path to project folder --# doSaveData(fh.ComputerName.."-"..strParam,strFolder,strScope) -- Uses relative paths to let Paths change fh.SaveGlobal(strParam,strFolder,strScope) -- V3.3 fh.SaveLocal(strParam,strFolder,strScope) -- Uses relative paths to let Paths change end -- function SaveFolder function fh.SaveDialogue(...) -- Save Dialogue Parameters for "Font","Help","Main" by default for intName, strName in ipairs(tblOfNames(...)) do local tblName = tblNameFor(strName) fh.SaveLocal(strName.."R",tblName.Raster) fh.SaveLocal(strName.."X",tblName.CoordX) fh.SaveLocal(strName.."Y",tblName.CoordY) end end -- function SaveDialogue function fh.SaveSettings(...) -- Save Sticky Settings to File fh.SaveDialogue(...) fh.SaveGlobal("SafeColor",fh.Safe) fh.SaveGlobal("WarnColor",fh.Warn) fh.SaveGlobal("RiskColor",fh.Risk) fh.SaveGlobal("HeadColor",fh.Head) fh.SaveGlobal("BodyColor",fh.Body) fh.SaveGlobal("FontHead" ,fh.FontHead) fh.SaveGlobal("FontBody" ,fh.FontBody) fh.SaveGlobal("History" ,fh.History) fh.SaveGlobal("Balloon" ,fh.Balloon, "Machine") for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do for i,j in pairs (tblClipData) do -- Check if table has any entries strFileName = fh[strFileName] if type(table.save) == "function" then -- Save entire Settings File table per Project/User/Machine table.save(tblClipData,strFileName) else local tblClip = {} for strKey,strVal in pairs(tblClipData) do -- Else save Settings File lines with key & val fields -- V4.0 table.insert(tblClip,strKey.."="..strVal.."\n") --! -- V4.0 end local strClip = table.concat(tblClip,"\n") --! -- V4.0 if not general.SaveStringToFile(strClip,strFileName) then --! -- V4.0 error("\nSettings file not saved successfully.\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.") end end break end end end -- function SaveSettings function fh.CheckWindowPosition(tblName) -- Ensure dialogue window coordinates are on Screen if tonumber(tblName.CoordX) == nil or tonumber(tblName.CoordX) < 0 -- V3.5 or tonumber(tblName.CoordX) > intMaxW then tblName.CoordX = iup.CENTER end if tonumber(tblName.CoordY) == nil or tonumber(tblName.CoordY) < 0 -- V3.5 or tonumber(tblName.CoordY) > intMaxH then tblName.CoordY = iup.CENTER end end -- function CheckWindowPosition function fh.IsNormalWindow(iupDialog) -- Check dialogue window is not Maximised or Minimised (now redundant) -- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height local tblPosn = stringx.splitnumbers(iupDialog.ScreenPosition) local intPosX = tblPosn[1] local intPosY = tblPosn[2] if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised) return false -- then is Maximised or Minimised end return true end -- function IsNormalWindow function fh.SetWindowCoord(tblName) -- Set the Window coordinates if not Maximised or Minimised -- V3.5 -- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height local tblPosn = stringx.splitnumbers(tblName.Dialog.ScreenPosition) local intPosX = tblPosn[1] local intPosY = tblPosn[2] if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised) return false -- then is Maximised or Minimised end tblName.CoordX = intPosX -- Otherwise set the Window coordinates tblName.CoordY = intPosY return true end -- function SetWindowCoord function fh.ShowDialogue(strName,iupDialog,btnFocus,strFrame) -- Set standard frame attributes and display dialogue window local tblName = tblNameFor(strName) iupDialog = iupDialog or tblName.Dialog -- Retrieve previous parameters if needed btnFocus = btnFocus or tblName.Focus strFrame = strFrame or tblName.Frame strFrame = strFrame or "show norm" -- Default frame mode is dialog:showxy(X,Y) with DialogFrame="NO" ("normal" to vary size, otherwise fixed size) strFrame = strFrame:lower() -- Other modes are "show", "popup" & "keep" with DialogFrame="YES", or with "normal" for DialogFrame="NO" ("show" for active windows, "popup"/"keep" for modal windows) if strFrame:gsub("%s-%a-map%a*[%s%p]*","") == "" then -- May be prefixed with "map" mode to just map dialogue initially, also may be suffixed with "dialog" to inhibit iup.MainLoop() to allow progress messages strFrame = "map show norm" -- If only "map" mode then default to "map show norm" end if type(iupDialog) == "userdata" then tblName.Dialog = iupDialog tblName.Focus = btnFocus -- Preserve parameters tblName.Frame = strFrame iupDialog.Background = fh.Back -- Background colour iupDialog.Shrink = "YES" -- Sometimes needed to shrink controls to raster size if type(btnFocus) == "userdata" then -- Set button as focus for Esc and Enter keys iupDialog.StartFocus = iupDialog.StartFocus or btnFocus iupDialog.DefaultEsc = iupDialog.DefaultEsc or btnFocus iupDialog.DefaultEnter = iupDialog.DefaultEnter or btnFocus end iupDialog.MaxSize = intMaxW.."x"..intMaxH -- Maximum size is screen size iupDialog.MinSize = "x" -- Minimum size (default "x" becomes nil) iupDialog.RasterSize = tblName.Raster or "x" -- Raster size (default "x" becomes nil) if strFrame:match("norm") then -- DialogFrame mode is "NO" by default for variable size window if strFrame:match("pop") or strFrame:match("keep") then iupDialog.MinBox = "NO" -- For "popup" and "keep" hide Minimize and Maximize icons iupDialog.MaxBox = "NO" else strFrame = strFrame.." show" -- If not "popup" nor "keep" then use "showxy" mode end else iupDialog.DialogFrame = "YES" -- Define DialogFrame mode for fixed size window end iupDialog.close_cb = iupDialog.close_cb or function() return iup.CLOSE end -- Define default window X close, move, and resize actions iupDialog.move_cb = iupDialog.move_cb or function(self) fh.SetWindowCoord(tblName) end -- V3.5 iupDialog.resize_cb = iupDialog.resize_cb or function(self) if fh.SetWindowCoord(tblName) then tblName.Raster=self.RasterSize end end -- V3.5 if strFrame:match("map") then -- Only dialogue mapping is required iupDialog:map() tblName.Frame = strFrame:gsub("%s-%a-map%a*[%s%p]*","") -- Remove "map" from frame mode ready for subsequent call return end fh.RefreshDialogue(strName) -- Refresh to set Natural Size as Minimum Size if iup.MainLoopLevel() == 0 -- Called from outside Main GUI, so must use showxy() and not popup() or strFrame:match("dialog") or strFrame:match("sho") then -- Use showxy() to dispay dialogue window for "showxy" or "dialog" mode iupDialog:showxy(tblName.CoordX,tblName.CoordY) if not strFrame:match("dialog") -- Inhibit MainLoop if "dialog" mode -- V4.1 and iup.MainLoopLevel() == 0 then iup.MainLoop() end else iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to display dialogue window for "popup" or "keep" modes fhSleep(200,150) -- Sometimes needed to prevent MainLoop() closure! -- V3.9 end if not strFrame:match("dialog") and strFrame:match("pop") then tblName.Dialog = nil -- When popup closed, clear key parameters, but not for "keep" mode tblName.Raster = nil tblName.CoordX = nil -- iup.CENTER tblName.CoordY = nil -- iup.CENTER else fh.SetWindowCoord(tblName) -- Set Window coordinate pixel values -- V3.5 end end end -- function ShowDialogue function fh.DestroyDialogue(strName) -- Destroy existing dialogue local tblName = tblNameFor(strName) if tblName then local iupDialog = tblName.Dialog if type(iupDialog) == "userdata" then iupDialog:destroy() tblName.Dialog = nil -- Prevent future misuse of handle -- 22 Jul 2014 end end end -- function DestroyDialogue local function strDialogueArgs(strArgA,strArgB,comp) -- Compare two argument pairs and return matching pair local tblArgA = stringx.splitnumbers(strArgA) local tblArgB = stringx.splitnumbers(strArgB) local strArgX = tostring(comp(tblArgA[1] or 100,tblArgB[1] or 100)) local strArgY = tostring(comp(tblArgA[2] or 100,tblArgB[2] or 100)) return strArgX.."x"..strArgY end -- local function strDialogueArgs function fh.RefreshDialogue(strName) -- Refresh dialogue window size after Font change, etc local tblName = tblNameFor(strName) local iupDialog = tblName.Dialog -- Retrieve the dialogue handle if type(iupDialog) == "userdata" then iupDialog.Size = iup.NULL iupDialog.MinSize = iup.NULL -- V3.1 iup.Refresh(iupDialog) -- Refresh window to Natural Size and set as Minimum Size if not iupDialog.RasterSize then iupDialog:map() iup.Refresh(iupDialog) end local strSize = iupDialog.NaturalSize or iupDialog.RasterSize -- IUP 3.5 NaturalSize = nil, IUP 3.11 needs NaturalSize -- V3.1 iupDialog.MinSize = strDialogueArgs(iupDialog.MaxSize,strSize,math.min) -- Set Minimum Size to smaller of Maximm Size or Natural/Raster Size -- V3.1 iupDialog.RasterSize = strDialogueArgs(tblName.Raster,strSize,math.max) -- Set Current Size to larger of Current Size or Natural/Raster Size -- V3.1 iup.Refresh(iupDialog) tblName.Raster = iupDialog.RasterSize if iupDialog.Visible == "YES" then -- Ensure visible dialogue origin is on screen tblName.CoordX = math.max(tblName.CoordX,10) tblName.CoordY = math.max(tblName.CoordY,10) -- Set both coordinates to larger of current value or 10 pixels if iupDialog.Modal then -- V3.8 if iupDialog.Modal == "NO" then iupDialog.ZOrder = "BOTTOM" -- Ensure dialogue is subservient to any popup iupDialog:showxy(tblName.CoordX,tblName.CoordY) -- Use showxy() to reposition main window else iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to reposition modal window end end else iupDialog.BringFront="YES" end end end -- function RefreshDialogue function fh.AssignAttributes(tblControls) -- Assign the attributes of all controls supplied local anyFunction = nil for iupName, tblAttr in pairs ( tblControls or {} ) do if type(iupName) == "userdata" and type(tblAttr) == "table" then-- Loop through each iup control local intSkip = 0 -- Skip counter for attributes same for all controls for intAttr, anyName in ipairs ( tblControls[1] or {} ) do -- Loop through each iup attribute local strName = nil local strAttr = nil local strType = type(anyName) if strType == "string" then -- Attribute is different for each control in tblControls strName = anyName strAttr = tblAttr[intAttr-intSkip] elseif strType == "table" then -- Attribute is same for all controls as per tblControls[1] intSkip = intSkip + 1 strName = anyName[1] strAttr = anyName[2] elseif strType == "function" then intSkip = intSkip + 1 anyFunction = anyName break end if type(strName) == "string" and ( type(strAttr) == "string" or type(strAttr) == "function" ) then local anyRawGet = rawget(fh,strAttr) -- Use rawget() to stop require("pl.strict") complaining if type(anyRawGet) == "string" then strAttr = anyRawGet -- Use internal module attribute such as Head or FontBody elseif type(iupName[strName]) == "string" and type(strAttr) == "function" then -- Allow string attributes to invoke a function -- V3.7 strAttr = strAttr() end iupName[strName] = strAttr -- Assign attribute to control end end end end if anyFunction then anyFunction() end -- Perform any control assignment function end -- function AssignAttributes -- Font Dialogue Attributes and Functions -- fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default font for Body and Head text fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold ") ---[=[ local intFontPlain = 1 -- Font Face & Style values for legacy FontSet setting local intFontBold = 2 local intArialPlain = 3 local intArialBold = 4 local intTahomaPlain= 5 local intTahomaBold = 6 local strFontFace = fh.FontBody:gsub(",.*","") local tblFontSet = {} -- Lookup table for FontHead and FontBody tblFontSet[intFontPlain] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; -15"; } tblFontSet[intFontBold] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; Bold -15"; } tblFontSet[intArialPlain] = { Head="Arial; Bold -16"; Body="Arial; -16"; } tblFontSet[intArialBold] = { Head="Arial; Bold -16"; Body="Arial; Bold -15"; } tblFontSet[intTahomaPlain] = { Head="Tahoma; Bold -15"; Body="Tahoma; -16"; } tblFontSet[intTahomaBold] = { Head="Tahoma; Bold -15"; Body="Tahoma; Bold -14"; } function fh.FontAssignment(intFontSet) -- Assign Font Face & Style GUI values for legacy FontSet setting if intFontSet then intFontSet = math.max(intFontSet,1) intFontSet = math.min(intFontSet,#tblFontSet) fh.FontHead = tblFontSet[intFontSet]["Head"] -- Legacy Font for all GUI dialog header text fh.FontBody = tblFontSet[intFontSet]["Body"] -- Legacy Font for all GUI dialog body text end end -- function FontAssignment --]=] function fh.FontDialogue(tblAttr,strName) -- GUI Font Face & Style Dialogue tblAttr = tblAttr or {} strName = strName or "Main" local isFontChosen = false local btnFontHead = iup.button { Title="Choose Headings Font and default Colour"; } local btnFontBody = iup.button { Title="Choose Body text Font and default Colour"; } local btnCol_Safe = iup.button { Title=" Safe Colour "; } local btnCol_Warn = iup.button { Title=" Warning Colour "; } local btnCol_Risk = iup.button { Title=" Risky Colour "; } local btnDefault = iup.button { Title=" Default Fonts "; } local btnMinimum = iup.button { Title=" Minimum Size "; } local btnDestroy = iup.button { Title=" Close Dialogue "; } local frmSetFonts = iup.frame { Title=" Set Window Fonts & Colours "; iup.vbox { Alignment="ACENTER"; Margin=fh.Margin; Homogeneous="YES"; btnFontHead; btnFontBody; iup.hbox { btnCol_Safe; btnCol_Warn; btnCol_Risk; Homogeneous="YES"; }; iup.hbox { btnDefault ; btnMinimum ; btnDestroy ; Homogeneous="YES"; }; } -- iup.vbox end } -- iup.frame end -- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button local dialogFont = iup.dialog { Title=" Set Window Fonts & Colours "; Gap=fh.Gap; Margin=fh.Border; frmSetFonts; } local tblButtons = { } local function setDialogues() -- Refresh the Main and Help dialogues local tblHelp = tblNameFor("Help") if type(tblHelp.Dialog) == "userdata" then -- Help dialogue exists fh.AssignAttributes(tblHelp.TblAttr) -- Assign the Help dialogue attributes fh.RefreshDialogue("Help") -- Refresh the Help window size & position end fh.AssignAttributes(tblAttr) -- Assign parent dialogue attributes fh.RefreshDialogue(strName) -- Refresh parent window size & position and bring infront of Help window fh.RefreshDialogue("Font") -- Refresh Font window size & position and bring infront of parent window end -- local function setDialogues local function getFont(strColor) -- Set font button function local strTitle = " Choose font style & default colour for "..strColor:gsub("Head","Heading").." text " local strValue = "Font"..strColor -- The font codes below are not recognised by iupFontDlg and result in empty font face! local strFont = rawget(fh,strValue):gsub(" Black,",","):gsub(" Light, Bold",","):gsub(" Extra Bold,",","):gsub(" Semibold,",",") local iupFontDlg = iup.fontdlg { Title=strTitle; Color=rawget(fh,strColor); Value=strFont; } iupFontDlg:popup() -- Popup predefined font dialogue if iupFontDlg.Status == "1" then if iupFontDlg.Value:match("^,") then -- Font face missing so revert to original font iupFontDlg.Value = rawget(fh,strValue) end fh[strColor] = iupFontDlg.Color -- Set Head or Body color attribute fh[strValue] = iupFontDlg.Value -- Set FontHead or FontBody font style fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes setDialogues() isFontChosen = true end end -- local function getFont local function getColor(strColor) -- Set colour button function local strTitle = " Choose colour for "..strColor:gsub("Warn","Warning"):gsub("Risk","Risky").." button & message text " local iupColorDlg = iup.colordlg { Title=strTitle; Value=rawget(fh,strColor); ShowColorTable="YES"; } iupColorDlg.DialogFrame="YES" iupColorDlg:popup() -- Popup predefined color dialogue fixed size window if iupColorDlg.Status == "1" then fh[strColor] = iupColorDlg.Value -- Set Safe or Warn or Risk color attribute fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes setDialogues() isFontChosen = true end end -- local function getColor local function setDefault() -- Action for Default Fonts button fh.Safe = fh.Green fh.Warn = fh.Magenta fh.Risk = fh.Red -- Set default colours fh.Body = fh.Black fh.Head = fh.Black fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default fonts for Body and Head text fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold") fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes setDialogues() isFontChosen = true end -- local function setDefault local function setMinimum() -- Action for Minimum Size button local tblName = tblNameFor(strName) local iupDialog = tblName.Dialog -- Retrieve the parent dialogue handle if type(iupDialog) == "userdata" then tblName.Raster = "10x10" -- Refresh parent window to Minimum Size & adjust position fh.RefreshDialogue(strName) end local tblFont = tblNameFor("Font") tblFont.Raster = "10x10" -- Refresh Font window to Minimum Size & adjust position fh.RefreshDialogue("Font") end -- local function setMinimum tblButtons = { { "Font" ; "FgColor" ; "Tip" ; "action" ; {"TipBalloon";"Balloon";} ; {"Expand";"YES";} ; }; [btnFontHead] = { "FontHead"; "Head"; "Choose the Heading text Font Face, Style, Size, Effects, and default Colour"; function() getFont("Head") end; }; [btnFontBody] = { "FontBody"; "Body"; "Choose the Body text Font Face, Style, Size, Effects, and default Colour" ; function() getFont("Body") end; }; [btnCol_Safe] = { "FontBody"; "Safe"; "Choose the colour for Safe operations" ; function() getColor("Safe") end; }; [btnCol_Warn] = { "FontBody"; "Warn"; "Choose the colour for Warning operations"; function() getColor("Warn") end; }; [btnCol_Risk] = { "FontBody"; "Risk"; "Choose the colour for Risky operations" ; function() getColor("Risk") end; }; [btnDefault ] = { "FontBody"; "Safe"; "Restore default Fonts and Colours"; function() setDefault() end; }; [btnMinimum ] = { "FontBody"; "Safe"; "Reduce window to its minimum size"; function() setMinimum() end; }; [btnDestroy ] = { "FontBody"; "Risk"; "Close this dialogue "; function() return iup.CLOSE end; }; [frmSetFonts] = { "FontHead"; "Head"; }; } fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep normal") -- Popup the Set Window Fonts dialogue: "keep normal" : vary size & posn, and remember size & posn -- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup normal") -- Popup the Set Window Fonts dialogue: "popup normal" : vary size & posn, but redisplayed centred -- fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep") -- Popup the Set Window Fonts dialogue: "keep" : fixed size, vary posn, and only remember posn -- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup") -- Popup the Set Window Fonts dialogue: "popup": fixed size, vary posn, but redisplayed centred dialogFont:destroy() return isFontChosen end -- function FontDialogue local function anyMemoControl(anyName,fgColor) -- Compose any control Title and FgColor local strName = tostring(anyName) -- anyName may be a string, and fgColor is default FgColor local tipText = nil if type(anyName) == "table" then -- anyName may be a table = { Title string ; FgColor string ; ToolTip string (optional); } strName = anyName[1] fgColor = anyName[2]:match("%d* %d* %d*") or fgColor tipText = anyName[3] end return strName, fgColor, tipText end -- local function anyMemoControl local function anyMemoDialogue(strHead,anyHead,strMemo,anyMemo,...) -- Display framed memo dialogue with buttons local arg = {...} -- Fix for Lua 5.2+ local intButt = 0 -- Returned value if "X Close" button is used local tblButt = { [0]="X Close"; } -- Button names lookup table local strHead, fgcHead, tipHead = anyMemoControl(anyHead or "",strHead) local strMemo, fgcMemo, tipMemo = anyMemoControl(anyMemo or "",strMemo) -- Create the GUI labels and buttons local lblMemo = iup.label { Title=strMemo; FgColor=fgcMemo; Tip=tipMemo; TipBalloon=fh.Balloon; Alignment="ACENTER"; Padding=fh.Margin; Expand="YES"; WordWrap="YES"; } local lblLine = iup.label { Separator="HORIZONTAL"; } local iupHbox = iup.hbox { Homogeneous="YES"; } local btnButt = iup.button { } local strTop = "YES" -- Make dialogue TopMost -- V3.6 local strMode = "popup" if arg[1] == "Keep Dialogue" then -- Keep dialogue open for a progress message strMode = "keep dialogue" lblLine = iup.label { } if not arg[2] then strTop = "NO" end -- User chooses TopMost -- V3.6 else if #arg == 0 then arg[1] = "OK" end -- If no buttons listed then default to an "OK" button for intArg, anyButt in ipairs(arg) do local strButt, fgcButt, tipButt = anyMemoControl(anyButt,fh.Safe) tblButt[intArg] = strButt btnButt = iup.button { Title=strButt; FgColor=fgcButt; Tip=tipButt; TipBalloon=fh.Balloon; Expand="NO"; MinSize="80"; Padding=fh.Margin; action=function() intButt=intArg return iup.CLOSE end; } iup.Append( iupHbox, btnButt ) end end -- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button local iupMemo = iup.dialog { Title=fh.Plugin..fh.Version..strHead; TopMost=strTop; -- TopMost added -- V3.6 iup.vbox { Alignment="ACENTER"; Gap=fh.Gap; Margin=fh.Margin; iup.frame { Title=strHead; FgColor=fgcHead; Font=fh.FontHead; iup.vbox { Alignment="ACENTER"; Font=fh.FontBody; lblMemo; lblLine; iupHbox; }; }; }; } fh.ShowDialogue("Memo",iupMemo,btnButt,strMode) -- Show popup Memo dialogue window with righthand button in focus (if any) if strMode == "keep dialogue" then return lblMemo end -- Return label control so message can be changed iupMemo:destroy() return intButt, tblButt[intButt] -- Return button number & title that was pressed end -- local function anyMemoDialogue function fh.MemoDialogue(anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with "Memo" in frame return anyMemoDialogue(fh.Head,"Memo",fh.Body,anyMemo,...) end -- function MemoDialogue function fh.WarnDialogue(anyHead,anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with heading in frame return anyMemoDialogue(fh.Warn,anyHead,fh.Warn,anyMemo,...) end -- function WarnDialogue function fh.GetRegKey(strKey) -- Read Windows Registry Key Value local luaShell = luacom.CreateObject("WScript.Shell") local anyValue = nil if pcall( function() anyValue = luaShell:RegRead(strKey) end ) then return anyValue -- Return Key Value if found end return nil end -- function GetRegKey function fh.PutRegKey(strKey,anyValue,strType) -- Write Windows Registry Key Value local luaShell = luacom.CreateObject("WScript.Shell") local strAns = nil if pcall( function() strAns = luaShell:RegWrite(strKey,anyValue,strType) end ) then return true end return nil end -- function PutRegKey local function httpRequest(strRequest) -- Luacom http request protected by pcall() below local http = luacom.CreateObject("winhttp.winhttprequest.5.1") http:Open("GET",strRequest,false) http:Send() return http.Responsebody end -- local function httpRequest function fh.VersionInStore(strPlugin) -- Obtain the Version in Plugin Store by Name only -- V3.9 local strVersion = "0" if strPlugin then local strFile = fh.MachinePath.."\\VersionInStore "..strPlugin..".dat" local intTime = os.time() - 2600000 -- Time in seconds a month ago -- V3.9 local tblAttr, strError = lfs.attributes(strFile) -- Obtain file attributes if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago -- V3.9 local strErrFile = fh.MachinePath.."\\VersionInStoreInternetError.dat" local strRequest ="http://www.family-historian.co.uk/lnk/checkpluginversion.php?name="..strPlugin local isOK, strReturn = pcall(httpRequest,strRequest) if not isOK then -- Problem with Internet access local intTime = os.time() - 36000 -- Time in seconds 10 hours ago local tblAttr, strError = lfs.attributes(strErrFile) -- Obtain file attributes if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago fhMessageBox(strReturn.."\n The Internet appears to be inaccessible. ","MB_OK","MB_ICONEXCLAMATION") end general.SaveStringToFile(strErrFile,strErrFile) -- Update file modified time else general.DeleteFile(strErrFile) -- Delete file if Internet is OK if strReturn ~= nil then strVersion = strReturn:match("([%d%.]*),%d*") -- Version digits & dots then comma and Id digits general.SaveStringToFile(strVersion,strFile) -- Update file modified time and save version -- V4.1 end end else strVersion = general.StrLoadFromFile(strFile) -- Retrieve saved latest version -- V4.1 if #strVersion > 9 then general.DeleteFile(strFile) end end end return strVersion or "0" end -- function VersionInStore local function intVersion(strVersion) -- Convert version string to comparable integer local intVersion = 0 local arrNumbers = {} strVersion:gsub("(%d+)", function(strDigits) table.insert(arrNumbers,strDigits) end) -- V4.1 for i=1,5 do intVersion = intVersion * 100 + tonumber(arrNumbers[i] or 0) end return intVersion end -- local function intVersion function fh.CheckVersionInStore() -- Check if later Version available in Plugin Store local strNewVer = fh.VersionInStore(fh.Plugin:gsub(" %- .*","")) local strOldVer = fh.Version if intVersion(strNewVer) > intVersion(strOldVer:match("%D*([%d%.]*)")) then fh.MemoDialogue("Later Version "..strNewVer.." of this Plugin is available from the Family Historian 'Plugin Store'.") end end -- function CheckVersionInStore function fh.PluginDataScope(strScope) -- Set default Plugin Data scope to per-Project, or per-User, or per-Machine strScope = tostring(strScope):lower() if strScope:match("mach") then -- Per-Machine strDefaultScope = "Machine" elseif strScope:match("user") then -- Per-User strDefaultScope = "User" end -- Per-Project is default end -- function PluginDataScope --[=[ --! -- V4.0 local function strToANSI(strFileName) if stringx.encoding() == "ANSI" then return strFileName end return fhConvertUTF8toANSI(strFileName) end -- local function strToANSI --]=] local function getPluginDataFileName(strScope) -- Get plugin data filename for chosen scope local isOK, strDataFile = pcall(fhGetPluginDataFileName,strScope) if not isOK then strDataFile = fhGetPluginDataFileName() end -- Before V5.0.8 parameter is disallowed and default = CURRENT_PROJECT --! return strToANSI(strDataFile) -- V4.0 return strDataFile end -- local function getPluginDataFileName local function getDataFiles(strScope) -- Compose the Plugin Data file & path & root names --! local strPluginName = strToANSI(fh.Plugin) -- V4.0 local strPluginName = fh.Plugin local strPluginPlain = stringx.plain(strPluginName) local strDataFile = getPluginDataFileName(strScope) -- Allow plugins with variant filenames to use same plugin data files strDataFile = strDataFile:gsub("\\"..strPluginPlain:gsub(" ","_"):lower(),"\\"..strPluginName) strDataFile = strDataFile:gsub("\\"..strPluginPlain..".+%.[D,d][A,a][T,t]$","\\"..strPluginName..".dat") if strDataFile == "" and strScope == "CURRENT_PROJECT" then -- Use standalone GEDCOM path & filename..".fh_data\Plugin Data\" as the folder + the Plugin Filename..".dat" --! strDataFile = strToANSI(fhGetContextInfo("CI_GEDCOM_FILE")) -- V4.0 strDataFile = fhGetContextInfo("CI_GEDCOM_FILE") strDataFile = strDataFile:gsub("%.[G,g][E,e][D,d]",".fh_data") general.MakeFolder(strDataFile) -- V3.4 strDataFile = strDataFile.."\\Plugin Data" general.MakeFolder(strDataFile) -- V3.4 strDataFile = strDataFile.."\\"..strPluginName..".dat" end local strDataPath = strDataFile:gsub("\\"..strPluginPlain.."%.[D,d][A,a][T,t]$","") -- Plugin data folder path name local strDataRoot = strDataPath.."\\"..strPluginName -- Plugin data file root name general.MakeFolder(strDataPath) -- V3.4 return strDataFile, strDataPath, strDataRoot end -- local function getDataFiles function fh.Initialise(strVersion,strPlugin) -- Initialise the GUI module with optional Version & Plugin name --! local strAppData = strToANSI(fhGetContextInfo("CI_APP_DATA_FOLDER")) -- V4.0 local strAppData = fhGetContextInfo("CI_APP_DATA_FOLDER") fh.Plugin = fhGetContextInfo("CI_PLUGIN_NAME") -- Plugin Name from file fh.Version = strVersion or " " -- Plugin Version if fh.Version == " " then local strTitle = "\n@Title is missing" local strAuthor = "\n@Author is missing" local strVersion = "\n@Version is missing" local strPlugin = strAppData.."\\Plugins\\"..fh.Plugin..".fh_lua" if general.FlgFileExists(strPlugin) then for strLine in io.lines(strPlugin) do -- Read each line from the Plugin file strPlugin = strLine:match("^@Title:[\t-\r ]*(.*)") if strPlugin then strPlugin = strPlugin:gsub("&&","&") --? if fh.Plugin:match("^"..strPlugin:gsub("(%W)","%%%1")) then if fh.Plugin:match("^"..stringx.plain(strPlugin)) then fh.Plugin = strPlugin -- Prefer Title to Filename if it matches strTitle = nil else strTitle = "\n@Title differs from Filename" -- Report abnormality end end if strLine:match("^@Author:%s*(.*)") then -- Check @Author exists strAuthor = nil end fh.Version = strLine:gsub("^@Version:%D*([%d%.]*)%D*"," %1 ") if fh.Version ~= strLine then -- Obtain the @Version from Plugin file strVersion = nil break end end if strTitle or strAuthor or strVersion then -- Report any header abnormalities fhMessageBox("\nScript Header: "..fh.Plugin..(strTitle or "")..(strAuthor or "")..(strVersion or ""),"MB_OK","MB_ICONEXCLAMATION") end else fhMessageBox("\nPlugin has not been saved!","MB_OK","MB_ICONEXCLAMATION") end end fh.History = fh.Version -- Version History fh.Plugin = strPlugin or fh.Plugin -- Plugin Name from argument or default from file fh.CustomDialogue("Help","1020x730") -- Custom "Help" dialogue sizes fh.DefaultDialogue() -- Default "Font","Help","Main" dialogues fh.MachineFile,fh.MachinePath,fh.MachineRoot = getDataFiles("LOCAL_MACHINE") -- Plugin data names per machine fh.PerUserFile,fh.PerUserPath,fh.PerUserRoot = getDataFiles("CURRENT_USER") -- Plugin data names per user fh.ProjectFile,fh.ProjectPath,fh.ProjectRoot = getDataFiles("CURRENT_PROJECT") -- Plugin data names per project --! fh.FhDataPath = strToANSI(fhGetContextInfo("CI_PROJECT_DATA_FOLDER")) -- Paths used by Load/SaveFolder for relative folders -- V4.0 --! fh.PublicPath = strToANSI(fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER")) -- Public data folder path name -- V4.0 fh.FhDataPath = fhGetContextInfo("CI_PROJECT_DATA_FOLDER") -- Paths used by Load/SaveFolder for relative folders -- V4.0 fh.PublicPath = fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER") -- Public data folder path name -- V4.0 if fh.FhDataPath == "" then fh.FhDataPath = fh.ProjectPath:gsub("\\Plugin Data$","") end if fh.PublicPath == "" then fh.PublicPath = fh.ProjectPath fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Plugin Data$","%1") else general.MakeFolder(fh.PublicPath) -- V3.4 fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Public$","%1") end fh.CalicoPie = strAppData:gsub("\\Calico Pie\\.*","\\Calico Pie") -- Program Data Calico Pie path name fh.ComputerName = os.getenv("COMPUTERNAME") -- Local PC Computer Name end -- function Initialise fh.Initialise() -- Initialise module with default values return fh end -- local function iup_gui_v3 local iup_gui = iup_gui_v3() -- To access FH IUP GUI build module -- Global Data Definitions -- function PresetGlobalData() iup_gui.Margin = "1x1" iup_gui.Gap = "1" iup_gui.Balloon = "NO" -- Needed for PlayOnLinux/Mac -- V1.6 iup_gui.SetUtf8Mode() TblTags = { "INDI"; "FAM"; "_PLAC"; -- Table of Record and Place fields -- 20 Nov 2015 V1.3 INDI = { PLAC=true; _PLAC=true; }; FAM = { PLAC=true; }; _PLAC= { TEXT=true; } } ArrTags = { PLAC=true; _PLAC=false; _LINK_P=true; TEXT=false; }; -- List of tags with Place names -- V1.7 ArrColPart = { } -- Create list of " Address 1 ", ... , " Address 10 ", " Place 1 ", ... , " Place 10 " IntColsMax = 10 for intColType, strColType in ipairs ({" Address 9 "," Place 9 "}) do for intColItem = 1, IntColsMax do strColType = strColType:gsub("%d+",tostring(intColItem)) table.insert(ArrColPart,strColType) end end TblOption = { } -- Saved sticky GUI options TblFilter = { } -- Address & Place input filter IntFocus = -1 -- Focus entry for input filter -- V1.6 IntLines = 20 -- Half lines for input filter -- V1.6 DicSortBy = { Place="Address"; Address="Place"; Plac="Addr"; Addr="Plac"; } -- V1.5 -- V1.6 StrSortBy = "Place" -- V1.5 -- V1.8 TblOption.SortBy = StrSortBy end -- function PresetGlobalData -- Reset Sticky Settings to Default Values -- function ResetDefaultSettings() iup_gui.CustomDialogue("Main","0x0") -- Custom "Main" dialogue minimum size & centralisation iup_gui.CustomDialogue("Font","0x0") -- Custom "Font" dialogue minimum size & centralisation for intColPart, strColPart in ipairs (ArrColPart) do TblOption[strColPart] = intColPart -- Reset default column part assignments end StrHideAdr = "OFF" -- Reset default GUI toggle settings StrShowAdr = "OFF" StrWipeAdr = "OFF" StrRghtAdr = "OFF" StrLeftAdr = "OFF" StrWipePlc = "OFF" StrRghtPlc = "OFF" StrLeftPlc = "OFF" --= StrSortBy = "Place" -- V1.5 --= TblOption.SortBy = StrSortBy IntTabPosn = 0 -- Default to tab undefined end -- function ResetDefaultSettings -- Load Sticky Settings from File -- function LoadSettings() iup_gui.LoadSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History" TblOption = iup_gui.LoadGlobal("Option",TblOption) StrSortBy = TblOption.SortBy or StrSortBy -- V1.5 SaveSettings() -- Save sticky data settings end -- function LoadSettings -- Save Sticky Settings to File -- function SaveSettings() iup_gui.SaveGlobal("Option",TblOption ) iup_gui.SaveSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History" end -- function SaveSettings -- Copy Children Data Fields -- -- V1.7 function CopyBranch(ptrSource,ptrTarget) local strTag = fhGetTag(ptrSource) if strTag == "_FMT" then return end -- Skip rich text format code if strTag == "_FIELD" then strTag = fhGetMetafieldShortcut(ptrSource) -- Handle citation metafield end local ptrNew = fhCreateItem(strTag,ptrTarget,true) if ptrNew:IsNull() then return end -- Escape if item not created if strTag=="TEXT" and fhGetTag(ptrTarget)=="_PLAC" then return end -- Escape if Place name to avoid duplication fhSetValue_Copy(ptrNew,ptrSource) CopyChildren(ptrSource,ptrNew) end -- function CopyBranch -- Copy Children Data Fields -- function CopyChildren(ptrSource,ptrTarget) local intFrom = 0 -- Count of child branches local ptrFrom = fhNewItemPtr() ptrFrom = ptrSource:Clone() ptrFrom:MoveToFirstChildItem(ptrFrom) while ptrFrom:IsNotNull() do intFrom = intFrom + 1 CopyBranch(ptrFrom,ptrTarget) -- Unsupported items such as Custom ID, etc, will be silently dropped ptrFrom:MoveNext() end return intFrom end -- function CopyChildren function DoRearrangeParts(intMaxAddr,intMaxPlac) local tblOld = {} -- V6+ Old Place names versus New Place names, etc local tblNew = {} -- V6+ New Place names versus Old Place names, etc local tblCol = {} -- Place & Address Column Parts in strColPart() for V5 only local intPlaces = 0 -- Count of V6+ Place Records local intAlters = 0 -- Count of V6+ multiple Merges & Clones local dicStrBoth = {} -- Result Set tables local arrOldAddr = {} local arrOldPlac = {} local arrPtrAddr = {} local arrPtrPlac = {} local arrWarning = {} -- 20 Nov 2015 V1.3 local intWarning = 0 local function putResultSet(oldAddr,oldPlac,ptrAddr,ptrPlac,strPlac,strFull,strWarning) local strPair = oldAddr..","..oldPlac local newAddr = fhGetValueAsText(ptrAddr) if newAddr..","..strFull ~= strPair or strWarning then -- 20 Nov 2015 V1.3 local strBoth = newAddr..","..strPlac..","..strPair if not dicStrBoth[strBoth] or strWarning then -- Update Result Set tables dicStrBoth[strBoth] = true table.insert(arrOldAddr,oldAddr) table.insert(arrOldPlac,oldPlac) table.insert(arrPtrAddr,ptrAddr:Clone()) table.insert(arrPtrPlac,ptrPlac:Clone()) table.insert(arrWarning,strWarning) -- 20 Nov 2015 V1.3 end end if strWarning then intWarning = intWarning + 1 end end -- local function putResultSet local function strColPart(strText,intPart) -- Use TextPart() or split on comma to obtain each Col Part if #strText > 0 then strText = strText:gsub("[%z\01-\32,]-\n",",") -- Replace newline with comma unless preceded by comma strText = strText:gsub("[%z\01-\32]+"," ") -- Replace any multiple white space with one space char if fhGetAppVersion() > 5 then strText = fhCallBuiltInFunction("TextPart",strText,intPart,1,"STD") else if not tblCol[strText] then -- Split new Text on comma into Col Part array local arrCol = { } (strText..","):gsub(" ?(.-) ?,", function(strCol) arrCol[#arrCol+1] = strCol end) tblCol[strText] = arrCol end strText = tblCol[strText][intPart] or "" -- Retrieve previously split Col Part end end return strText end -- local function strColPart local function strJustify(strField,strRight,strLeft,intMax) -- Justify Address/Place field right/left local strField, strTail = strField:match("(.-)([, ]*)$") -- Remove trailing Col Parts if #strField > 0 then if strRight == "ON" then -- Right justify Col Parts? local intHead = (#strTail/2) - 1 + intMax - IntColsMax strField = string.rep(", ",intHead)..strField -- Prefix leading Col Parts -- V1.1 elseif strLeft == "ON" then -- Left justify Col Parts? strField = strField:gsub("^[, ]+","") -- Remove leading Col Parts end end return strField end -- local function strJustify local function ptrUpdate(strField,ptrField,strTag,ptrFact,strWarn) -- Update Address/Place field local isOK local strWarning if #strField > 0 then if ptrField:IsNull() then ptrField = fhCreateItem(strTag,ptrFact,true) -- Create new field end if ptrField:IsNotNull() then -- Save rearranged field isOK = fhSetValueAsText(ptrField,strField) end elseif ptrField:IsNotNull() then -- Delete empty field if fhHasChildItem(ptrField) then -- 20 Nov 2015 V1.3 strWarn = ( strWarn or " " )..fhGetTag(ptrField).." child item(s) deleted! " end isOK = fhDeleteItem(ptrField) end return ptrField, strWarn end -- local function ptrUpdate local function hasNoLinks(ptrText) -- Has V6+ Place Record no Links? local strText = fhGetValueAsText(ptrText) -- Get place name from TEXT field for intOld = 1, #tblOld do local tblPlac = tblOld[intOld][strText] -- Check each batch if tblPlac then return tblPlac.Lnk == 0 end -- Return true if no links end return true end -- local function hasNoLinks local function doPush(intOld,strPlac) -- Push Old Place entry into next batch table local intNxt = intOld + 1 if not tblOld[intNxt] then -- Create next batch table if necessary tblOld[intNxt] = {} end tblOld[intNxt][strPlac] = tblOld[intOld][strPlac] -- Postpone Old to New cloning until the next batch tblOld[intOld][strPlac] = nil for intPlac, strPlac in ipairs (tblOld[intNxt][strPlac].Nxt) do doPush(intNxt,strPlac) -- Push dependent Place entries into next batch table end end -- local function doPush tblOld[1] = {} if fhGetAppVersion() > 5 then -- Compile table of V6+ Place Record names local tblOld = tblOld[1] local ptrPlace = fhNewItemPtr() ptrPlace:MoveToFirstRecord("_PLAC") while ptrPlace:IsNotNull() do -- Loop through all Place Records local ptrText = fhGetItemPtr(ptrPlace,"~.TEXT") local strText = fhGetValueAsText(ptrText) tblOld[strText] = {} -- Tabulate V6+ Place Record details tblOld[strText].Rec = ptrPlace:Clone() tblOld[strText].Lnk = fhCallBuiltInFunction("LinksTo",ptrPlace) tblOld[strText].New = {} tblOld[strText].Nxt = {} intPlaces = intPlaces + 1 ptrPlace:MoveNext() end end progbar.Setup(iup_gui.DialogueAttributes("Bars")) -- Setup the progress bar attributes if #TblFilter+intPlaces > 1000 then progbar.Start("Re-arranging Column Parts",#TblFilter+intPlaces) -- Optionally start Progress Bar on large Projects end for intType = 0, fhGetRecordTypeCount() do -- Loop through all Record Types to find Place fields -- V1.7 local strType = fhGetRecordTypeTag(intType) if strType == "INDI" then ArrTags["_PLAC"] = true; -- _PLAC only in Emigration/Immigration events -- V1.7 elseif strType == "_PLAC" then ArrTags["TEXT"] = true; -- TEXT only in Place records -- V1.7 else ArrTags["_PLAC"] = false; -- Otherwise exclude them both -- V1.7 ArrTags["TEXT"] = false; end progbar.Message("Arranging "..strType.." Addresses && Places") local ptrPrev = fhNewItemPtr() -- 20 Nov 2015 V1.3 local ptrItem = fhNewItemPtr() ptrItem:MoveToFirstRecord(strType) while ptrItem:IsNotNull() do -- Iterate through all Record items local strTag = fhGetTag(ptrItem) if ArrTags[strTag] then -- Until a new Place field tag found -- V1.7 if strType ~= "_PLAC" or hasNoLinks(ptrItem) then local ptrPlac = ptrItem:Clone() local ptrAddr = fhNewItemPtr() local ptrFact = fhNewItemPtr() ptrFact:MoveToParentItem(ptrPlac) local isAddr = ( strTag == "PLAC" and fhIsFact(ptrFact) ) if isAddr then -- Only for PLAC tag in a Fact ptrAddr = fhGetItemPtr(ptrFact,"~.ADDR") end local oldAddr = fhGetValueAsText(ptrAddr) -- Get Place & Address details local oldPlac = fhGetValueAsText(ptrPlac) local oldPlac = fhGetDisplayText(ptrPlac,"","min") -- V1.7 local newAddr = oldAddr local newPlac = oldPlac local strBoth = oldAddr..","..oldPlac if not TblFilter[strBoth].ProgBar then TblFilter[strBoth].ProgBar = true -- Step progress bar for new Address & Place progbar.Step(1) collectgarbage("step",0) -- V1.7 end if TblFilter[strBoth].Enabled then -- Filter is enabled for the Address & Place local arrPart = {} -- Array of input Col Parts local strPart = "" local tblAddr = {} -- Table of output Address Parts local tblPlac = {} -- Table of output Place Parts local strGsub = "^%[%[(.*)%]%]$" -- Pattern match [[private]] brackets local strTail = "" local strWarn = nil -- 20 Nov 2015 V1.3 newAddr = "" newPlac = "" for intPart = 1, IntColsMax do -- Extract comma separated Col Parts arrPart[intPart] = strColPart(oldAddr,intPart) arrPart[intPart + IntColsMax] = strColPart(oldPlac,intPart) end for intPart = 1, #ArrColPart do -- Map input to output Col Parts strPart = arrPart[TblOption[ArrColPart[intPart]]] or "" if intPart <= IntColsMax then -- Map to output Address Col Parts if #strPart > 0 then tblAddr[strPart] = "" -- Dictionary to delete any Place duplicates end table.insert(tblAddr,strPart) else -- Map to output Place Col Parts if #strPart > 0 then strPart = strPart:gsub(strGsub,"%1") -- Remove any [[private]] brackets from input Address Part tblPlac[strPart] = "" -- Dictionary to delete any Address duplicates if StrHideAdr == "ON" then tblPlac[strPart] = "[["..strPart.."]]" -- Dictionary for [[private]] Address duplicates end end table.insert(tblPlac,strPart) end end for intPart = 1, IntColsMax do -- Concatenate output Col Parts strPart = tblAddr[intPart] if #strPart > 0 then if StrShowAdr == "ON" then strPart = strPart:gsub(strGsub,"%1") -- Remove [[private]] brackets to show Address Part end if StrWipeAdr == "ON" or StrHideAdr == "ON" then strPart = tblPlac[strPart] or strPart -- Delete/Hide duplicate Address Part end end newAddr = newAddr..strPart..", " -- Append new output Address Col Parts strPart = tblPlac[intPart] if #strPart > 0 then if StrWipePlc == "ON" then strPart = tblAddr[strPart] or strPart -- Delete any duplicate Place Part end end newPlac = newPlac..strPart..", " -- Append new output Place Col Parts end newAddr = strJustify(newAddr,StrRghtAdr,StrLeftAdr,intMaxAddr) newPlac = strJustify(newPlac,StrRghtPlc,StrLeftPlc,intMaxPlac) if isAddr then -- Address only exists for PLAC field in Fact if newAddr ~= oldAddr then -- Address field has changed ptrAddr, strWarn = ptrUpdate(newAddr,ptrAddr,"ADDR",ptrFact,strWarn) end end if fhGetAppVersion() == 5 then -- FH Version 5 if newPlac ~= oldPlac then -- Place field has changed ptrPlac, strWarn = ptrUpdate(newPlac,ptrPlac,"PLAC",ptrFact,strWarn) if ptrItem:IsNull() then ptrItem = ptrPrev end -- 20 Nov 2015 V1.3 end end putResultSet(oldAddr,oldPlac,ptrAddr,ptrPlac,newPlac,newPlac,strWarn) end if fhGetAppVersion() > 5 then -- FH Version 6+ Place field, even if no change local keyPlac = newPlac:lower() -- Cope with Place names only differing in case -- V1.8 if keyPlac == "gloucester, england" then zz=0 end local tblMerge = tblNew[keyPlac] -- V1.8 if not tblMerge then -- Create New Place entry for merged Old Places tblMerge = {} tblMerge.Old = {} tblMerge.Num = 0 end if not tblMerge.Old[oldPlac] then -- Create New Place versus Old Place & Merge Number & Data tblMerge.Num = tblMerge.Num + 1 tblMerge.Old[oldPlac] = { Num=tblMerge.Num; Data={ }; New=newPlac; } if tblMerge.Num == 2 then intAlters = intAlters + 1 -- Count number of multiple-merges that need a key end end if ptrPlac:IsNull() and #newPlac > 0 then -- Create new Place field pointer ptrPlac = fhCreateItem("PLAC",ptrFact,true) end table.insert(tblMerge.Old[oldPlac].Data, -- Save the Address & Place field Data { OldAddr=oldAddr; PtrAddr=ptrAddr; PtrPlac=ptrPlac; } ) tblNew[keyPlac] = tblMerge -- V1.8 for intOld = 1, math.min(#tblOld,99) do -- Check 1st, 2nd, 3rd, etc batch, but prevent infinite loop local tblClone = tblOld[intOld][oldPlac] -- Find entry for Old place record if tblClone then if not tblClone.New[keyPlac] then -- Create entry for New place record clone -- V1.8 table.insert(tblClone,keyPlac) -- V1.8 tblClone.New[keyPlac] = #tblClone -- How many New places cloned from one Old place? -- V1.8 if #tblClone == 2 then intAlters = intAlters + 1 -- Count number of multiple-clones that need a key end local tblExist = tblOld[intOld][keyPlac] -- V1.8 if newPlac ~= oldPlac and tblExist then -- New place exists as an Old place preventing update table.insert(tblExist.Nxt,oldPlac) tblOld[intOld][oldPlac] = tblClone -- Push cloning into next batch to avoid interference doPush(intOld,oldPlac) else tblOld[intOld][oldPlac] = tblClone -- Else perform the cloning in current batch end end break end end end end end if progbar.Stop() then break end -- Cancel re-arrangements ptrPrev = ptrItem:Clone() -- !! ptrItem:MoveNextSpecial() -- 20 Nov 2015 V1.3 if fhGetTag(ptrItem) == "SOUR" then local ptrNext = ptrItem:Clone() ptrNext:MoveToFirstChildItem(ptrNext) -- Temporary fix for MoveNextSpecial bug -- V1.7 if ptrNext:IsNotNull() then ptrItem = ptrNext:Clone() else ptrItem:MoveNextSpecial() end else ptrItem:MoveNextSpecial() end end if progbar.Stop() then break end -- Cancel re-arrangements end if fhGetAppVersion() > 5 and not progbar.Stop() then -- Update V6+ Place Records local function setPlaceName(ptrTag,strNew) -- Update Place Record TEXT Tag name local strOld = fhGetValueAsText(ptrTag) if strOld ~= strNew then if not fhSetValueAsText(ptrTag,strNew) then local strTag = fhGetTag(ptrTag) fhMessageBox("Failed to change Place ("..strTag..") name\n from: "..strOld.."\n into: "..strNew) end end end -- local function setPlaceName local arrKey = { "@" } -- Array of Merge/Clone Key Prefix letters local function strPrefix() -- Obtain next Merge/Clone Key Prefix for intKey = #arrKey, 1, -1 do local strKey = arrKey[intKey] or "@" if strKey == "Z" then arrKey[intKey] = "A" else arrKey[intKey] = string.char(string.byte(strKey) + 1) break end end return table.concat(arrKey) end -- local function strPrefix local function strMergeKey(tblMerge,strPlac) -- Create Merge Key if tblMerge and tblMerge.Num > 1 then local intNum = 0 if tblMerge.Old[strPlac] then intNum = tblMerge.Old[strPlac].Num -- Retrieve current Merge Number end local intMax = tblMerge.Num or 1 -- Retrieve largest Merge Number if not tblMerge.Pre then tblMerge.Pre = strPrefix() -- Create next letter prefix end return ("{"..tblMerge.Pre.."%"..#tostring(intMax).."d}"):format(intNum) else return "" end end -- local function strMergeKey local function strCloneKey(strPre,tblClone,strPlac) -- Create Clone Key local intNum = tblClone.New[strPlac] or 0 return ("{"..strPre.."%"..#tostring(#tblClone).."d}"):format(intNum) end -- local function strCloneKey local function strPlace(strPre,tblOld,newPlac,strPlac,tblMerge,oldPlac) return strCloneKey(strPre,tblOld,newPlac)..strPlac..strMergeKey(tblMerge,oldPlac) end -- local function strPlace while intAlters > 26 do -- Initialise Merge/Clone Key Prefix table.insert(arrKey,1,"A") intAlters = intAlters / 26 end for intOld, tblOld in ipairs (tblOld) do -- Loop on 1st, 2nd, 3rd, etc batch progbar.Message("Updating the Place Records") for oldPlac, tblOld in pairs (tblOld) do -- Loop through old Place Records local ptrOld = tblOld.Rec:Clone() local ptrText = fhGetItemPtr(ptrOld,"~.TEXT") -- Get TEXT field pointer for record local keyPlac = tblOld[1] or oldPlac -- V1.8 local tblEdit = tblNew[keyPlac] -- Does a New for Old entry exist? -- V1.8 if tblEdit then local tblData = tblEdit.Old[oldPlac].Data[1] -- Retrieve the associated data local ptrPlac = tblData.PtrPlac:Clone() local ptrAddr = tblData.PtrAddr:Clone() local oldAddr = tblData.OldAddr local newAddr = fhGetValueAsText(ptrAddr) local strKey = "" if #tblOld == 1 then -- 1:1 Place name change... local newPlac = tblEdit.Old[oldPlac].New or keyPlac -- V1.8 local strPlac = newPlac..strMergeKey(tblEdit,oldPlac) -- Add suffix to differentiate merge duplicates if strPlac == "" then -- Delete solitary Place record local isOK = fhDeleteItem(ptrOld) else setPlaceName(ptrText,strPlac) -- Change record Place name end putResultSet(oldAddr,oldPlac,ptrAddr,ptrText,newPlac,strPlac) else -- 1:N Place name change... local strPre = strPrefix() -- Add prefix for clone duplicates & suffix for merge duplicates local strRoot = strPlace(strPre,tblOld,0,oldPlac,tblNew[oldPlac],oldPlac) setPlaceName(ptrText,strRoot) putResultSet(oldAddr,oldPlac,fhNewItemPtr(),ptrText,strRoot,strRoot) for intPlac, keyPlac in ipairs (tblOld) do -- V1.8 local ptrNew = fhCreateItem("_PLAC") -- Clone details from original to new record if CopyChildren(ptrOld,ptrNew) <= 1 then -- Give empty record non-empty Note, else it auto-deletes local isOK = fhSetValueAsText(fhCreateItem("NOTE2",ptrOld,true)," ") end local tblMerge = tblNew[keyPlac] -- Add prefix for clone duplicates & suffix for merge duplicates -- V1.8 local newPlac = tblMerge.Old[oldPlac].New or keyPlac -- V1.8 local strPlac = strPlace(strPre,tblOld,keyPlac,newPlac,tblMerge,oldPlac) -- V1.8 setPlaceName(fhCreateItem("TEXT",ptrNew,true),strPlac) for intData, tblData in ipairs (tblMerge.Old[oldPlac].Data) do local ptrPlac = tblData.PtrPlac:Clone() -- Update all Place field clones local ptrAddr = tblData.PtrAddr:Clone() local newAddr = fhGetValueAsText(ptrAddr) setPlaceName(ptrPlac,strPlac) putResultSet(tblData.OldAddr,oldPlac,ptrAddr,ptrPlac,newPlac,strPlac) end end end end progbar.Step(1) if progbar.Stop() then break end -- Cancel re-arrangements end end end if #arrOldAddr > 0 then progbar.Message("Preparing Result Set") fhSleep(500,100) progbar.Message("Preparing Result Set") fhSleep(500,100) fhOutputResultSetTitles("Rearrange Address and Place Parts Summary") fhOutputResultSetColumn("Input Address" ,"text",arrOldAddr,#arrOldAddr,140,"align_left",5) fhOutputResultSetColumn("Input Place" ,"text",arrOldPlac,#arrOldAddr,140,"align_left",4) fhOutputResultSetColumn("Output Address","item",arrPtrAddr,#arrOldAddr,140,"align_left",3) fhOutputResultSetColumn("Output Place" ,"item",arrPtrPlac,#arrOldAddr,140,"align_left",2) fhOutputResultSetColumn("Error Warning" ,"text",arrWarning,#arrOldAddr,140,"align_left",1,false) if intWarning > 0 then fhMessageBox("\n One or more Address/Place sub-fields were deleted. \n\n Check the Result Set Error Warning messages. \n") end else fhMessageBox("\n No Address or Place changes made. \n") end progbar.Close() end -- function DoRearrangeParts function GUI_MainDialogue() local function strColTip(strColPart) return "Input column part"..( ArrColPart[TblOption[strColPart]] or " " ) end -- local function strColTip local strHKLMKey = "HKLM\\SOFTWARE\\Calico Pie\\Family Historian\\2.0\\Preferences\\" local intMaxAddr = iup_gui.GetRegKey(strHKLMKey.."Atom List Addr Cols") -- Tools > Work with Data > Address Columns -- V1.6 local intMaxPlac = iup_gui.GetRegKey(strHKLMKey.."Atom List Place Cols") -- Tools > Work with Data > Place Columns -- V1.6 local strMaxAddr = string.format("%d",intMaxAddr) -- V1.7 local strMaxPlac = string.format("%d",intMaxPlac) -- V1.7 -- Create each GUI label and button with title and tooltip, etc local lblSources = iup.label { Title="Input Column Part" ; Alignment="ACENTER"; } local lblTargets = iup.label { Title="Output Column Part"; Alignment="ACENTER"; } local vbxColHead = iup.vbox { iup.hbox { Homogeneous="YES"; lblSources; lblTargets; } } local vbxColAddr = iup.vbox { Margin="0x0"; Gap="0"; } local vbxColPlac = iup.vbox { Margin="0x0"; Gap="0"; } local lstColPart = { } local lblColPart = { } local hbxColPart = { } local tblControls = {} -- Must be before doSetFont(), which must be before btnSetFont.action local function setColPartColour(intColPart) -- V1.5 Set Output Column Part colour local strColour = "Warn" -- Warn if not default setting if tonumber(lstColPart[intColPart].Value) == intColPart then strColour = "Body" end lblColPart[intColPart].FgColor = iup_gui[strColour] tblControls[lblColPart[intColPart]][3] = strColour return strColour end -- local function setColPartColour for intColPart, strColPart in ipairs (ArrColPart) do -- Build the Input & Output Address & Place column parts lstColPart[intColPart] = iup.list { Value=TblOption[strColPart]; DropDown="YES"; Visible_Items="25"; action=function(self,strText,intItem,intState) TblOption[strColPart] = intItem setColPartColour(intColPart) -- V1.5 Set Output Column Part colour self.Tip=strColTip(strColPart) end } lblColPart[intColPart] = iup.button{ Title=strColPart; CanFocus="NO"; Padding="0x1"; } hbxColPart[intColPart] = iup.hbox { Homogeneous="YES"; lstColPart[intColPart]; lblColPart[intColPart]; } for intColItem, strColItem in ipairs (ArrColPart) do lstColPart[intColPart][intColItem] = strColItem end lstColPart[intColPart][#ArrColPart+1] = " " if strColPart:match("Address") then iup.Append(vbxColAddr,hbxColPart[intColPart]) else iup.Append(vbxColPlac,hbxColPart[intColPart]) end end local vbxColPart = iup.vbox { vbxColHead, vbxColAddr, vbxColPlac } local lblOptions = iup.label { Title="Select Rearrangement Options"; Alignment="ACENTER"; } local btnPlc2Adr = iup.button{ Title="Copy all Place parts to all Address parts"; } local btnKillAdr = iup.button{ Title="Delete all Address column parts entirely"; } local btnRghtAdr = iup.button{ Title=" Shift Addresses right "; } local btnLeftAdr = iup.button{ Title=" Shift Addresses left "; } local txtFrstAdr = iup.text { Spin="YES"; SpinMin=1; SpinMax=IntColsMax; SpinAlign="RIGHT"; Border="YES"; Size="30"; SpinValue=1; } local txtLastAdr = iup.text { Spin="YES"; SpinMin=1; SpinMax=IntColsMax; SpinAlign="RIGHT"; Border="YES"; Size="30"; SpinValue=IntColsMax; } local tglHideAdr = iup.toggle{ Title="Add [[privacy]] to duplicated Address parts"; Value="OFF"; } local tglShowAdr = iup.toggle{ Title="Delete [[privacy]] to show all Address parts"; Value="OFF"; } local tglWipeAdr = iup.toggle{ Title="Erase Address parts duplicating Place parts"; Value="OFF"; } local tglRghtAdr = iup.toggle{ Title="Right justify Address parts to Address "..strMaxAddr; Value="OFF"; } -- V1.7 local tglLeftAdr = iup.toggle{ Title="Left justify Address parts to Address 1"; Value="OFF"; } local btnAdr2Plc = iup.button{ Title="Copy all Address parts to all Place parts"; } local btnKillPlc = iup.button{ Title="Delete all Place column parts entirely"; } local btnRghtPlc = iup.button{ Title=" Shift all Places right "; } local btnLeftPlc = iup.button{ Title=" Shift all Places left "; } local txtFrstPlc = iup.text { Spin="YES"; SpinMin=1; SpinMax=IntColsMax; SpinAlign="RIGHT"; Border="YES"; Size="30"; SpinValue=1; } local txtLastPlc = iup.text { Spin="YES"; SpinMin=1; SpinMax=IntColsMax; SpinAlign="RIGHT"; Border="YES"; Size="30"; SpinValue=IntColsMax; } local tglWipePlc = iup.toggle{ Title="Erase Place parts duplicating Address parts"; Value="OFF"; } local tglRghtPlc = iup.toggle{ Title="Right justify all Place parts to Place "..strMaxPlac; Value="OFF"; } -- V1.7 local tglLeftPlc = iup.toggle{ Title="Left justify all Place parts to Place 1"; Value="OFF"; } local btnDefault = iup.button{ Title="RESTORE PLUGIN DEFAULT SETTINGS"; } local btnPerform = iup.button{ Title="PERFORM REARRANGEMENT of Parts"; } local lblFilter = iup.label { Title="Address and Place Entries"; Alignment="ACENTER"; } local lstFilter = iup.list { Value=""; VisibleLines=9; VisibleColumns=9; Multiple="YES"; } local btnSetAll = iup.button{ Title="Select All"; } local btnSortBy = iup.button{ Title="Sort by "..DicSortBy[StrSortBy]; } -- V1.5 local btnSetNil = iup.button{ Title="Select None"; } local btnSetFont = iup.button{ Title="Set Window Fonts"; } local btnGetHelp = iup.button{ Title="Help and Advice"; } local btnDestroy = iup.button{ Title="Cancel Plugin"; } local arrBtnAddr = {} local arrBtnPlac = {} local iupBtnHbox = iup.hbox { Homogeneous="NO"; Margin="1x0"; Gap="1"; } for intPart = 1, intMaxAddr do -- Build the Address Part buttons -- V1.6 arrBtnAddr[intPart] = iup.button { Title="A"..intPart; Size="12"; Tip="Sort by column part Address "..intPart; } iup.Append(iupBtnHbox,arrBtnAddr[intPart]) end for intPart = 1, intMaxPlac do -- Build the Place Part buttons -- V1.6 arrBtnPlac[intPart] = iup.button { Title="P"..intPart; Size="12"; Tip="Sort by column part Place "..intPart; } iup.Append(iupBtnHbox,arrBtnPlac[intPart]) end local vbxOptions = iup.vbox { iup.vbox { iup.hbox { lblOptions }; }; iup.vbox { Homogeneous="YES"; btnPlc2Adr; btnKillAdr; iup.hbox { Homogeneous="YES"; btnRghtAdr; iup.hbox { Homogeneous="YES"; iup.label { Title="between "; Expand="YES"; Alignment="ARIGHT:ACENTER"; }; txtFrstAdr; }; }; iup.hbox { Homogeneous="YES"; btnLeftAdr; iup.hbox { Homogeneous="YES"; iup.label { Title=" and "; Expand="YES"; Alignment="ARIGHT:ATOP"; }; txtLastAdr; }; }; tglHideAdr; tglShowAdr; tglWipeAdr; tglRghtAdr; tglLeftAdr; }; iup.vbox { Homogeneous="YES"; btnAdr2Plc; btnKillPlc; iup.hbox { Homogeneous="YES"; btnRghtPlc; iup.hbox { Homogeneous="YES"; iup.label { Title="between "; Expand="YES"; Alignment="ARIGHT:ACENTER"; }; txtFrstPlc; }; }; iup.hbox { Homogeneous="YES"; btnLeftPlc; iup.hbox { Homogeneous="YES"; iup.label { Title=" and "; Expand="YES"; Alignment="ARIGHT:ATOP"; }; txtLastPlc; }; }; tglWipePlc; tglRghtPlc; tglLeftPlc; btnDefault; btnPerform; }; } -- Create the Option tab layout local vboxOption = iup.vbox { Alignment="ARIGHT"; iup.hbox { Homogeneous="YES"; vbxColPart; vbxOptions; }; } -- Create the Filter tab layout local vboxFilter = iup.vbox { Alignment="ARIGHT"; iup.vbox { lblFilter; -- ? ? iupBtnHbox; -- V1.6 -- Postponed lstFilter; iup.hbox { Homogeneous="YES"; Margin="30x0"; Gap="30"; btnSetAll; btnSortBy; btnSetNil; }; -- V1.5 }; } -- Create the Tab controls layout local tabControl = iup.tabs { -- Padding="1x1"; vboxOption; TabTitle0=" Mapping Options "; vboxFilter; TabTitle1=" Input Filter "; } -- Combine all the above controls local allControl = iup.vbox { Alignment="ARIGHT"; tabControl; iup.hbox { Homogeneous="YES"; btnSetFont; btnGetHelp; btnDestroy; }; } local dialogMain = iup.dialog { Title=iup_gui.Plugin..iup_gui.Version; Margin=iup_gui.Margin; Gap=iup_gui.Gap; allControl; } local strBackground = "" local function setControlsActive(strYorN) -- Enable/Disable controls during busy actions -- V1.8 -- strYorN ~ "YES" or "NO" local strBackColour = iup_gui.Silver if strYorN == "NO" then strBackground = dialogMain.Background else strBackColour = strBackground end dialogMain.Active = strYorN dialogMain.Background = strBackColour iup.Redraw(dialogMain,1) end -- local function setControlsActive local function setControls() -- Reset GUI control values for intColPart, strColPart in ipairs (ArrColPart) do lstColPart[intColPart].Value = TblOption[strColPart] lstColPart[intColPart].Tip = strColTip(strColPart) setColPartColour(intColPart) -- V1.5 Set Output Column Part colour end tglHideAdr.Value = StrHideAdr tglShowAdr.Value = StrShowAdr tglWipeAdr.Value = StrWipeAdr tglRghtAdr.Value = StrRghtAdr tglLeftAdr.Value = StrLeftAdr tglWipePlc.Value = StrWipePlc tglRghtPlc.Value = StrRghtPlc tglLeftPlc.Value = StrLeftPlc end -- local function setControls local function putControls() -- Preserve GUI Toggle values StrHideAdr = tglHideAdr.Value StrShowAdr = tglShowAdr.Value StrWipeAdr = tglWipeAdr.Value StrRghtAdr = tglRghtAdr.Value StrLeftAdr = tglLeftAdr.Value StrWipePlc = tglWipePlc.Value StrRghtPlc = tglRghtPlc.Value StrLeftPlc = tglLeftPlc.Value SaveSettings() -- Save sticky data settings end -- local function putControls local function doCopyParts(intSource,intTarget) -- Handle copy from Place/Addr to Addr/Place buttons putControls() for intColPart = 1, IntColsMax do local strColPart = ArrColPart[intColPart + intTarget] TblOption[strColPart] = intColPart + intSource -- Assign source parts to target parts end setControls() end -- local function doCopyParts local function doKillParts(intTarget) -- Handle delete all Addr/Place column parts buttons putControls() for intColPart = 1, IntColsMax do local strColPart = ArrColPart[intColPart + intTarget] TblOption[strColPart] = #ArrColPart+1 -- Assign to all target parts end setControls() end -- local function doKillParts local function doMoveParts(intHead,intTail,intMove) -- Handle shift Addr/Place parts Left/Right buttons putControls() intHead = tonumber(intHead) intTail = tonumber(intTail) for intColPart = intHead, intTail, intMove do local intNewPart = TblOption[ArrColPart[intColPart+intMove]] -- Shift to next column if intColPart == intTail then intNewPart = #ArrColPart+1 end -- Shift in TblOption[ArrColPart[intColPart]] = intNewPart end setControls() end -- local function doMoveParts function txtFrstAdr:spin_cb(intValue) -- Handle Address Spin limits txtLastAdr.SpinMin = intValue end -- function txtFrstAdr:spin_cb function txtLastAdr:spin_cb(intValue) txtFrstAdr.SpinMax = intValue end -- function txtLastAdr:spin_cb function txtFrstPlc:spin_cb(intValue) -- Handle Place Spin limits txtLastPlc.SpinMin = intValue end -- function txtFrstPlc:spin_cb function txtLastPlc:spin_cb(intValue) txtFrstPlc.SpinMax = intValue end -- function txtLastPlc:spin_cb function lstFilter:button_cb(intButton,intMode,intX,intY,strState) -- Mouse button in Filter List -- V1.6 IntLines = lstFilter.Size:match("x(%d+)$") IntLines = math.floor( tonumber(IntLines) / 16 ) -- Half number of visible lines in Filter List IntFocus = iup.ConvertXYToPos(lstFilter,intX,intY) -- Focus on chosen entry end -- function lstFilter:button_cb local function setTopItem() -- Set TopItem in Filter List -- V1.6 lstFilter.TopItem = math.max( 1, IntFocus-IntLines ) end -- local function setTopItem local function doPerform() -- Handle Perform Rearrangement button -- V1.7 putControls() local strFilter = lstFilter.Value -- Fix large project memory leak by moving lstFilter.Value outside for loop -- V1.7 for intEntry, tblEntry in ipairs ( TblFilter ) do -- Assign filter selector to each Address & Place local strValue = strFilter:sub(intEntry,intEntry) local strIndex = tblEntry.Addr..","..tblEntry.Plac TblFilter[strIndex] = {} TblFilter[strIndex].Enabled = ( strValue == "+" ) end DoRearrangeParts(intMaxAddr,intMaxPlac) end -- local function doPerform local function setButton(isMatch,btnName) -- Used only by setButtons() below if isMatch then btnName.Active = "YES" else btnName.Active = "NO" end end -- local function setButton local function setButtons() -- Set Filter tab buttons active or not local strMove = lstFilter.Value setButton(strMove:match("%-"),btnSetAll) -- Need some unselected to enable Select All setButton(strMove:match("%+"),btnSetNil) -- Need some selected to enable Select None end -- local function setButtons local function doSelect(strChar) -- Select Some, All, or None of List entries for btnSetAll, btnSetNil & doSortByMode if strChar == "" then strChar = "+" if fhGetAppVersion() > 5 then -- If "" and FH V6 then select Some from Place records -- V1.4 local arrFilt = {} local dicPlac = {} local arrPlac = fhGetCurrentRecordSel("_PLAC") if #arrPlac > 0 then for intPlac = 1, #arrPlac do local strPlac = fhGetDisplayText(arrPlac[intPlac]) dicPlac[strPlac] = true end for intEntry = 1, lstFilter.Count do if dicPlac[TblFilter[intEntry].Plac] then table.insert(arrFilt,"+") if IntFocus < 0 then IntFocus = intEntry end -- Set first selection as Focus -- V1.6 else table.insert(arrFilt,"-") end end lstFilter.Value = table.concat(arrFilt) setTopItem() -- V1.6 setButtons() return end end end if #strChar == 1 then strChar = string.rep(strChar,lstFilter.Count) -- Set All or None if "+" or "-" -- V1.5 end lstFilter.AutoRedraw = "NO" --= lstFilter.Visible = "NO" lstFilter.Value = strChar -- May set Some from doSortByMode -- V1.5 --= lstFilter.Visible = "YES" lstFilter.AutoRedraw = "YES" setTopItem() -- V1.6 setButtons() end -- local function doSelect local function getEntry(strName,intMax) -- Adjust Name & Format Size for Entry local intSize = strName:length() -- Name length in characters strName = strName:gsub("[%z\1-\31]"," ") -- Replace control chars with space chars for tidy format -- V1.1 if string.encoding() == "UTF-8" then while intSize > intMax do -- Remove trailing UTF-8 chars beyond intMax'th intSize = intSize - 1 strName = strName:gsub("[%z\1-\127\194-\244][\128-\191]*$","") end end return strName,( intMax + strName:len() - intSize ) -- Format size adjusted for UTF-8 chars end -- local function getEntry local intMax = 95 local function strFormatFilter(tblEntry) -- Format Address & Place pair if not tblEntry then return " " end local isOK = false while not isOK do local strAddr,intAddr = getEntry(tblEntry.Addr,50) local strPlac,intPlac = getEntry(tblEntry.Plac,intMax) local strFormat = ("%-{A}.{A}s %-.{B}s"):gsub("{A}",intAddr):gsub("{B}",intPlac) local isOK, strFormat = pcall(string.format,strFormat,strAddr,strPlac) if isOK then return strFormat end intMax = intMax - 5 -- Sometimes intMax=95 is too big end end -- local function strFormatFilter --[=[ Postponed local minSize = 3 local intSlim = 0 local function strFormatFilter(tblEntry) -- Format Address & Place parts -- V1.6 if not tblEntry then return " " end local dicSize = TblFilter[0] local isOK = false while not isOK do local arrPart = {} local strForm = "" for intPart = 1, intMaxAddr do local strAddr,intAddr = getEntry(tblEntry["A"..intPart],dicSize["A"..intPart]) table.insert(arrPart,strAddr) intAddr = math.max( minSize, intAddr-intSlim ) --? strForm = strForm .. ("%-{A}.{A}s "):gsub("{A}",intAddr) strForm = strForm .. ("%-{A}.{A}s"):gsub("{A}",intAddr) end for intPart = 1, intMaxPlac do local strPlac,intPlac = getEntry(tblEntry["P"..intPart],dicSize["P"..intPart]) table.insert(arrPart,strPlac) intPlac = math.max( minSize, intPlac-intSlim ) --? strForm = strForm .. ("%-{P}.{P}s "):gsub("{P}",intPlac) strForm = strForm .. ("%-{P}.{P}s"):gsub("{P}",intPlac) end local isOK, strFormat = pcall(string.format,strForm,unpack(arrPart)) if isOK then return strFormat end -- Escape of isOK is true intSlim = intSlim + 1 -- Reduce all columns progressively end end -- local function strFormatFilter --]=] local function doDisplayFilter() -- Display Address & Place Filter table --# lstFilter.Font = iup_gui.FontBody:gsub(".-, ","Lucida Console, ")-- Monospaced font "Consolas, " or "Lucida Console, " or "Lucida Sans Typewriter, " or "DejaVu Sans Mono, " lstFilter.AutoRedraw = "NO" lstFilter.Visible = "NO" lstFilter[1] = iup.NULL -- Empty list needed for large Projects -- V1.8 for intEntry, tblEntry in ipairs ( TblFilter ) do lstFilter[intEntry] = strFormatFilter(tblEntry) if intEntry % 3000 == 0 then --= collectgarbage("step",0) -- V1.8 --= collectgarbage("collect") fhSleep(10,8) end end lstFilter.Visible = "YES" lstFilter.AutoRedraw = "YES" end -- local function doDisplayFilter local strKey = "Plac" local function isLessThan(tblA,tblB) -- Compare Filter table entries -- V1.6 local strSort = strKey while tblA[strSort] == tblB[strSort] do strSort = DicSortBy[strSort] if strSort == strKey then break end end return tblA[strSort] < tblB[strSort] end -- local function isLessThan local function doSortByMode(strPart) -- Set the Sort By Keys and Title and perform sort -- V1.5 if strPart then strKey = strPart else strKey = StrSortBy:sub(1,4) btnSortBy.Title = "Sort by "..DicSortBy[StrSortBy] end local strValue = lstFilter.Value for intEntry = 1, #TblFilter do TblFilter[intEntry].Value = strValue:sub(intEntry,intEntry) -- Save Filter selection values end if IntFocus > 0 then TblFilter[IntFocus].Focus = true -- Save Filter focus entry -- V1.6 end table.sort(TblFilter,isLessThan) -- Sort Filter entries strValue = "" for intEntry = 1, #TblFilter do strValue = strValue..TblFilter[intEntry].Value -- Restore Filter selection values if TblFilter[intEntry].Focus then TblFilter[intEntry].Focus = nil IntFocus = intEntry -- Restore Filter focus entry -- V1.6 end end doDisplayFilter() -- Display and select Filter values doSelect(strValue) -- V1.4 -- V1.5 end -- local function doSortByMode local function doSwapSortBy() -- Toggle between Sort By Address and Sort By Place -- V1.5 StrSortBy = DicSortBy[StrSortBy] TblOption.SortBy = StrSortBy doSortByMode() end -- local function doSwapSortBy local function iupWidth(strIupSize) -- Get integer width of IUp Size field -- V1.6 return tonumber( strIupSize:match("^(%d+)x") ) end -- local function iupWidth local function setAddrPlaceSizes() -- Set the Address & Place part sizes -- V1.6 local dicSize = {} for strPart, intPart in pairs (TblFilter[-1]) do dicSize[strPart] = intPart end local intWidth = dicSize.Width -- Finding a suitable character size width attribute is proving difficult ????????? local intSize = math.floor( iupWidth(lstFilter.NaturalSize) * 100 ) local intSize = ( math.floor( iupWidth(lstFilter.Size) * 2 ) * 100) local intSize = math.floor( iupWidth(dialogMain.Size) * 100 ) -- local intNatSize = lstFilter.NaturalSize -- local intSize = lstFilter.Size local intFont = iupWidth(lstFilter.charsize) local intChars = math.floor(intSize/intFont) local intCent = math.min(100,intChars/intWidth) -- Precentage reduction to fit current dialogue print("setAddrPlaceSizes",intChars,intWidth,intCent) --# local intCent = math.min(100,intSize/intWidth) -- Precentage reduction to fit current dialogue --# local intCent = math.min(100,15000/intWidth) -- Precentage reduction to fit 150 characters for intPart = 1, 10 do if intPart <= intMaxAddr then -- Adjust the Address part sizes -- V1.6 local intAddr = dicSize["A"..intPart] if intAddr > minSize then intAddr = math.min(intAddr,math.ceil(intAddr * intCent / 100)) elseif intPart == 10 then intAddr = minSize + 1 -- Cater for A10 wider label end dicSize["A"..intPart] = intAddr arrBtnAddr[intPart].Size = tostring(intAddr * 4) arrBtnAddr[intPart].action = function(self) doSortByMode(self.Title) end DicSortBy["A"..intPart] = "A"..(intPart+1) end if intPart <= intMaxPlac then -- Adjust the Place part sizes -- V1.6 local intPlac = dicSize["P"..intPart] if intPlac > minSize then intPlac = math.min(intPlac,math.ceil(intPlac * intCent / 100)) elseif intPart == 10 then intPlac = minSize + 1 -- Cater for P10 wider label end dicSize["P"..intPart] = intPlac arrBtnPlac[intPart].Size = tostring(intPlac * 4) arrBtnPlac[intPart].action = function(self) doSortByMode(self.Title) end DicSortBy["P"..intPart] = "P"..(intPart+1) end end DicSortBy[string.format("A%d",intMaxAddr)] = "P1" -- Set the sequence for sort keys -- V1.6 DicSortBy[string.format("P%d",intMaxPlac)] = "A1" TblFilter[0] = dicSize doDisplayFilter() -- Display and select Filter values end -- local function setAddrPlaceSizes local function getAddrPlacePairs() -- Get Address & Place Filter table entries local intRecs = 0 for intType, strType in ipairs (TblTags) do -- Loop through record types -- V1.7 local ptrItem = fhNewItemPtr() ptrItem:MoveToFirstRecord(strType) while ptrItem:IsNotNull() do -- Count all Records -- V1.7 intRecs = intRecs + 1 ptrItem:MoveNext() end end progbar.Setup() -- Setup the progress bar attributes if intRecs > 5000 then progbar.Start("Identifying Column Parts",intRecs) -- Optionally start Progress Bar on large Projects end for intType, strType in ipairs (TblTags) do -- Loop through record types progbar.Message("Collating "..strType.." Addresses && Places") local ptrItem = fhNewItemPtr() ptrItem:MoveToFirstRecord(strType) while ptrItem:IsNotNull() do -- Iterate through all Record items if not fhHasParentItem(ptrItem) then if progbar.Stop() then return false end -- Cancel collation -- V1.7 progbar.Step(1) end local strTag = fhGetTag(ptrItem) if TblTags[strType][strTag] then -- Until a Place name tag found (PLAC, _PLAC, TEXT) -- V1.7 local oldPlac = fhGetValueAsText(ptrItem) local oldAddr = "" if strTag == "PLAC" then -- Only PLAC tags in Facts have an Address -- V1.7 local ptrFact = fhNewItemPtr() ptrFact:MoveToParentItem(ptrItem) if fhIsFact(ptrFact) then oldAddr = fhGetValueAsText(fhGetItemPtr(ptrFact,"~.ADDR")) end end local strBoth = oldAddr..","..oldPlac -- Combine Address & Place details if not TblFilter[strBoth] then -- Update Filter table table.insert(TblFilter,{ Addr=oldAddr; Plac=oldPlac; }) local intFilter = #TblFilter TblFilter[strBoth] = intFilter end end -- !! ptrItem:MoveNextSpecial() if fhGetTag(ptrItem) == "SOUR" then local ptrNext = ptrItem:Clone() ptrNext:MoveToFirstChildItem(ptrNext) -- Temporary fix for MoveNextSpecial bug -- V1.7 if ptrNext:IsNotNull() then ptrItem = ptrNext:Clone() else ptrItem:MoveNextSpecial() end else ptrItem:MoveNextSpecial() end end end progbar.Step(1) doSortByMode() -- Update the Filter sort mode -- V1.5 progbar.Step(1) collectgarbage("collect") -- V1.7 progbar.Close() if tonumber(lstFilter.Count) > 9999 then fhMessageBox("\n For very large projects with 10,000+ Address & Place items \n the Input Filter tab selection feature is not available \nso select Place Records in the Records Window beforehand. \n") lstFilter.Active = "NO" -- V1.8 end return true end -- local function getAddrPlacePairs --[=[ Postponed -- Needs updating from above !!!!!!!!!!!!!!!! local function getAddrPlacePairs() -- Get Address & Place Filter table entries local dicSize = { } for intPart = 1, 10 do -- Preset the Address & Place part sizes -- V1.6 dicSize["A"..intPart] = minSize dicSize["P"..intPart] = minSize end local tblPlace = { } for _, strType in ipairs ({ "INDI"; "FAM"; }) do -- Loop through record types that have Place fields with Address fields -- V1.7 local ptrItem = fhNewItemPtr() ptrItem:MoveToFirstRecord(strType) while ptrItem:IsNotNull() do -- Iterate through all Record items local strTag = fhGetTag(ptrItem) if strTag == "PLAC" then local oldPlac = fhGetValueAsText(ptrItem) -- Until a Place name tag found --? if strTag ~= "TEXT" or not tblPlace[oldPlac] then -- Include Place Record names only if not already found -- V1.7 omit tblPlace[oldPlac] = true local oldAddr = "" local ptrFact = fhNewItemPtr() ptrFact:MoveToParentItem(ptrItem) if strTag == "PLAC" and fhIsFact(ptrFact) then -- Only PLAC tags in Facts have an Address oldAddr = fhGetValueAsText(fhGetItemPtr(ptrFact,"~.ADDR")) end local strBoth = oldAddr..","..oldPlac -- Combine Address & Place details if not TblFilter[strBoth] then -- Update Filter table with Address & Place parts -- V1.6 local dicPart = { Addr=oldAddr; Plac=oldPlac; } local strPart = "" local arrAddr = {} local arrPlac = {} oldAddr = "," .. oldAddr -- string.split() cannot be used as consecutive commas get merged oldPlac = "," .. oldPlac oldAddr:gsub(",([^,]*)", function(strAddr) arrAddr[#arrAddr+1] = strAddr end) oldPlac:gsub(",([^,]*)", function(strPlac) arrPlac[#arrPlac+1] = strPlac end) for intPart = 1, 99 do if intPart <= intMaxAddr then strPart = "A"..intPart dicPart[strPart] = arrAddr[intPart] or "" elseif #arrAddr >= intPart then strPart = "A"..strMaxAddr -- V1.7 dicPart[strPart] = dicPart[strPart]..","..arrAddr[intPart] elseif #arrPlac < intMaxPlac and intPart > intMaxPlac then break end dicSize[strPart] = math.max(dicSize[strPart],#dicPart[strPart]) if intPart <= intMaxPlac then strPart = "P"..intPart dicPart[strPart] = arrPlac[intPart] or "" elseif #arrPlac >= intPart then strPart = "P"..strMaxPlac -- V1.7 dicPart[strPart] = dicPart[strPart]..","..arrPlac[intPart] elseif #arrAddr < intMaxAddr and intPart > intMaxAddr then break end dicSize[strPart] = math.max(dicSize[strPart],#dicPart[strPart]) end table.insert(TblFilter,dicPart) TblFilter[strBoth] = #TblFilter end end end -- !! ptrItem:MoveNextSpecial() if fhGetTag(ptrItem) == "SOUR" then local ptrNext = ptrItem:Clone() ptrNext:MoveToFirstChildItem(ptrNext) -- Temporary fix for MoveNextSpecial bug -- V1.7 if ptrNext:IsNotNull() then ptrItem = ptrNext:Clone() else ptrItem:MoveNextSpecial() end else ptrItem:MoveNextSpecial() end end end local intWidth = 0 for intPart = 1, 10 do -- Find total width of Address and Place parts -- V1.6 if intPart <= intMaxAddr then intWidth = intWidth + dicSize["A"..intPart] end if intPart <= intMaxPlac then intWidth = intWidth + dicSize["P"..intPart] end end dicSize.Width = intWidth TblFilter[-1] = dicSize setAddrPlaceSizes() doSortByMode() -- Update the Filter sort mode -- V1.5 end -- local function getAddrPlacePairs --]=] local function doDefault() -- Handle the Restore Defaults button ResetDefaultSettings() setControls() -- Reset controls & redisplay Main dialogue --= doSortByMode() -- Update the Filter sort mode -- V1.5 txtFrstAdr.SpinValue=1 txtFrstAdr.SpinMax=IntColsMax txtLastAdr.SpinMin=1 txtLastAdr.SpinValue=IntColsMax txtFrstPlc.SpinValue=1 txtFrstPlc.SpinMax=IntColsMax txtLastPlc.SpinMin=1 txtLastPlc.SpinValue=IntColsMax iup_gui.ShowDialogue("Main") SaveSettings() -- Save sticky data settings end -- local function doDefault local function strMono() return iup_gui.FontBody:gsub(".-, ","Lucida Console, ") -- Monospaced font "Consolas, " or "Lucida Console, " or "Lucida Sans Typewriter, " or "DejaVu Sans Mono, " -- V1.6 end -- local function strMono local function doSetFont() -- Handle the Set Window Font button btnSetFont.Active = "NO" putControls() iup_gui.FontDialogue(tblControls) SaveSettings() -- Save sticky data settings btnSetFont.Active = "YES" end -- local function doSetFont function btnSetFont:button_cb(intButton,intPress) -- Action for mouse right-click on Set Window Fonts button if intButton == iup.BUTTON3 and intPress == 0 then iup_gui.BalloonToggle() -- Toggle tooltips Balloon mode end end -- function btnSetFont:button_cb local function doExecute(strExecutable, strParameter) -- Invoke FH Shell Execute API -- V?.? local function ReportError(strMessage) iup_gui.WarnDialogue( "Shell Execute Error", "ERROR: "..strMessage.." :\n"..strExecutable.."\n"..strParameter.."\n\n", "OK" ) end -- local function ReportError return general.DoExecute(strExecutable, strParameter, ReportError) end -- local function doExecute local strHelp = "https://pluginstore.family-historian.co.uk/page/help/rearrange-address-and-place-parts" local arrHelp = { "-mapping-options"; "-input-filter"; } local function doGetHelp() -- Action for Help and Advice button according to current tab -- V1.6 local strPage = arrHelp[IntTabPosn] or "" doExecute( strHelp..strPage ) fhSleep(3000,500) dialogMain.BringFront="YES" end -- local function doGetHelp function tabControl:tabchangepos_cb(intNew,intOld) -- Call back when Main tab position is changed IntTabPosn = intNew + 1 setTopItem() -- V1.6 setButtons() end -- function tabControl:tabchangepos_cb tblControls = { { "Active"; "Font"; "FgColor"; "Expand"; "Tip"; { "TipBalloon";"Balloon" }; { "help_cb"; function() doGetHelp() end; }; "action"; setControls; }; -- Options tab -- [vboxOption] = { "YES"; "FontBody"; "Body"; "YES" ; }; [lblSources] = { "YES"; "FontHead"; "Head";"HORIZONTAL"; "Input column parts before re-arrangement"; }; [lblTargets] = { "YES"; "FontHead"; "Head";"HORIZONTAL"; "Output column parts after re-arrangement"; }; -- See below for Input & Output column Address & Place parts -- [lblOptions] = { "YES"; "FontHead"; "Head";"HORIZONTAL"; "Select desired re-arrangement options then click PERFORM REARRANGEMENT button"; }; [btnPlc2Adr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Copy from all Place column parts to all Address column parts" ; function() doCopyParts(IntColsMax,0) end }; [btnKillAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Delete all of the Address column parts completely" ; function() doKillParts(0) end }; [btnRghtAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Shift Address column parts right between chosen columns" ; function() doMoveParts(txtLastAdr.Value,txtFrstAdr.Value,-1) end }; [btnLeftAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Shift Address column parts left between chosen columns" ; function() doMoveParts(txtFrstAdr.Value,txtLastAdr.Value, 1) end }; [txtFrstAdr] = { "YES"; "FontHead"; "Safe";"HORIZONTAL"; "Select start part for shifting Address column parts"; }; [txtLastAdr] = { "YES"; "FontHead"; "Safe";"HORIZONTAL"; "Select end part for shifting Address column parts"; }; [tglHideAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Insert [[ privacy ]] brackets to hide all duplicated Address parts" ; function(self,intState) if intState == 1 then tglShowAdr.Value = "OFF" tglWipePlc.Value = "OFF" tglWipeAdr.Value = "OFF" end self.Tip = self.Tip end }; [tglShowAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Erase [[ privacy ]] brackets to show all the Address column parts" ; function(self,intState) if intState == 1 then tglHideAdr.Value = "OFF" end self.Tip = self.Tip end }; [tglWipeAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Delete any Address part that duplicates any Place part" ; function(self,intState) if intState == 1 then tglHideAdr.Value = "OFF" tglWipePlc.Value = "OFF" end self.Tip = self.Tip end }; [tglRghtAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Right justify all Address column parts to Address column "..strMaxAddr ; function(self,intState) if intState == 1 then tglLeftAdr.Value = "OFF" end self.Tip = self.Tip end }; -- V1.7 [tglLeftAdr] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Left justify all Address column parts to Address column 1" ; function(self,intState) if intState == 1 then tglRghtAdr.Value = "OFF" end self.Tip = self.Tip end }; [btnAdr2Plc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Copy from all Address column parts to all Place column parts" ; function() doCopyParts(0,IntColsMax) end }; [btnKillPlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Delete all of the Place column parts completely" ; function() doKillParts(IntColsMax) end }; [btnRghtPlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Shift Place column parts right between chosen columns" ; function() doMoveParts(txtLastPlc.Value+IntColsMax,txtFrstPlc.Value+IntColsMax,-1) end }; [btnLeftPlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Shift Place column parts left between chosen columns" ; function() doMoveParts(txtFrstPlc.Value+IntColsMax,txtLastPlc.Value+IntColsMax, 1) end }; [txtFrstPlc] = { "YES"; "FontHead"; "Safe";"HORIZONTAL"; "Select start part for shifting Place column parts"; }; [txtLastPlc] = { "YES"; "FontHead"; "Safe";"HORIZONTAL"; "Select end part for shifting Place column parts"; }; [tglWipePlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Delete any Place part that duplicates any Address part" ; function(self,intState) if intState == 1 then tglHideAdr.Value = "OFF" tglWipeAdr.Value = "OFF" end self.Tip = self.Tip end }; [tglRghtPlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Right justify all Place column parts to Place column "..strMaxPlac ; function(self,intState) if intState == 1 then tglLeftPlc.Value = "OFF" end self.Tip = self.Tip end }; -- V1.7 [tglLeftPlc] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Left justify all Place column parts to Place column 1" ; function(self,intState) if intState == 1 then tglRghtPlc.Value = "OFF" end self.Tip = self.Tip end }; [btnDefault] = { "YES"; "FontBody"; "Safe"; "YES" ; "Restore default Settings for Window positions\nand Address and Place part settings" ; function() setControlsActive("NO"); doDefault(); setControlsActive("YES"); end }; -- V1.8 [btnPerform] = { "YES"; "FontHead"; "Safe"; "YES" ; "Perform the selected Column Part re-arrangement operations" ; function() setControlsActive("NO"); doPerform(); setControlsActive("YES"); return iup.CLOSE end }; -- V1.8 -- Filter tab -- [vboxFilter] = { "YES"; "FontBody"; "Body"; "YES" ; }; [lblFilter] = { "YES"; "FontHead"; "Head";"HORIZONTAL"; "List of possible Address and Place Inputs"; }; [lstFilter] = { "YES"; function() return strMono() end ; "Body"; "YES" ; "Use Leftclick and Shft+Leftclick and Ctrl+Leftclick" ; function(self,text,item,state) setButtons(text,item,state) end }; [btnSetAll] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Select all of the Address and Place entries" ; function() setControlsActive("NO"); doSelect("+") ; setControlsActive("YES"); end }; -- V1.8 [btnSortBy] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Sort by Address entries or by Place entries" ; function() setControlsActive("NO"); doSwapSortBy(); setControlsActive("YES"); end }; -- V1.8 -- V1.5 [btnSetNil] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Select none of the Address and Place entries" ; function() setControlsActive("NO"); doSelect("-") ; setControlsActive("YES"); end }; -- V1.8 [iupBtnHbox] = { "YES"; function() return strMono() end ; "Safe";"HORIZONTAL"; }; -- Dialogue -- [tabControl] = { "YES"; "FontHead"; "Head"; "YES" ; "Mapping Options tab or Input Filter tab"; }; [btnSetFont] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Choose user interface font style" ; function() doSetFont() end; }; [btnGetHelp] = { "YES"; "FontBody"; "Safe";"HORIZONTAL"; "Obtain online Help and Advice from the Plugin Store" ; function() doGetHelp() end; }; [btnDestroy] = { "YES"; "FontBody"; "Risk";"HORIZONTAL"; "Cancel this Plugin" ; function() return iup.CLOSE end; }; [allControl] = { "YES"; "FontBody"; "Body"; "YES" ; }; } for intColPart, strColPart in ipairs (ArrColPart) do -- Set Input & Output column Address & Place part controls local strAct = "YES" if ( strColPart:match("Addr") and intColPart > intMaxAddr ) or ( strColPart:match("Plac") and intColPart - IntColsMax > intMaxPlac ) then strAct = "NO" end tblControls[lstColPart[intColPart]] = { strAct; "FontBody"; "Safe"; "YES" ; "Input column part"..strColPart; } tblControls[lblColPart[intColPart]] = { strAct; "FontBody"; "Body"; "HORIZONTAL"; "Output column part"..strColPart; } setColPartColour(intColPart) -- V1.5 Set Output Column Part colour end iup_gui.AssignAttributes(tblControls) -- Assign control attributes --[=[ Postponed local function doResizeFilter(self,width,height) if IntTabPosn == 2 then -- Resize Filter List to new size for both width of parts and offset for focus -- V1.6 local intSize = math.floor( iupWidth(lstFilter.Size) * 100 ) -- local intNatSize = lstFilter.NaturalSize -- local intSize = lstFilter.Size local font = iupWidth(lstFilter.charsize) local chars = math.floor(intSize/font) -- print("doResizeFilter",width,height,intSize,font,chars) setAddrPlaceSizes() end end; dialogMain.resize_cb = function(self,width,height) doResizeFilter(self,width,height) end -- V1.6 iup_gui.ShowDialogue("Main",dialogMain,btnDestroy,"Map") -- Map main dialogue, so size of Filter List is known --]=] iup_gui.ShowDialogue("Main",dialogMain,btnDestroy,"Map") -- Map main dialogue, so size of Filter List is known if getAddrPlacePairs() then iup_gui.ShowDialogue("Main",dialogMain,btnDestroy) -- Display main dialogue end end -- function GUI_MainDialogue -- Main code starts here -- local intPause = collectgarbage("setpause",50) -- Default = 200 Aggressive = 50 -- Sets pause of collector and returns prev value of pause -- V1.7 local intStep = collectgarbage("setstepmul",300) -- Default = 200 Aggressive = 300 -- Sets step mult of collector & returns prev value of step -- V1.7 fhInitialise(5,0,8,"save_recommended") -- 5.0.8 for Project/User/Machine Plugin Data PresetGlobalData() -- Preset global data definitions ResetDefaultSettings() -- Preset default sticky settings LoadSettings() -- Load sticky data settings iup_gui.CheckVersionInStore() -- Notify if later Version available GUI_MainDialogue() -- Invoke main dialogue SaveSettings() -- Save sticky data settings