PureBasic Forums - English

Posted: **Tue Feb 04, 2014 2:30 am**

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.

Posted: **Fri Feb 07, 2014 3:10 am**

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

Posted: **Fri Feb 07, 2014 3:45 am**

> 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.

Posted: **Fri Feb 07, 2014 4:37 am**

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.

Posted: **Fri Feb 07, 2014 5:21 am**

> 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.

PureBasic Forums - English

FontIndex

FontIndex

Re: FontIndex

Re: FontIndex

Re: FontIndex

Re: FontIndex