{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Graphics.Vty.UnicodeWidthTable.Install
( TableInstallException(..)
, installUnicodeWidthTable
, isCustomTableReady
)
where
import Control.Monad (when, forM_)
import qualified Control.Exception as E
import GHC.Conc.Sync (withMVar)
import Control.Concurrent.MVar (MVar, newMVar)
import Data.Word (Word8, Word32)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import System.IO.Unsafe (unsafePerformIO)
import Graphics.Vty.UnicodeWidthTable.Types
installLock :: MVar ()
{-# NOINLINE installLock #-}
installLock :: MVar ()
installLock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
isCustomTableReady :: IO Bool
isCustomTableReady :: IO Bool
isCustomTableReady = IO Bool -> IO Bool
forall a. IO a -> IO a
withInstallLock (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
c_isCustomTableReady
withInstallLock :: IO a -> IO a
withInstallLock :: forall a. IO a -> IO a
withInstallLock IO a
act = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
installLock ((() -> IO a) -> IO a) -> (() -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
act
tableSize :: Int
tableSize :: Int
tableSize = Int
0x110000
data TableInstallException =
TableInitFailure Int Int
| TableRangeFailure Int WidthTableRange
| TableActivationFailure Int
deriving (TableInstallException -> TableInstallException -> Bool
(TableInstallException -> TableInstallException -> Bool)
-> (TableInstallException -> TableInstallException -> Bool)
-> Eq TableInstallException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableInstallException -> TableInstallException -> Bool
== :: TableInstallException -> TableInstallException -> Bool
$c/= :: TableInstallException -> TableInstallException -> Bool
/= :: TableInstallException -> TableInstallException -> Bool
Eq, Int -> TableInstallException -> ShowS
[TableInstallException] -> ShowS
TableInstallException -> String
(Int -> TableInstallException -> ShowS)
-> (TableInstallException -> String)
-> ([TableInstallException] -> ShowS)
-> Show TableInstallException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableInstallException -> ShowS
showsPrec :: Int -> TableInstallException -> ShowS
$cshow :: TableInstallException -> String
show :: TableInstallException -> String
$cshowList :: [TableInstallException] -> ShowS
showList :: [TableInstallException] -> ShowS
Show)
instance E.Exception TableInstallException
installUnicodeWidthTable :: UnicodeWidthTable -> IO ()
installUnicodeWidthTable :: UnicodeWidthTable -> IO ()
installUnicodeWidthTable UnicodeWidthTable
table = IO () -> IO ()
forall a. IO a -> IO a
withInstallLock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
initResult <- Int -> IO Int
initCustomTable Int
tableSize
when (initResult /= 0) $
E.throwIO $ TableInitFailure initResult tableSize
forM_ (unicodeWidthTableRanges table) $ \WidthTableRange
r -> do
result <- Word32 -> Word32 -> Word8 -> IO Int
setCustomTableRange (WidthTableRange -> Word32
rangeStart WidthTableRange
r)
(WidthTableRange -> Word32
rangeSize WidthTableRange
r)
(WidthTableRange -> Word8
rangeColumns WidthTableRange
r)
when (result /= 0) $ do
deallocateCustomTable
E.throwIO $ TableRangeFailure result r
actResult <- activateCustomTable
when (actResult /= 0) $
E.throwIO $ TableActivationFailure actResult
foreign import ccall unsafe "vty_init_custom_table"
initCustomTable :: Int -> IO Int
foreign import ccall unsafe "vty_set_custom_table_range"
setCustomTableRange :: Word32 -> Word32 -> Word8 -> IO Int
foreign import ccall unsafe "vty_activate_custom_table"
activateCustomTable :: IO Int
foreign import ccall unsafe "vty_custom_table_ready"
c_isCustomTableReady :: IO Int
foreign import ccall unsafe "vty_deallocate_custom_table"
deallocateCustomTable :: IO ()