gelatin-fruity (empty) → 0.1.0.0

raw patch · 4 files changed

+237/−0 lines, 4 filesdep +FontyFruitydep +basedep +gelatinsetup-changed

Dependencies added: FontyFruity, base, gelatin, linear, vector

Files

LICENSE +30/−0
Setup.hs +2/−0
gelatin-fruity.cabal +33/−0
src/Gelatin/Fruity.hs +172/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Schell Scivally (c) 2016++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 Schell Scivally 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.

+ Setup.hs view

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

+ gelatin-fruity.cabal view

@@ -0,0 +1,33 @@+name:                gelatin-fruity+version:             0.1.0.0+synopsis:            Gelatin's support for rendering TTF outlines, using FontyFruity.+description:         Gelatin's support for rendering TTF outlines, using FontyFruity.+                     Using FontyFruity gelatin can render smooth font geometry without+                     freetype.+homepage:            https://github.com/schell/gelatin-fruity#readme+license:             BSD3+license-file:        LICENSE+author:              Schell Scivally+maintainer:          schell@takt.com+copyright:           Schell Scivally+category:            Graphics+build-type:          Simple+cabal-version:       >=1.10+stability:           experimental++library+  ghc-options:         -Wall+  hs-source-dirs:      src+  exposed-modules:     Gelatin.Fruity++  build-depends:       base                >=4.8  && <4.11+                     , gelatin             >=0.1  && <0.2+                     , FontyFruity         >=0.5  && <0.6+                     , vector              >=0.12 && <0.13+                     , linear              >=1.20 && <1.21++  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/schell/gelatin-fruity

+ src/Gelatin/Fruity.hs view

