Bitmap font

1 files changed, 49 insertions, 0 deletions

diff --git a/src/Game/BitmapFont.hs b/src/Game/BitmapFont.hs
new file mode 100644
index 0000000..d42f293
--- /dev/null
+++ b/src/Game/BitmapFont.hs
@@ -0,0 +1,49 @@
+module Game.BitmapFont (BitmapFont, load, renderText) where
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Foreign.C.Types (CInt)
+import qualified Game.Utils as U
+import qualified SDL
+import Text.JSON
+
+data FontDesc = FontDesc Int Int (Map Char (SDL.Rectangle CInt))
+
+data BitmapFont = BitmapFont FontDesc SDL.Texture
+
+instance JSON FontDesc where
+  showJSON = undefined
+  readJSON (JSObject obj) = do
+    w <- valFromObj "width" obj
+    h <- valFromObj "height" obj
+    m <- valFromObj "map" obj
+    pure $ FontDesc w h $ Map.fromList (zipWith (curry (toRect w h)) m [0 ..])
+    where
+      -- we store a Map from char to the SDL rect containing the glyph
+      toRect :: Int -> Int -> (Char, Int) -> (Char, SDL.Rectangle CInt)
+      toRect w h (c, i) = (c, U.rect (i * w) 0 w h)
+  readJSON _ = mzero
+
+-- | Load a bitmap font description from a JSON file.
+--
+-- The texture is expected to have the glyphs in a single line plus a special one at the end to be used when a character is not found in the font map.
+load :: String -> SDL.Texture -> IO BitmapFont
+load filename tex = do
+  d <- readFile filename
+  case decode d :: Result FontDesc of
+    Ok desc -> pure $ BitmapFont desc tex
+    Error e -> error e
+
+-- | Render a string at position x, y using the prodided bitmap font.
+renderText :: SDL.Renderer -> BitmapFont -> Int -> Int -> String -> IO ()
+renderText renderer (BitmapFont (FontDesc w h m) tex) x y text = mapM_ renderOne (zip [0 ..] text)
+  where
+    renderOne :: (Int, Char) -> IO ()
+    renderOne (i, c) =
+      SDL.copy renderer tex (Just src) (Just dst)
+      where
+        -- find the glyph or render the special one as error
+        src = fromMaybe (U.rect (length m * w) 0 w h) (Map.lookup c m)
+        dst = U.rect (x + i * w) y w h