12 files changed, 159 insertions(+), 55 deletions(-)

M app/Main.hs
A assets/Lora-Bold.ttf
A assets/Lora-BoldItalic.ttf
A assets/Lora-Italic.ttf
A assets/Lora-Regular.ttf
A assets/SIL Open Font License.txt
M package.yaml
M src/Typograffiti.hs
M src/Typograffiti/Atlas.hs
M src/Typograffiti/GL.hs
M src/Typograffiti/Glyph.hs
M src/Typograffiti/Utils.hs

@@ 3,15 3,18 @@
 {-# LANGUAGE TypeApplications    #-}
 module Main where
 
-import           Control.Monad          (forever)
+import           Control.Monad          (unless)
 import           Control.Monad.Except   (runExceptT, withExceptT)
 import           Control.Monad.IO.Class (MonadIO (..))
 import           Data.ByteString        (ByteString)
 import qualified Data.ByteString.Char8  as B8
+import           Data.Function          (fix)
 import qualified Data.Vector.Unboxed    as UV
 import           Graphics.GL
 import           SDL
 import           System.FilePath        ((</>))
+import           Text.Show.Pretty       (pPrint)
+
 import           Typograffiti
 import           Typograffiti.GL
 


@@ 26,7 29,7 @@ vertexShader = B8.pack $ unlines
   , "out vec2 fuv;"
   , "void main () {"
   , "  fuv = uv;"
-  , "  gl_Position = projection * modelview * vec4(position, 0.0, 0.1);"
+  , "  gl_Position = projection * modelview * vec4(position.xy, 0.0, 1.0);"
   , "}"
   ]
 


@@ 43,6 46,12 @@ fragmentShader = B8.pack $ unlines
   ]
 
 
+-- TODO: Word caching.
+-- Somehow make it so it isn't bonded to one kind of
+-- shader. It would be nice if users could write their own
+-- shaders for this. At the same time, they shouldn't have to.
+
+
 main :: IO ()
 main = do
   SDL.initializeAll


@@ 51,17 60,21 @@ main = do
         { glProfile = Core Debug 3 3 }
       wcfg = defaultWindow
         { windowInitialSize = V2 640 480
-        , windowOpenGL = Just openGL
+        , windowOpenGL      = Just openGL
+        , windowResizable   = True
         }
 
   w <- createWindow "Typograffiti" wcfg
   _ <- glCreateContext w
-  let ttfName = "assets" </> "Neuton-Regular.ttf"
+  let ttfName = "assets" </> "Lora-Regular.ttf"
 
   (either fail return =<<) . runExceptT $ do
     -- Get the atlas
     atlas <- withExceptT show
-      $ allocAtlas ttfName (PixelSize 16 16) asciiChars
+      $ allocAtlas
+          ttfName
+          (GlyphSizeInPixels 16 16)
+          asciiChars
     -- Compile our shader program
     let position = 0
         uv       = 1


@@ 79,7 92,7 @@ main = do
     tex        <- getUniformLocation prog "tex"
     -- Generate our string geometry
     geom <- withExceptT show
-      $ stringTris atlas True "Hi there"
+      $ stringTris atlas True "Typograffiti from your head to your feetee."
     let (ps, uvs) = UV.unzip geom
     -- Buffer the geometry into our attributes
     textVao <- withVAO $ \vao -> do


@@ 103,14 116,24 @@ main = do
 
     -- Set our model view transform
     let mv :: M44 Float
-        mv = mat4Translate (V3 10 100 0)
+        mv = mat4Translate (V3 0 16 0)
         mv2 :: M44 Float
-        mv2 = mv !*! mat4Scale (V3 0.125 0.125 1)
+        mv2 = mv !*! mat4Translate (V3 0 16 0)
     -- Forever loop, drawing stuff
-    forever $ do
-      _ <- pollEvents
-      pj :: M44 Float <-
-        orthoProjection <$> get (windowSize w)
+    fix $ \loop -> do
+
+      events <- fmap eventPayload
+        <$> pollEvents
+
+      glClearColor 0 0 0 1
+      glClear GL_COLOR_BUFFER_BIT
+
+      dsz@(V2 dw dh) <- glGetDrawableSize w
+      glViewport 0 0 (fromIntegral dw) (fromIntegral dh)
+
+      wsz <- get (windowSize w)
+      let pj :: M44 Float = orthoProjection wsz
+
       withBoundTextures [atlasTexture atlas] $ do
         updateUniform prog projection pj
         updateUniform prog modelview mv


@@ 121,6 144,7 @@ main = do
           GL_TRIANGLES
           (fromIntegral $ UV.length ps)
 
