module Text.TeXMath.Unicode.ToTeX ( getTeXMath
, getSymbolType
, records
) where
import qualified Data.Map as M
import Text.TeXMath.TeX
import Text.TeXMath.Types
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Control.Applicative hiding (optional)
import Text.TeXMath.Unicode.ToASCII (getASCII)
import Text.TeXMath.Unicode.ToUnicode (fromUnicodeChar)
import qualified Text.TeXMath.Shared as S
import qualified Control.Applicative as CA
import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe
import Foreign.Storable
import qualified Data.Foldable as F
getTeXMath :: String -> Env -> [TeX]
getTeXMath s e = concatMap (charToString e) s
commandTypes :: [TeXSymbolType]
commandTypes = [Accent, Rad, TOver, TUnder]
charToString :: Env -> Char -> [TeX]
charToString e c =
fromMaybe fallback
(charToLaTeXString e c <|> textConvert e c)
where
fallback = concatMap asciiToLaTeX $ getASCII c
asciiToLaTeX ac = fromMaybe [escapeLaTeX ac] (charToLaTeXString e ac)
charToLaTeXString :: Env -> Char -> Maybe [TeX]
charToLaTeXString environment c = do
v <- M.lookup c recordsMap
let toLit [x] = [Token x]
toLit [] = []
toLit cs = [Literal cs]
let cmds = commands v
raw <- lookup "base" cmds
<|> listToMaybe (mapMaybe (flip lookup cmds) environment)
let latexCommand = if isControlSeq raw
then [ControlSeq raw]
else toLit raw
return $ if category v `elem` commandTypes
then latexCommand ++ [Grouped []]
else latexCommand
textConvert :: Env -> Char -> Maybe [TeX]
textConvert env c = do
(ttype, v) <- fromUnicodeChar c
return [ControlSeq (S.getLaTeXTextCommand env ttype), Grouped [Token v]]
records :: [Record]
records = map snd $ M.toAscList recordsMap
getSymbolType :: Char -> TeXSymbolType
getSymbolType c = fromMaybe Ord (category <$> M.lookup c recordsMap)
foreign import ccall unsafe "&toTexCharIntKey" c_toTexCharIntKey :: Ptr CInt
foreign import ccall unsafe "&char2TexCategory" c_char2TexCategory:: Ptr (Ptr CChar)
foreign import ccall unsafe "&char2TexCommand" c_char2TexCommand :: Ptr (Ptr CChar)
foreign import ccall unsafe "&char2PkgNam" c_char2PkgNam :: Ptr (Ptr CChar)
foreign import ccall unsafe "&char2TexComment" c_char2TexComment :: Ptr (Ptr CChar)
ingestAction :: Storable a => (a -> IO b)-> Ptr a -> Int -> IO b
ingestAction f ptr ix = do pval <- peekElemOff ptr ix; f pval
recordsMap :: M.Map Char Record
recordsMap = F.foldl' (\mp rec -> M.insertWith mergeRecords (uchar rec) rec mp) M.empty $ reverse normalizedRecords
where
mergeRecords :: Record -> Record ->Record
mergeRecords (Record c1 ls1 cat1 comm1) (Record c2 ls2 cat2 comm2)
| c1==c2 && cat1==cat2 && comm1 == comm2= Record c1 (ls1 ++ ls2) cat1 comm1
| c1 /= c2 = error $ "mixed up records for characters "++ show c1 ++ " " ++ show c2
++ " please file a bug report, this is a bug in TexMath"
| otherwise =
error $ "there is data corruption in the records for character, please report the bug! " ++ show c1
normalizedRecords :: [Record]
normalizedRecords = getZipList $ (\uchr cmdL cmdR cat cmmnt-> Record uchr [(cmdL,cmdR)] cat cmmnt )
CA.<$> ZipList recordChars CA.<*> ZipList recordPkgName
CA.<*> ZipList recordCommand CA.<*> ZipList recordTexCategory CA.<*> ZipList recordComment
recordChars :: [Char]
recordChars = unsafePerformIO $
mapM (ingestAction (return.toEnum.fromIntegral) c_toTexCharIntKey) [0 .. 6093]
recordTexCategory :: [TeXSymbolType]
recordTexCategory = unsafePerformIO $ mapM (ingestAction (fmap read.peekCString) c_char2TexCategory) [0.. 6093]
recordComment :: [String]
recordComment = unsafePerformIO $ mapM (ingestAction (peekCString) c_char2TexComment) [0 .. 6093]
recordCommand :: [String]
recordCommand = unsafePerformIO $ mapM (ingestAction (peekCString) c_char2TexCommand) [0 .. 6093]
recordPkgName :: [String ]
recordPkgName = unsafePerformIO $ mapM (ingestAction peekCString c_char2PkgNam) [0.. 6093]