{-# LANGUAGE ForeignFunctionInterface #-}

module Gamgine.Font.GLF where
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Control.Applicative ((<$>))


init :: IO ()
init :: IO ()
init = IO ()
c_glfInit


newtype FontId = FontId Int deriving (FontId -> FontId -> Bool
(FontId -> FontId -> Bool)
-> (FontId -> FontId -> Bool) -> Eq FontId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontId -> FontId -> Bool
== :: FontId -> FontId -> Bool
$c/= :: FontId -> FontId -> Bool
/= :: FontId -> FontId -> Bool
Eq, Int -> FontId -> ShowS
[FontId] -> ShowS
FontId -> String
(Int -> FontId -> ShowS)
-> (FontId -> String) -> ([FontId] -> ShowS) -> Show FontId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontId -> ShowS
showsPrec :: Int -> FontId -> ShowS
$cshow :: FontId -> String
show :: FontId -> String
$cshowList :: [FontId] -> ShowS
showList :: [FontId] -> ShowS
Show)

loadFont :: FilePath -> IO FontId
loadFont :: String -> IO FontId
loadFont String
s = do
   String -> (CString -> IO FontId) -> IO FontId
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO FontId) -> IO FontId)
-> (CString -> IO FontId) -> IO FontId
forall a b. (a -> b) -> a -> b
$ \CString
cs -> do
      CInt
ci <- CString -> IO CInt
c_glfLoadFont CString
cs
      FontId -> IO FontId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FontId -> IO FontId) -> (CInt -> FontId) -> CInt -> IO FontId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FontId
FontId (Int -> FontId) -> (CInt -> Int) -> CInt -> FontId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> IO FontId) -> CInt -> IO FontId
forall a b. (a -> b) -> a -> b
$ CInt
ci


setCurrentFont :: FontId -> IO Bool
setCurrentFont :: FontId -> IO Bool
setCurrentFont (FontId Int
id) = do
   CInt
ci <- CInt -> IO CInt
c_glfSetCurrentFont (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
id
   Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
glfOk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ci)


type X = Double
type Y = Double

data Bounds = Bounds {
   Bounds -> (X, X)
min :: (X, Y),
   Bounds -> (X, X)
max :: (X, Y)
   } deriving Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bounds -> ShowS
showsPrec :: Int -> Bounds -> ShowS
$cshow :: Bounds -> String
show :: Bounds -> String
$cshowList :: [Bounds] -> ShowS
showList :: [Bounds] -> ShowS
Show

getStringBounds :: String -> IO Bounds
getStringBounds :: String -> IO Bounds
getStringBounds String
s = do
   String -> (CString -> IO Bounds) -> IO Bounds
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO Bounds) -> IO Bounds)
-> (CString -> IO Bounds) -> IO Bounds
forall a b. (a -> b) -> a -> b
$ \CString
cs ->
      (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO Bounds) -> IO Bounds)
-> (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
cminX ->
      (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO Bounds) -> IO Bounds)
-> (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
cminY ->
      (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO Bounds) -> IO Bounds)
-> (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
cmaxX ->
      (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO Bounds) -> IO Bounds)
-> (Ptr CFloat -> IO Bounds) -> IO Bounds
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
cmaxY -> do
         CString
-> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
c_glfGetStringBounds CString
cs Ptr CFloat
cminX Ptr CFloat
cminY Ptr CFloat
cmaxX Ptr CFloat
cmaxY
         X
minX <- Ptr CFloat -> IO X
peekToFrac Ptr CFloat
cminX
         X
minY <- Ptr CFloat -> IO X
peekToFrac Ptr CFloat
cminY
         X
maxX <- Ptr CFloat -> IO X
peekToFrac Ptr CFloat
cmaxX
         X
maxY <- Ptr CFloat -> IO X
peekToFrac Ptr CFloat
cmaxY
         Bounds -> IO Bounds
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bounds -> IO Bounds) -> Bounds -> IO Bounds
forall a b. (a -> b) -> a -> b
$ (X, X) -> (X, X) -> Bounds
Bounds (X
minX, X
minY) (X
maxX, X
maxY)
   where
      peekToFrac :: Ptr CFloat -> IO X
peekToFrac = (CFloat -> X
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> X) -> IO CFloat -> IO X
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO CFloat -> IO X)
-> (Ptr CFloat -> IO CFloat) -> Ptr CFloat -> IO X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek


drawWiredString :: String -> IO ()
drawWiredString :: String -> IO ()
drawWiredString String
s = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s CString -> IO ()
c_glfDrawWiredString


drawSolidString :: String -> IO ()
drawSolidString :: String -> IO ()
drawSolidString String
s = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s CString -> IO ()
c_glfDrawSolidString



glfError :: Int
glfError :: Int
glfError = -Int
1

glfOk :: Int
glfOk :: Int
glfOk = Int
0

glfYes :: Int
glfYes :: Int
glfYes = Int
1

glfNo :: Int
glfNo :: Int
glfNo = Int
2


foreign import ccall unsafe "glf.h glfInit"
   c_glfInit :: IO ()

foreign import ccall unsafe "glf.h glfLoadFont"
   c_glfLoadFont :: CString -> IO CInt

foreign import ccall unsafe "glf.h glfSetCurrentFont"
   c_glfSetCurrentFont :: CInt -> IO CInt

foreign import ccall unsafe "glf.h glfGetStringBounds"
   c_glfGetStringBounds :: CString -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()

foreign import ccall unsafe "glf.h glfDrawWiredString"
   c_glfDrawWiredString :: CString -> IO ()

foreign import ccall unsafe "glf.h glfDrawSolidString"
   c_glfDrawSolidString :: CString -> IO ()