module Graphics.FreeGame.Bitmap (Bitmap, bitmapData, bitmapSize, loadBitmapFromFile, cropBitmap, Font, loadFont, charToBitmap) where
import Control.Applicative
import Codec.Picture.Repa
import Data.Array.Repa as R
import Data.Word
import Data.Array.IArray as A
import qualified Graphics.Rendering.TrueType.STB as TT
newtype Bitmap = Bitmap {
bitmapData :: R.Array D DIM3 Word8
}
bitmapSize :: Bitmap -> (Int, Int)
bitmapSize bmp = let (Z :. h :. w :. _) = R.extent (bitmapData bmp) in (w, h)
loadBitmapFromFile :: FilePath -> IO Bitmap
loadBitmapFromFile path = Bitmap <$> delay <$> imgData <$> either error id <$> readImageRGBA path
cropBitmap :: Bitmap
-> (Int, Int)
-> (Int, Int)
-> Bitmap
cropBitmap (Bitmap img) (w, h) (x, y) = Bitmap $ extract (Z :. y :. x :. 0) (Z :. h :. w :. 4) img
newtype Font = Font TT.BitmapCache
loadFont :: FilePath -> Float -> IO Font
loadFont path size = do
tt <- TT.loadTTF path
o <- head <$> TT.enumerateFonts tt
font <- TT.initFont tt o
Just g <- TT.findGlyph font '|'
TT.BBox (x0,y0) (x1,y1) <- TT.getGlyphBoundingBox font g
let s = size/fromIntegral (x1x0)
Font <$> TT.newBitmapCache font False (s, s)
charToBitmap :: Font -> (Word8, Word8, Word8) -> Char -> IO (Maybe (Bitmap, Float, Float, Float))
charToBitmap (Font cache) (red,green,blue) ch = do
r <- TT.getCachedBitmap cache ch
case r of
Just (TT.CBM bmp@(TT.Bitmap (w,h) _) (ox,oy) (TT.HMetrics adv _)) -> do
ar <- TT.bitmapArray bmp
let pixel (Z:.y:.x:.c) = [ar A.! (y, x), red, green, blue] !! c
return $ Just (Bitmap $ fromFunction (Z :. h :. w :. 4) pixel, fromIntegral ox / 2, fromIntegral oy / 2, adv)
Nothing -> return Nothing