@@ -0,0 +1,172 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module:     Gelatin.Fruity+-- Copyright:  (c) 2017 Schell Scivally+-- License:    MIT+-- Maintainer: Schell Scivally <schell@takt.com>+--+-- Provides two high-level functions that create gelatin renderers:+--+-- ['coloredString']: font strings filled with color+--+-- ['texturedString']: font strings filled with a texture mapping+--+--+-- Provides one mid-level function for extracting a font outline:+--+-- ['stringOutline']: raw geometry of a font string+--+--+-- For help obtaining a 'Font' within your program, check out+-- 'loadFontFile'.+module Gelatin.Fruity (+  module TT,+  coloredString,+  texturedString,+  stringOutline+) where++import           Gelatin+import           Graphics.Text.TrueType as TT+import           Data.Vector.Unboxed (Vector, Unbox)+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector as B+import           Control.Arrow (first,second)+--------------------------------------------------------------------------------+-- Font decomposition into triangles and beziers+--------------------------------------------------------------------------------+-- | Ephemeral types for creating polygons from font outlines.+-- Fonty gives us a [[Vector (Float, Float)]] for an entire string, which+-- breaks down to+type Contour = Vector (V2 Float) -- Beziers+type CharacterOutline = [Contour]+type StringOutline = [CharacterOutline]++fromFonty :: (Unbox b1, Functor f1, Functor f)+          => (Vector (V2 b1) -> b) -> f (f1 (Vector (b1, b1))) -> f (f1 b)+fromFonty f = fmap $ fmap $ f . V.map (uncurry V2)++-- | Turn a polyline into a list of bezier points.+toBeziers :: (Fractional a, Ord a, Unbox a)+          => Vector (V2 a) -> Vector (Bezier (V2 a))+toBeziers vs =+  V.fromList $ map (\(a,b,c) -> bezier (vs V.! a) (vs V.! b) (vs V.! c)) ndxs+  where ndxs = map f [0 .. nt $ V.length vs -1]+        nt n = max 0 $ ceiling $ (fromIntegral n - 3) / (2 :: Double)+        f i = let a = i * 2+                  b = a + 1+                  c = a + 2+               in (a,b,c)++unBeziers :: (Fractional a, Ord a, Unbox a)+          => Vector (Bezier a)+          -> Vector a+unBeziers = V.concatMap (\(_,a,b,c) -> V.fromList [a,b,c])++fruityBeziers :: [[Vector (Float, Float)]] -> StringOutline+fruityBeziers = fromFonty (unBeziers . toBeziers . V.map (fmap realToFrac))++-- | Collects the points that lie directly on the contour of the font+-- outline.+onContourPoints :: Unbox a => Vector (Bezier a) -> Vector a+onContourPoints = V.concatMap f+  where f (False,a,b,c) = V.fromList [a,b,c]+        f (_,a,_,c) = V.fromList [a,c]+--onContourPoints = V.foldl' f mempty+--  where f bs (False,a,b,c) = bs V.++ V.fromList [a,b,c]+--        f bs (_,a,_,c) = bs V.++ V.fromList [a,c]++stringCurve :: Font -> Int -> Float -> String -> [[Vector (Float, Float)]]+stringCurve font dpi px str = getStringCurveAtPoint dpi (0,0) [(font, sz, str)]+    where --sz = pixelSizeInPointAtDpi px dpi+          sz = PointSize px++-- | Extract the outlines of a given string using a font. Returns a+-- vector of 'RawBeziers' and 'RawTriangles'.+stringOutline+  :: Font+  -- ^ The font to extract geometry from.+  -> Int+  -- ^ The dpi to read the font at.+  -> Float+  -- ^ The target pixel width of the resulting geometry.+  -> String+  -- ^ The string to construct and extract the geometry with.+  -> B.Vector (RawGeometry (V2 Float))+stringOutline font dpi px str =+  B.fromList $ map RawLine $ concat $+    fromFonty (cleanSeqDupes . V.concatMap divide . toBeziers . V.map (fmap realToFrac)) $+      stringCurve font dpi px str+  where divide (_,a,b,c) = subdivideAdaptive 100 0 $ bez3 a b c++fontBezAndTris :: Font -> Int -> Float -> String+               -> (RawGeometry (V2 Float), B.Vector (RawGeometry (V2 Float)))+fontBezAndTris font dpi px str =+    let cs  = stringCurve font dpi px str+        bs  = fruityBeziers cs+        ts  = concatMap (fmap onContourPoints) $ fromFonty (toBeziers . V.map (fmap realToFrac)) cs+    in ( RawBeziers $ V.concat $ concat bs+       , B.map RawTriangleFan $ B.fromList ts+       )++-- | Creates a gelatin Renderer that renders the given string in 2d space.+coloredString+  :: Backend t e (V2 Float, V4 Float) (V2 Float) Float s+  -- ^ A backend for rendering geometry with 'V2V4' vertices.+  -> Font+  -- ^ The font to use.+  -> Int+  -- ^ The dpi to use for reading the font geometry.+  -> Float+  -- ^ Your target pixel width.+  -> String+  -- ^ The string to render.+  -> (V2 Float -> V4 Float)+  -- ^ A function from font geometry/space to color.+  -> IO (Renderer (V2 Float) Float s)+coloredString b font dpi px str fill = do+  let g        = mapRawGeometry h+      h v      = (v, fill v)+      (bs, ts) = second (B.map g) $ first g $ fontBezAndTris font dpi px str++  (_, r1) <- compilePicture b $ do+    setRawGeometry ts+    setRenderingOptions [StencilMaskOption]++  (_, r2) <- compilePicture b $ setRawGeometry $ B.singleton bs++  return $ r1 `mappend` r2++-- | Creates a gelatin Renderer that renders the given string in 2d space,+-- using a given texture.+texturedString+  :: Backend t e (V2 Float, V2 Float) (V2 Float) Float s+  -- ^ A backend for rendering geometry with 'V2V2' vertices.+  -> Font+  -- ^ The font to use.+  -> Int+  -- ^ The dpi to use for reading the font geometry.+  -> Float+  -- ^ Your target pixel width.+  -> String+  -- ^ The string to render.+  -> t+  -- ^ The texture.+  -> (V2 Float -> V2 Float)+  -- ^ A function from font geometry/space to texture mapping (uv coords).+  -> IO (Renderer (V2 Float) Float s)+texturedString b font dpi px str t fill = do+  let g   = mapRawGeometry h+      h v = (v, fill v)+      (bs, ts) = second (B.map g) $ first g $ fontBezAndTris font dpi px str++  (_, r1) <- compilePicture b $ do+    setRawGeometry ts+    setRenderingOptions [StencilMaskOption]+    setTextures [t]++  (_, r2) <- compilePicture b $ do+    setRawGeometry $ B.singleton bs+    setTextures [t]++  return $ r1 `mappend` r2