load-font (empty) → 0.1.0.0

raw patch · 15 files changed

+355/−0 lines, 15 filesdep +basedep +fltkhsdep +load-fontsetup-changedbinary-added

Dependencies added: base, fltkhs, load-font, text

Files

• .gitignore +3/−0
• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.org +16/−0
• Setup.hs +2/−0
• app/Main.hs +52/−0
• load-font.cabal +67/−0
• package.yaml +48/−0
• screenshot-demo.jpg binary
• src/Graphics/UI/Font/Load.hs +50/−0
• src/Graphics/UI/Font/LoadCWrapper.chs +19/−0
• src/cbits/font_load.c +56/−0
• src/cbits/font_load.h +2/−0
• stack.yaml +7/−0
• test-fonts/moon_phases.ttf binary

@@ -0,0 +1,3 @@+.stack-work/+load-font.cabal+*~

@@ -0,0 +1,3 @@+# Changelog for font-load++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,16 @@+* Load Font+  This library aims to a cross-platform (Win/Lin/OSX) way to load a custom font bundled with your Haskell app. The font is automatically unloaded when the app exits.++  It ships with the [[https://www.dafont.com/moon-phases.font][Moon Phases]] font and a GUI demo, ~load-font-exe~ that uses the [[https://hackage.haskell.org/package/fltkhs][FLTKHS]] Haskell GUI library to show that Moon Phases is indeed loaded. It has been tested on Arch Linux, Windows 10 and OSX Sierra.++  While the demo uses FLTKHS font loading and unloading it is agnostic to the GUI framework. FLTKHS is used here simply because it's the easiest to build and install.++  This library owes its existence to [[https://groups.google.com/d/msg/fltkgeneral/uAdg8wOLiMk/_CzBu995AwAJ][Albrecht Schlosser's post on the FLTK mailing list]].++  To run the demo, clone this repo and do:+  #+BEGIN_EXAMPLE+  > stack build --flag fltkhs:bundled+  > stack exec load-font-exe+  #+END_EXAMPLE++ [[file:screenshot-demo.jpg]]

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where+import Graphics.UI.Font.Load+import Paths_load_font+import Graphics.UI.FLTK.LowLevel.Fl_Enumerations+import qualified Graphics.UI.FLTK.LowLevel.FL as FL+import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.FLTKHS++drawFonts :: Font -> Ref Box -> IO ()+drawFonts moonPhasesFont b = do+  label <- getLabel b+  bounds@(Rectangle (Position (X x') (Y y')) _) <- getRectangle b+  flcPushClip bounds+  flcSetColor blackColor+  flcSetFont helvetica (FontSize 18)+  flcDraw "It says \"Hello World!\" in Moon Phases:" (Position (X (x'+25)) (Y (y'+40)))+  flcSetFont moonPhasesFont (FontSize 30)+  flcDraw "Hello world!" (Position (X (x'+25)) (Y (y'+90)))+  flcPopClip++main :: IO ()+main = do+  fontPath <- getDataFileName "test-fonts/moon_phases.ttf"+  loadFont fontPath+  numFaces <- FL.setFonts Nothing+  let fonts = map Font [0 .. numFaces - 1]+  withFaces <- mapM+                 (\f -> do+                   (face,_) <- FL.getFontName f+                   return (face,f)+                 )+                 fonts+  case (lookup "Moon Phases" withFaces) of+    Nothing -> flMessage "The Moon Phases test font was not loaded!"+    Just f -> do+      win <- windowNew+               (Size (Width 400) (Height 120))+               Nothing+               (Just "Font Load Demo")+      setColor win whiteColor+      begin win+      b <- boxCustom+             (toRectangle (0,0,400,120))+             Nothing+             (Just (drawFonts f))+             Nothing+      setBox b FlatBox+      end win+      showWidget win+      _ <- FL.run+      return ()

