FontIndex

[Seymour Clufley]

Since I work in graphic design a lot, I am often in the situation where I need to find a suitable font. It's usually a type of font that I've needed (and found) before, but I will have forgotten the name, or similar fonts that I considered before, so I have to start the search all over again. To avoid having to do this in future, I wanted a way to "index" fonts, so that I could easily keep track of which fonts are suitable for what.

Below is a simple program to solve the problem. It enables you to select a font and associate "genres" with it (any names you like). In this way, a list of genres gradually builds up. Then, you can select a genre to find all fonts associated with it. You can also select multiple genres in order to refine your search.

Code: Select all

Structure FontStructure
	Map genre.i()
	load.i
EndStructure

Global NewMap fnt.FontStructure()
Global NewMap genre.b()
Global changes.b
Global cur_font.s = ""
Global win.i
Global genrelist.i
Global searchresultlist.i
Global announcer.i
Global ed.i
Global addgenrebutton.i
Global indexfile.s = font_index.txt ; put a filename here
#d1 = "|"
#d2 = "~"

Macro Nots
	""=
EndMacro


Procedure.b LoadFontKnowledge()
	f = ReadFile(#PB_Any,indexfile)
	If f
		ClearMap(fnt())
		While Not Eof(f)
			ln.s = ReadString(f)
			nm.s = StringField(ln,1,#d1)
			test.i = LoadFont(#PB_Any,nm,20)
			If test
				AddMapElement(fnt(),nm)
				fnt(nm)\load = test
				genrearr.s = StringField(ln,2,#d1)
				gs = CountString(genrearr,#d2)
				For g = 1 To gs
					genrename.s = StringField(genrearr,g,#d2)
					If Nots genrename : Continue : EndIf
					fnt(nm)\genre(genrename) = #True
					If Not FindMapElement(genre(),genrename)
						AddMapElement(genre(),genrename)
					EndIf
				Next g
			EndIf
		Wend
		CloseFile(f)
		ProcedureReturn #True
	Else
		MessageRequester("Font Index","Could not read indexfile:"+Chr(13)+"*"+indexfile+"*"+Chr(13)+Chr(13)+"(This is probably because you have not yet saved it, in which case this is nothing to worry about.)")
		ProcedureReturn #False
	EndIf
EndProcedure

Procedure.b SaveFontKnowledge()
	;R("PROC: SaveFontKnowledge")
	If Not changes : ProcedureReturn #True : EndIf
	f = CreateFile(#PB_Any,indexfile)
	If f
		ForEach fnt()
			If MapSize(fnt()\genre())
				ln.s = MapKey(fnt())+#d1
				ForEach fnt()\genre()
					ln+MapKey(fnt()\genre())+#d2
				Next
				ln+#d1
				WriteStringN(f,ln)
				chars + Len(ln)
			EndIf
		Next
		CloseFile(f)
		changes = #False
		If chars=0
			DeleteFile(indexfile)
			ProcedureReturn #True
		EndIf
	Else
		MessageRequester("Font Index","Could not create indexfile:"+Chr(13)+"*"+indexfile+"*")
		ProcedureReturn #False
	EndIf
EndProcedure

Macro ExitAttempt
	If changes
		Select MessageRequester("Close Font Index","Save changes?",#PB_MessageRequester_YesNoCancel)
			Case #PB_MessageRequester_Yes
				SaveFontKnowledge()
				End
			Case #PB_MessageRequester_No
				End
			Case #PB_MessageRequester_Cancel
		EndSelect
	Else
		End
	EndIf
EndMacro


Procedure.b CloseFont()
	ForEach fnt(cur_font)\genre()
		FreeGadget(fnt(cur_font)\genre())
		fnt(cur_font)\genre() = 0
	Next
	cur_font = ""
	SetGadgetText(announcer,"")
	HideGadget(addgenrebutton,#True)
EndProcedure

#Margin = 10
#GenreButtonWidth = 75
#GenreButtonHeight = 20
Procedure.b CascadeFontGenreButtons()
	x = #Margin
	y = GadgetY(ed)+GadgetHeight(ed)+#Margin
	maxx = GadgetWidth(ed)-#GenreButtonWidth
	
	ForEach fnt(cur_font)\genre()
		;g.s = MapKey(fnt(cur_font)\genre())
		ResizeGadget(fnt(cur_font)\genre(),x,y,#PB_Ignore,#PB_Ignore)
		x+#GenreButtonWidth+5
		If x>maxx
			x = #Margin
			y+#GenreButtonHeight+5
		EndIf
	Next
	
	ResizeGadget(addgenrebutton,x,y,#PB_Ignore,#PB_Ignore)
	
EndProcedure

Procedure.b OpenFont(nm.s)
	If Nots nm
		ProcedureReturn #False
	EndIf
	
	If Not FindMapElement(fnt(),nm)
		;R("NOT FOUND IN MAP: *"+nm+"*")
		test.i = LoadFont(#PB_Any,nm,20)
		;R("TEST: "+Str(test))
		If test
			AddMapElement(fnt(),nm)
			fnt(nm)\load = test
		Else
			MessageRequester("Font Index","Font was not found on system:"+Chr(13)+"*"+nm+"*")
			ProcedureReturn #False
		EndIf
	EndIf
	
	CloseFont()
	cur_font = nm
	
	HideGadget(announcer,#False)
	SetGadgetText(announcer,nm)
	HideGadget(ed,#False)
	SetGadgetFont(ed,FontID(fnt(nm)\load))
	
	UseGadgetList(WindowID(win))
	
	ForEach fnt(nm)\genre()
		g.s = MapKey(fnt(nm)\genre())
		fnt(nm)\genre() = ButtonGadget(#PB_Any,x,y,#GenreButtonWidth,#GenreButtonHeight,g)
		GadgetToolTip(fnt(nm)\genre(),"Remove")
	Next
	CascadeFontGenreButtons()
	HideGadget(addgenrebutton,#False)
	
EndProcedure

Procedure.b AttachGenreToCurrentFont(g.s)
	If Not FindMapElement(fnt(cur_font)\genre(),g)
		AddMapElement(fnt(cur_font)\genre(),g)
		fnt(cur_font)\genre() = ButtonGadget(#PB_Any,0,0,#GenreButtonWidth,#GenreButtonHeight,g)
		GadgetToolTip(fnt(cur_font)\genre(),"Remove")
		changes = #True
		CascadeFontGenreButtons()
	EndIf
EndProcedure

Procedure.b DetachGenreFromCurrentFont(g.s)
	If FindMapElement(fnt(cur_font)\genre(),g)
		FreeGadget(fnt(cur_font)\genre())
		DeleteMapElement(fnt(cur_font)\genre(),g)
		changes = #True
		CascadeFontGenreButtons()
	EndIf
EndProcedure

Procedure.b DeleteGenre(gnm.s)
	DeleteMapElement(genre(),gnm)
	gs = CountGadgetItems(genrelist)
	For g = 0 To gs
		If GetGadgetItemText(genrelist,g)=gnm
			RemoveGadgetItem(genrelist,g)
			Break
		EndIf
	Next g
	ForEach fnt()
		If FindMapElement(fnt()\genre(),gnm)
			If MapKey(fnt())=cur_font
				FreeGadget(fnt()\genre(gnm))
				CascadeFontGenreButtons()
			EndIf
			DeleteMapElement(fnt()\genre(),gnm)
		EndIf
	Next
EndProcedure



Procedure.i GetConformantFonts()
	
	NewMap need.b()
	gs = CountGadgetItems(genrelist)
	For g = 0 To gs
		If GetGadgetItemState(genrelist,g)=1
			gnm.s = GetGadgetItemText(genrelist,g)
			AddMapElement(need(),gnm)
		EndIf
	Next g
	
	needs = MapSize(need())
	If needs
	NewList rez.s()
	ForEach fnt()
		genrematchcount = 0
		ForEach need()
			If FindMapElement(fnt()\genre(),MapKey(need()))
				genrematchcount+1
			Else
				Break
			EndIf
		Next
		If genrematchcount = needs
			AddElement(rez())
			rez() = MapKey(fnt())
		EndIf
	Next
	
	ClearGadgetItems(searchresultlist)
	
	If ListSize(rez())
	SortList(rez(),#PB_Sort_Ascending|#PB_Sort_NoCase)
	ForEach rez()
		AddGadgetItem(searchresultlist,-1,rez())
	Next
Else
	If needs=1
		ResetMap(need())
		NextMapElement(need())
		gnm.s = MapKey(need())
		If MessageRequester("Font Index","No fonts have the genre "+c34+gnm+c34+". Delete it?",#PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
			DeleteGenre(gnm)
		EndIf
	EndIf
EndIf
	
	ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure





LoadFontKnowledge()
ww = 1000
wh = 450
win = OpenWindow(#PB_Any,0,0,ww,wh,"Font Index",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
esc = 1
AddKeyboardShortcut(win,#PB_Shortcut_Escape,esc)
save = 2
AddKeyboardShortcut(win,#PB_Shortcut_Control|#PB_Shortcut_S,save)

finderbutton = ButtonGadget(#PB_Any,#Margin,#Margin,100,20,"Find font...")

glistw = 200
TextGadget(#PB_Any,ww-#Margin-glistw,#Margin,glistw,20,"Genres...")
gh = Int((wh-#Margin-#Margin-#Margin-15-15)/2)
genrelist = ListViewGadget(#PB_Any,ww-#Margin-glistw,#Margin+15,glistw,gh,#PB_ListView_ClickSelect)
ForEach genre()
	AddGadgetItem(genrelist,-1,MapKey(genre()))
Next

t = TextGadget(#PB_Any,ww-#Margin-glistw,GadgetY(genrelist)+GadgetHeight(genrelist)+#Margin,glistw,15,"Conformant fonts...")
searchresultlist = ListViewGadget(#PB_Any,ww-#Margin-glistw,GadgetY(t)+GadgetHeight(t),glistw,gh)

announcer = TextGadget(#PB_Any,#Margin,75,300,15,"Font name")
HideGadget(announcer,#True)
ed = EditorGadget(#PB_Any,#Margin,90,600,250)
SetGadgetText(ed,"The quick brown fox jumped over the lazy dogs. 0 1 2 3 4 5 6 7 8 9")
HideGadget(ed,#True)

addgenrebutton = ButtonGadget(#PB_Any,0,0,100,#GenreButtonHeight,"ADD GENRE...")
HideGadget(addgenrebutton,#True)


Repeat
	we = WindowEvent()
	If we
		Select we
			Case #PB_Event_CloseWindow
				ExitAttempt
			Case #PB_Event_Menu
				Select EventMenu()
					Case save
						SaveFontKnowledge()
					Case esc
						ExitAttempt
				EndSelect
			Case #PB_Event_Gadget
				gad = EventGadget()
				Select gad
					Case finderbutton
						;OpenFont(InputRequester("Find font","Enter name:",""))
						If FontRequester("",20,#false)
							nm.s = SelectedFontName()
							If nm
								OpenFont(nm)
							EndIf
						EndIf
					Case addgenrebutton
						If cur_font
							g.s = InputRequester("Apply new genre","Enter genre name:","")
							If g
								If Not FindMapElement(genre(),g)
									genre(g) = #True
									AddGadgetItem(genrelist,-1,g)
								EndIf
								AttachGenreToCurrentFont(g)
							EndIf
						EndIf
					Case genrelist
						GetConformantFonts()
					Case searchresultlist
						sel = GetGadgetState(searchresultlist)
						If sel>-1
							nm.s = GetGadgetItemText(searchresultlist,sel)
							If nm
								OpenFont(nm)
							EndIf
						EndIf
					Default
						If cur_font
							ForEach fnt(cur_font)\genre()
								If gad=fnt(cur_font)\genre()
									DetachGenreFromCurrentFont(MapKey(fnt(cur_font)\genre()))
									Break
								EndIf
							Next
						EndIf
				EndSelect
		EndSelect
	Else
		Delay(50)
	EndIf
ForEver

I hope this is useful for somebody.

[Seymour Clufley]

I'm surprised nobody has replied. Is there some serious bug in the code that I should know about? :O

[PB]

> I'm surprised nobody has replied

Well, I read your post, but since I don't need it, I didn't reply.
Sometimes it's just as simple as that. Don't worry so much.

[Kuron]

I have no use for your code and I have not tried it, but I do say thank you for sharing with the community. The code looks like good stuff, although Maps can be migraine inducing for me.

I do have a suggestion though, put it in the Tricks 'n' Tips section so those looking for a code example to do this can find it easier.

[PB]

> put it in the Tricks 'n' Tips section

Agreed. It's not Off Topic at all. Perhaps that's why more people
haven't commented too... some probably don't read this section.