+        updateUniform prog projection pj
         updateUniform prog modelview mv2
         drawVAO
           prog


@@ 128,3 152,4 @@ main = do
           GL_TRIANGLES
           6
       glSwapWindow w
+      unless (any (== QuitEvent) events) loop

@@ 0,0 1,44 @@
+Copyright (c) 2011-2013, Cyreal (www.cyreal.org a@cyreal.org), with
+Reserved Font Name 'Lora'
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide development of collaborative font projects, to support the font creation efforts of academic and linguistic communities, and to provide a free and open framework in which fonts may be shared and improved in partnership with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and redistributed freely as long as they are not sold by themselves. The fonts, including any derivative works, can be bundled, embedded, redistributed and/or sold with any software provided that any reserved names are not used by derivative works. The fonts and derivatives, however, cannot be released under any other type of license. The requirement for fonts to remain under this license does not apply to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright Holder(s) under this license and clearly marked as such. This may include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting, or substituting -- in part or in whole -- any of the components of the Original Version, by changing formats or by porting the Font Software to a new environment.
+
+"Author" refers to any designer, engineer, programmer, technical writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining a copy of the Font Software, to use, study, copy, merge, embed, modify, redistribute, and sell modified and unmodified copies of the Font Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components, in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled, redistributed and/or sold with any software, provided that each copy contains the above copyright notice and this license. These can be included either as stand-alone text files, human-readable headers or in the appropriate machine-readable metadata fields within text or binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font Name(s) unless explicit written permission is granted by the corresponding Copyright Holder. This restriction only applies to the primary font name as presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font Software shall not be used to promote, endorse or advertise any Modified Version, except to acknowledge the contribution(s) of the Copyright Holder(s) and the Author(s) or with their explicit written permission.
+
+5) The Font Software, modified or unmodified, in part or in whole, must be distributed entirely under this license, and must not be distributed under any other license. The requirement for fonts to remain under this license does not apply to any document created using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM OTHER DEALINGS IN THE FONT SOFTWARE.<
\ No newline at end of file

@@ 45,6 45,7 @@ executables:
     dependencies:
     - filepath
     - JuicyPixels
+    - pretty-show
     - sdl2
     - typograffiti
 