@@ -0,0 +1,67 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: f0d79e490fdec5930d56c78d859e5922183c991f5459dbbf6b10f130560ffb12++name:           load-font+version:        0.1.0.0+synopsis:       A cross platform library for loading bundled fonts into your application+description:    Please see the README on Github at <https://github.com/deech/font-load#readme>+category:       UI,Graphics,GUI,User Interfaces, Font+homepage:       https://github.com/deech/load-font#readme+bug-reports:    https://github.com/deech/load-font/issues+author:         Aditya Siram+maintainer:     aditya.siram@gmail.com+copyright:      2018 Aditya Siram+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    src/cbits/font_load.c++data-files:+    test-fonts/moon_phases.ttf++source-repository head+  type: git+  location: https://github.com/deech/load-font++library+  hs-source-dirs:+      src+  include-dirs:+      src/cbits+  c-sources:+      src/cbits/font_load.c+  build-depends:+      base >=4.7 && <5+  build-tools:+      c2hs+  exposed-modules:+      Graphics.UI.Font.Load+  other-modules:+      Graphics.UI.Font.LoadCWrapper+      Paths_load_font+  default-language: Haskell2010++executable load-font-exe+  main-is: Main.hs+  hs-source-dirs:+      app+  ghc-options: -O2+  build-depends:+      base >=4.7 && <5+    , fltkhs >=0.5.4.4+    , load-font+    , text >=1.2.2.0+  if (os(linux) || os(windows))+    ghc-options: -pgml g++ "-optl-Wl,--allow-multiple-definition" "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"+  else+    ghc-options: -optl-Wl,-lfltkc+  other-modules:+      Paths_load_font+  default-language: Haskell2010

