@@ -9,19 +9,34 @@ where
99
1010import Control.Monad (when, forM_)
1111import qualified Control.Exception as E
12+import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)
1213import Data.Word (Word8, Word32)
1314#if !(MIN_VERSION_base(4,11,0))
1415import Data.Semigroup ((<>))
1516#endif
17+import System.IO.Unsafe (unsafePerformIO)
1618
1719import Graphics.Vty.UnicodeWidthTable.Types
1820
21+-- | The lock used to make functions in this module thread-safe.
22+installLock :: MVar ()
23+{-# NOINLINE installLock #-}
24+installLock = unsafePerformIO $ newMVar ()
25+
1926-- | Returns True if and only if a custom table has been allocated and
2027-- marked as ready for use.
2128--
22−-- This function is not thread-safe.
29+-- This function is thread-safe.
2330isCustomTableReady :: IO Bool
24−isCustomTableReady = (== 1) <$> c_isCustomTableReady
31+isCustomTableReady =
32+ E.bracket takeInstallLock (const releaseInstallLock) $
33+ const $ (== 1) <$> c_isCustomTableReady
34+
35+takeInstallLock :: IO ()
36+takeInstallLock = takeMVar installLock
37+
38+releaseInstallLock :: IO ()
39+releaseInstallLock = putMVar installLock ()
2540
2641-- This is the size of the allocated custom character width table, in
2742-- character slots. It's important that this be large enough to hold all
@@ -79,25 +94,26 @@ instance E.Exception TableInstallException
7994-- installed or is invalid, or if a custom table already exists -- this
8095-- will raise a 'TableInstallException' exception.
8196--
82−-- This function is not thread-safe.
97+-- This function is thread-safe.
8398installUnicodeWidthTable :: UnicodeWidthTable -> IO ()
84−installUnicodeWidthTable table = do
85− initResult <- initCustomTable tableSize
86− when (initResult /= 0) $
87− E.throw $ TableInitFailure initResult tableSize
88−
89− forM_ (unicodeWidthTableRanges table) $ \r -> do
90− result <- setCustomTableRange (rangeStart r)
91− (rangeSize r)
92− (rangeColumns r)
93−
94− when (result /= 0) $ do
95− deallocateCustomTable
96− E.throw $ TableRangeFailure result r
97−
98− actResult <- activateCustomTable
99− when (actResult /= 0) $
100− E.throw $ TableActivationFailure actResult
99+installUnicodeWidthTable table =
100+ E.bracket takeInstallLock (const releaseInstallLock) $ const $ do
101+ initResult <- initCustomTable tableSize
102+ when (initResult /= 0) $
103+ E.throw $ TableInitFailure initResult tableSize
104+
105+ forM_ (unicodeWidthTableRanges table) $ \r -> do
106+ result <- setCustomTableRange (rangeStart r)
107+ (rangeSize r)
108+ (rangeColumns r)
109+
110+ when (result /= 0) $ do
111+ deallocateCustomTable
112+ E.throw $ TableRangeFailure result r
113+
114+ actResult <- activateCustomTable
115+ when (actResult /= 0) $
116+ E.throw $ TableActivationFailure actResult
101117
102118------------------------------------------------------------------------
103119-- C imports