; Module/File: Font_RequesterMonospaceCheck.pb ; Function: Check, if a requester-choosen-font is monospace - Linux ; Author: Omi ; Date: Mar. 24, 2016 ; Version: 0.1 ; Target Compiler: PureBasic 5.2/5.3/5.4 ; Target OS: Linux: (X/K/L)ubuntu, Mint, 32/64, Ascii/Uni ;-------------------------------------------------------------- EnableExplicit ImportC "" pango_context_list_families(*context, *families, *n_families); PangoFontFamily pango_context_get_font_description(*context) pango_font_description_get_family(*desc) pango_font_family_get_name(*family) pango_font_family_is_monospace(*family) EndImport ; Object constants #MainWin = 0 #But1 = 0 #Txt1 = 1 Global.i gEvent, gQuit Global.i gFontRequester, gIsMonospace Global.s gCurrFontName Procedure.i Font_IsMonospace(FontName.s) Protected PangoContext= gdk_pango_context_get_() Protected.i PangoFamilies, PangoFamily, pFamilyName Protected.i pPangoFamily Protected.i I, nFamilies, IsMonospace= #False pango_context_list_families(PangoContext, @PangoFamilies, @nFamilies) pPangoFamily= PangoFamilies For I= 1 To nFamilies PangoFamily= PeekI(pPangoFamily); not sure about 'long', but yet no error If PangoFamily pFamilyName= pango_font_family_get_name(PangoFamily) If pFamilyName If PeekS(pFamilyName, -1, #PB_UTF8) = FontName; compare names IsMonospace= pango_font_family_is_monospace(PangoFamily) Break EndIf EndIf EndIf pPangoFamily+ SizeOf(PangoFamily) Next I g_free_(PangoFamilies) ProcedureReturn IsMonospace EndProcedure Procedure.s Font_GetNameFromGadget(Gadget) Protected PangoDescription= pango_context_get_font_description(gtk_widget_get_pango_context_(GadgetID(Gadget))) Protected.i pFamily Protected.s FamilyName pFamily= pango_font_description_get_family(PangoDescription) If pFamily FamilyName= PeekS(pFamily, -1, #PB_UTF8) EndIf ProcedureReturn FamilyName EndProcedure If OpenWindow(#MainWin, 300, 200, 400, 100, "Query font monospace property", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) ButtonGadget(#But1, 5, 5, 390, 26, "Choose font to check ...") TextGadget (#Txt1, 5, 35, 390, 22, "") ;Get current TextGadget font name ... gCurrFontName= Font_GetNameFromGadget(#But1) SetGadgetText(#Txt1, "Default Font: '"+gCurrFontName+"'") Repeat gEvent= WaitWindowEvent() Select gEvent Case #PB_Event_CloseWindow gQuit= #True Case #PB_Event_Gadget If EventGadget() = #But1 gFontRequester= FontRequester(gCurrFontName, 10, 0) If gFontRequester gCurrFontName= SelectedFontName() gIsMonospace= Font_IsMonospace(gCurrFontName) If gIsMonospace SetGadgetText(#Txt1, "'"+gCurrFontName+"'" + " is monospace") Else SetGadgetText(#Txt1, "'"+gCurrFontName+"'" + " isn't monospace") EndIf EndIf EndIf EndSelect Until gQuit EndIf ; IDE Options = PureBasic 5.42 LTS (Linux - x86) ; CursorPosition = 90 ; FirstLine = 73 ; Folding = - ; EnableUnicode ; EnableXP