@@ -0,0 +1,48 @@+name:                load-font+version:             0.1.0.0+github:              "deech/load-font"+license:             BSD3+author:              "Aditya Siram"+maintainer:          "aditya.siram@gmail.com"+copyright:           "2018 Aditya Siram"+synopsis:            A cross platform library for loading bundled fonts into your application+category:            UI,Graphics,GUI,User Interfaces, Font+extra-source-files:+- src/cbits/font_load.c+- README.md+- ChangeLog.md+data-files:+- test-fonts/*.ttf++description:         Please see the README on Github at <https://github.com/deech/font-load#readme>++dependencies:+- base >= 4.7 && < 5++library:+  source-dirs: src+  exposed-modules: Graphics.UI.Font.Load+  build-tools: c2hs+  c-sources:+    - src/cbits/font_load.c+  include-dirs: src/cbits++executables:+  load-font-exe:+    main:                Main.hs+    source-dirs:         app+    ghc-options:+    - -threaded+    - -rtsopts+    - -with-rtsopts=-N+    dependencies:+    - load-font+    - fltkhs >= 0.5.4.4+    - text >= 1.2.2.0+    ghc-options: -O2+    when:+      - condition: (os(linux) || os(windows))+        then:+          ghc-options: -pgml g++ "-optl-Wl,--allow-multiple-definition" "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"+        else:+          ghc-options: "-optl-Wl,-lfltkc"

binary file changed (absent → 13317 bytes)

@@ -0,0 +1,50 @@+module Graphics.UI.Font.Load+  (+    loadFont+  , unloadFont+  )+where+import Foreign.C.String+import Control.Applicative+import Foreign.C.Types+import qualified Graphics.UI.Font.LoadCWrapper as CWrapper+-- |+-- Remove a private font located at 'FilePath' from the application.+--+-- For the most part you shouldn't need this function because private fonts are+-- automatically unloaded when the process exits but it's available in case+-- you're doing something more exotic like switching between two versions of the+-- same font.+--+-- On Windows and OSX this works as you would expect. But on Linux the only+-- available function is+-- <https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcconfigappfontclear.html FcConfigAppFontClear>+-- which ignores the 'FilePath' and removes /all/ private+-- fonts. This adheres violently to the Principle Of Greatest Surprise and in+-- the future I will transparently reload the other fonts but for now, caveat+-- computer.+unloadFont :: FilePath -> IO ()+unloadFont fp = withCString fp (\pathPtr -> CWrapper.unloadFont pathPtr)++-- |+-- Make a font located at some 'FilePath' available to your application. The font is automatically cleared from the font database with the process exits.+--+-- On Linux this uses+-- <https://www.freedesktop.org/software/fontconfig/fontconfig-devel/fcconfigappfontaddfile.html FcConfigAppFontAddFile>+-- under the hood and so assumes X11/Xft are available.+-- It should work fine on modern Linux systems but will break with old Xlib+-- legacy fonts.+--+-- Currently the error case just returns a pretty uninformative message+-- because underlying calls on Linux and Windows which are out of my control+-- only return 0 or 1 in case of failure or success. Given this it would make more sense that+-- the return type should be 'Maybe ()' but 'Either String ()' has two advantages+-- 1. It makes errors easier to collect when batch loading+-- 2. OSX has a <https://developer.apple.com/documentation/corefoundation/cferror-ru8 much nicer error> which I plan to expose in the future+loadFont :: FilePath -> IO (Either String ())+loadFont fp = withCString fp (\pathPtr -> do+                                 res <- CWrapper.loadFont pathPtr+                                 case res of+                                   Left _ -> return (Left ("Unable to load: " ++ fp))+                                   Right () -> return (Right ())+                             )

@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-}+module Graphics.UI.Font.LoadCWrapper+  (+    loadFont+  , unloadFont+  )+where+import Foreign.C.String+import Control.Applicative+import Foreign.C.Types+#include "font_load.h"+{# fun load_private_font as loadFont' { `CString' } -> `CInt' #}+loadFont :: CString -> IO (Either String ())+loadFont pathPtr = do+  res <- loadFont' pathPtr+  case res of+    0 -> return (Left "")+    _ -> return (Right ())+{# fun unload_private_font as unloadFont { `CString' } -> `()' #}

@@ -0,0 +1,56 @@+#include "font_load.h"+#ifdef _WIN32+#define _WIN32_WINNT 0x0501 /* need at least WinXP for this API, I think */+#include <windows.h>+#elif defined(__APPLE__)+#include <ApplicationServices/ApplicationServices.h>+#else /* Assume X11 with XFT/fontconfig - this will break on systems using legacy Xlib fonts */+#include <fontconfig/fontconfig.h>+#define USE_XFT 1+#endif++// Create some portability wrappers+#ifdef _WIN32+int load_private_font(_In_ LPCTSTR path) {+  return AddFontResourceEx(path, FR_PRIVATE, 0);+}+void unload_private_font(_In_ LPCTSTR path) {+  RemoveFontResourceEx(path, FR_PRIVATE, 0);+}++#elif defined(__APPLE__)+int load_private_font(const char *pf) {+  int result = 0;+  CFErrorRef errRef;+  // Make a URL from the font name given+  CFURLRef fontURL = CFURLCreateFromFileSystemRepresentation(kCFAllocatorDefault, (const UInt8 *)pf, strlen(pf), false);+  // Try to load the font file+  if (CTFontManagerRegisterFontsForURL(fontURL, kCTFontManagerScopeProcess, &errRef)) {+    result = 1;+  } else {+    result = 0;+  }+  // discard the fontURL+  if (fontURL)+    CFRelease(fontURL);+  return result;+} // load_private_font++void unload_private_font(const char *pf) {+  CFErrorRef err;+  // Make a URL from the font name given+  CFURLRef fontURL = CFURLCreateFromFileSystemRepresentation(kCFAllocatorDefault, (const UInt8 *)pf, strlen(pf), false);+  // Try to unregister the font+  CTFontManagerUnregisterFontsForURL(fontURL, kCTFontManagerScopeProcess, &err);+  if (fontURL)+    CFRelease(fontURL);+} // unload_private_font++#else /* Assume X11 with XFT/fontconfig - will break on systems using legacy Xlib fonts */+int load_private_font(const char* path) {+  return (int)FcConfigAppFontAddFile(0, (const FcChar8 *)(path));+}+void unload_private_font(const char* path) {+  FcConfigAppFontClear(0);+}+#endif

@@ -0,0 +1,2 @@+int load_private_font(const char* path);+void unload_private_font(const char* path);

@@ -0,0 +1,7 @@+resolver: lts-10.7+packages:+- .+allow-newer: true+extra-deps:+- c2hs-0.28.3+- fltkhs-0.5.4.4

binary file changed (absent → 19632 bytes)