class EL_FONT_REGISTRY_ROUTINES

(source code)

description

Routines to access Windows font information in registry

note
	description: "[
		Routines to access Windows font information in registry
	]"

	author: "Finnian Reilly"
	copyright: "Copyright (c) 2001-2022 Finnian Reilly"
	contact: "finnian at eiffel hyphen loop dot com"

	license: "MIT license (See: en.wikipedia.org/wiki/MIT_License)"
	date: "2024-09-25 7:54:42 GMT (Wednesday 25th September 2024)"
	revision: "4"

expanded class
	EL_FONT_REGISTRY_ROUTINES

inherit
	EL_EXPANDED_ROUTINES

	EL_MODULE_WIN_REGISTRY; EL_MODULE_HKEY_LOCAL_MACHINE

feature -- Access

	new_true_type_font_set: EL_HASH_SET [ZSTRING]
		local
			name, name_part: ZSTRING; name_split: EL_SPLIT_ZSTRING_ON_STRING
		do
			create Result.make (100)
			across Win_registry.value_names (HKLM_fonts) as list loop
				name := list.name
				if name.ends_with (True_type_suffix) then
					name.remove_tail (True_type_suffix.count)
					name.right_adjust
					if name.has_substring (Ampersand_string) then
						create name_split.make (name, Ampersand_string)
						across name_split as split loop
							name_part := split.item
							remove_qualifiers (name_part)
							Result.put_copy (name_part)
						end
					else
						remove_qualifiers (name)
						Result.put (name)
					end
				end
			end
		end

feature -- Constants

	Substitute_fonts: EL_HASH_TABLE [ZSTRING, STRING_32]
		local
			name: STRING_32
		once
			create Result.make_equal (30)
			across Win_registry.string_list (HKLM_font_substitutes) as list loop
				name := list.item.name.substring_to (',')
				Result [name] := list.item.value.substring_to (',')
			end
		end

	Valid_font_types: EL_STRING_8_LIST
		once
			Result := "fon, fnt, ttf, ttc, fot, otf, mmm, pfb, pfm"
		end

feature {NONE} -- Implementation

	remove_qualifiers (name: ZSTRING)
		local
			removed: BOOLEAN; word: ZSTRING
		do
			across Qualifier_word_list as list until removed loop
				word := list.item
				if name.ends_with (word) and then name.count > word.count then
					name.remove_tail (word.count); name.right_adjust
					removed := True
				end
			end
			if removed then
				remove_qualifiers (name) -- Recurse
			else
				name.trim
			end
		end

feature {NONE} -- Constants

	Ampersand_string: ZSTRING
		once
			Result := " & "
		end

	HKLM_font_substitutes: DIR_PATH
		once
			Result := Key_local.Windows_nt_current_version #+ "FontSubstitutes"
		end

	HKLM_fonts: DIR_PATH
		once
			Result := Key_local.Windows_nt_current_version #+ "Fonts"
		end

	Qualifier_word_list: EL_ZSTRING_LIST
		once
			Result := "Bold, Italic, Oblique, Regular, Semibold"
		end

	True_type_suffix: ZSTRING
		once
			Result := "(TrueType)"
		end

end