@@ 12,6 12,7 @@
 module Typograffiti
   ( allocAtlas
   , GlyphSize (..)
+  , CharSize (..)
   , TypograffitiError (..)
   , Atlas (..)
   , asciiChars

@@ 15,6 15,7 @@ module Typograffiti.Atlas where
 import           Control.Monad
 import           Control.Monad.Except                              (MonadError (..))
 import           Control.Monad.IO.Class
+import           Data.Bifunctor                                    (bimap)
 import           Data.IntMap                                       (IntMap)
 import qualified Data.IntMap                                       as IM
 import           Data.Map                                          (Map)


@@ 79,27 80,35 @@ data Atlas = Atlas { atlasTexture     :: GLuint
 
 
 emptyAtlas :: FT_Library -> FT_Face -> GLuint -> Atlas
-emptyAtlas lib fce t = Atlas t 0 lib fce mempty (PixelSize 0 0) ""
+emptyAtlas lib fce t = Atlas t 0 lib fce mempty (GlyphSizeInPixels 0 0) ""
 
 
 data AtlasMeasure = AM { amWH      :: V2 Int
                        , amXY      :: V2 Int
                        , rowHeight :: Int
-                       , amMap     :: IntMap (V2 Int)
                        } deriving (Show, Eq)
 
 
 emptyAM :: AtlasMeasure
-emptyAM = AM 0 (V2 1 1) 0 mempty
+emptyAM = AM 0 (V2 1 1) 0
 
 
+-- | The amount of spacing between glyphs rendered into the atlas's texture.
 spacing :: Int
 spacing = 1
 
 
-measure :: FT_Face -> Int -> AtlasMeasure -> Char -> FreeTypeIO AtlasMeasure
-measure fce maxw am@AM{..} char
-  | Just _ <- IM.lookup (fromEnum char) amMap = return am
+-- | Extract the measurements of a character in the FT_Face and append it to
+-- the given AtlasMeasure.
+measure
+  :: FT_Face
+  -> Int
+  -> (IntMap AtlasMeasure, AtlasMeasure)
+  -> Char
+  -> FreeTypeIO (IntMap AtlasMeasure, AtlasMeasure)
+measure fce maxw (prev, am@AM{..}) char
+  -- Skip chars that have already been measured
+  | fromEnum char `IM.member` prev = return (prev, am)
   | otherwise = do
     let V2 x y = amXY
         V2 w h = amWH


@@ 109,7 118,7 @@ measure fce maxw am@AM{..} char
     -- Get the glyph slot
     slot <- liftIO $ peek $ glyph fce
     -- Get the bitmap
-    bmp   <- liftIO $ peek $ bitmap slot
+    bmp <- liftIO $ peek $ bitmap slot
     let bw = fromIntegral $ BM.width bmp
         bh = fromIntegral $ rows bmp
         gotoNextRow = (x + bw + spacing) >= maxw


@@ 121,9 130,8 @@ measure fce maxw am@AM{..} char
         am1 = AM { amWH = V2 nw nh
                  , amXY = V2 nx ny
                  , rowHeight = rh
-                 , amMap = IM.insert (fromEnum char) amXY amMap
                  }
-    return am1
+    return (IM.insert (fromEnum char) am prev, am1)
 
 
 texturize :: IntMap (V2 Int) -> Atlas -> Char -> FreeTypeIO Atlas


@@ 144,7 152,7 @@ texturize xymap atlas@Atlas{..} char
     ftms  <- liftIO $ peek $ metrics slot
     -- Add the metrics to the atlas
     let vecwh = fromIntegral <$> V2 (BM.width bmp) (rows bmp)
-        canon = floor @Double @Int . (* 0.5) . (* 0.015625) . fromIntegral
+        canon = floor @Double @Int . (* 0.015625) . fromIntegral
         vecsz = canon <$> V2 (GM.width ftms) (GM.height ftms)
         vecxb = canon <$> V2 (horiBearingX ftms) (horiBearingY ftms)
         vecyb = canon <$> V2 (vertBearingX ftms) (vertBearingY ftms)


@@ 165,15 173,15 @@ texturize xymap atlas@Atlas{..} char
 -- | Allocate a new 'Atlas'.
 -- When creating a new 'Atlas' you must pass all the characters that you
 -- might need during the life of the 'Atlas'. Character texturization only
--- happens here.
+-- happens once.
 allocAtlas
   :: ( MonadIO m
      , MonadError TypograffitiError m
      )
   => FilePath
-  -- ^ 'FilePath' of the 'Font' to use for this 'Atlas'.
+  -- ^ Path to the font file to use for this Atlas.
   -> GlyphSize
-  -- ^ Size of glyphs in this 'Atlas'
+  -- ^ Size of glyphs in this Atlas.
   -> String
   -- ^ The characters to include in this 'Atlas'.
   -> m Atlas


@@ 181,15 189,14 @@ allocAtlas fontFilePath gs str = do
   e <- liftIO $ runFreeType $ do
     fce <- newFace fontFilePath
     case gs of
-      PixelSize w h -> setPixelSizes fce (2*w) (2*h)
-      CharSize w h dpix dpiy -> setCharSize fce (floor $ 26.6 * 2 * w)
-                                                (floor $ 26.6 * 2 * h)
-                                                dpix dpiy
+      GlyphSizeInPixels w h -> setPixelSizes fce w h
+      GlyphSizeByChar (CharSize w h dpix dpiy) -> setCharSize fce w h dpix dpiy
 
-    AM{..} <- foldM (measure fce 512) emptyAM str
+    (amMap, am) <- foldM (measure fce 512) (mempty, emptyAM) str
 
-    let V2 w h = amWH
-        xymap  = amMap
+    let V2 w h = amWH am
+        xymap :: IntMap (V2 Int)
+        xymap  = amXY <$> amMap
 
     t <- liftIO $ do
       t <- allocAndActivateTex GL_TEXTURE0


@@ 297,10 304,10 @@ makeCharQuad Atlas{..} useKerning penx mLast char = do
     Just (ndx,lndx,True) -> do
       e <- withFreeType (Just atlasLibrary) $
         getKerning atlasFontFace lndx ndx ft_KERNING_DEFAULT
-      return $ either (const penx) ((+penx) . floor . (/(64::Double)) . fromIntegral . fst) e
+      return $ either (const penx) ((+penx) . floor . (* 0.015625) . fromIntegral . fst) e
     _  -> return $ fromIntegral penx
   case IM.lookup ichar atlasMetrics of
-    Nothing -> throwError $ TypograffitiErrorNoGlyphMetricsForChar char -- return (penx, mndx)
+    Nothing -> throwError $ TypograffitiErrorNoGlyphMetricsForChar char
     Just GlyphMetrics{..} -> do
       let V2 dx dy = fromIntegral <$> glyphHoriBearing
           x = fromIntegral px + dx

@@ 210,16 210,6 @@ compileOGLProgram attribs shaders = do
     return program
 
 
-orthoProjection
-  :: Integral a
-  => V2 a
-  -- ^ The window width and height
-  -> M44 Float
-orthoProjection (V2 ww wh) =
-  let (hw,hh) = (fromIntegral ww, fromIntegral wh)
-  in ortho 0 hw hh 0 0 1
-
-
 --------------------------------------------------------------------------------
 -- Uniform marshaling functions
 --------------------------------------------------------------------------------


@@ 326,12 316,24 @@ instance UniformValue (Int,Int) where
 mat4Translate :: Num a => V3 a -> M44 a
 mat4Translate = mkTransformationMat identity
 
+
 mat4Rotate :: (Num a, Epsilon a, Floating a) => a -> V3 a -> M44 a
 mat4Rotate phi v = mkTransformation (axisAngle v phi) (V3 0 0 0)
 
+
 mat4Scale :: Num a => V3 a -> M44 a
 mat4Scale (V3 x y z) =
     V4 (V4 x 0 0 0)
        (V4 0 y 0 0)
        (V4 0 0 z 0)
        (V4 0 0 0 1)
+
+
+orthoProjection
+  :: Integral a
+  => V2 a
+  -- ^ The window width and height
+  -> M44 Float
+orthoProjection (V2 ww wh) =
+  let (hw,hh) = (fromIntegral ww, fromIntegral wh)
+  in ortho 0 hw hh 0 0 1

@@ 4,19 4,43 @@ module Typograffiti.Glyph where
 import Linear
 
 
-data GlyphSize = CharSize Float Float Int Int
-               | PixelSize Int Int
+-- | The size of one freetype font character.
+-- https://www.freetype.org/freetype2/docs/tutorial/step1.html#section-5
+data CharSize = CharSize
+  { charSizeWidth  :: Int
+    -- ^ Width of a character specified in 1/64 of points.
+  , charSizeHeight :: Int
+    -- ^ Height of a character specified in 1/64 of points.
+  , charSizeWidthDPI :: Int
+    -- ^ Horizontal device resolution
+  , charSizeHeightDPI :: Int
+    -- ^ Vertical device resolution
+  } deriving (Show, Eq, Ord)
+
+
+data GlyphSize = GlyphSizeByChar CharSize
+               | GlyphSizeInPixels Int Int
                deriving (Show, Eq, Ord)
 
 
-glyphWidth :: GlyphSize -> Float
-glyphWidth (CharSize x y _ _) = if x == 0 then y else x
-glyphWidth (PixelSize x y)    = fromIntegral $ if x == 0 then y else x
-
-
-glyphHeight :: GlyphSize -> Float
-glyphHeight (CharSize x y _ _) = if y == 0 then x else y
-glyphHeight (PixelSize x y)    = fromIntegral $ if y == 0 then x else y
+pixelWidth :: GlyphSize -> Int
+pixelWidth (GlyphSizeInPixels w h)
+  | w == 0 = h
+  | otherwise = w
+pixelWidth (GlyphSizeByChar (CharSize w h xdpi ydpi)) =
+  let dpi = if xdpi == 0 then ydpi else xdpi
+      sz  = if w == 0 then h else w
+  in round $ fromIntegral sz * fromIntegral dpi / 72
+
+
+pixelHeight :: GlyphSize -> Int
+pixelHeight (GlyphSizeInPixels w h)
+  | h == 0 = w
+  | otherwise = h
+pixelHeight (GlyphSizeByChar (CharSize w h xdpi ydpi)) =
+  let dpi = if ydpi == 0 then xdpi else ydpi
+      sz  = if h == 0 then w else h
+  in round $ fromIntegral sz * fromIntegral dpi / 72
 
 
 -- | https://www.freetype.org/freetype2/docs/tutorial/step2.html

@@ 100,7 100,7 @@ setCharSize ff w h dpix dpiy = runIOErr "ft_Set_Char_Size" $
 
 setPixelSizes :: (MonadIO m, Integral i) => FT_Face -> i -> i -> FreeTypeT m ()
 setPixelSizes ff w h =
-  runIOErr "ft_Set_Pixel_Sizess" $ ft_Set_Pixel_Sizes ff (fromIntegral w) (fromIntegral h)
+  runIOErr "ft_Set_Pixel_Sizes" $ ft_Set_Pixel_Sizes ff (fromIntegral w) (fromIntegral h)
 
 getCharIndex :: (MonadIO m, Integral i)
              => FT_Face -> i -> FreeTypeT m FT_UInt