module Cudd.MTR (
MtrNode(..),
CMtrNode,
mtrAllocNode,
mtrCreateFirstChild,
mtrCreateLastChild,
mtrDeallocNode,
mtrMakeFirstChild,
mtrMakeLastChild,
mtrMakeNextSibling,
mtrPrintGroups,
mtrPrintTree,
mtrMakeGroup,
mtrInitGroupTree,
mtrFindGroup,
mtrDissolveGroup,
MTRType(..)
) where
import System.IO
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Unsafe
data CMtrNode
newtype MtrNode s = MtrNode (Ptr CMtrNode)
foreign import ccall unsafe "Mtr_AllocNode"
c_mtrAllocNode :: IO (Ptr CMtrNode)
mtrAllocNode :: ST s (MtrNode s)
mtrAllocNode = liftM MtrNode $ unsafeIOToST c_mtrAllocNode
foreign import ccall unsafe "Mtr_CreateFirstChild"
c_mtrCreateFirstChild :: Ptr CMtrNode -> IO (Ptr CMtrNode)
mtrCreateFirstChild :: MtrNode s -> ST s (MtrNode s)
mtrCreateFirstChild (MtrNode p) = liftM MtrNode $ unsafeIOToST $ c_mtrCreateFirstChild p
foreign import ccall unsafe "Mtr_CreateLastChild"
c_mtrCreateLastChild :: Ptr CMtrNode -> IO (Ptr CMtrNode)
mtrCreateLastChild :: MtrNode s -> ST s (MtrNode s)
mtrCreateLastChild (MtrNode p) = liftM MtrNode $ unsafeIOToST $ c_mtrCreateLastChild p
foreign import ccall unsafe "Mtr_DeallocNode"
c_mtrDeallocNode :: Ptr CMtrNode -> IO ()
mtrDeallocNode :: MtrNode s -> ST s ()
mtrDeallocNode (MtrNode p) = unsafeIOToST $ c_mtrDeallocNode p
foreign import ccall unsafe "Mtr_MakeFirstChild"
c_mtrMakeFirstChild :: Ptr CMtrNode -> Ptr CMtrNode -> IO ()
mtrMakeFirstChild :: MtrNode s -> MtrNode s -> ST s ()
mtrMakeFirstChild (MtrNode p) (MtrNode c) = unsafeIOToST $ c_mtrMakeFirstChild p c
foreign import ccall unsafe "Mtr_MakeLastChild"
c_mtrMakeLastChild :: Ptr CMtrNode -> Ptr CMtrNode -> IO ()
mtrMakeLastChild :: MtrNode s -> MtrNode s -> ST s ()
mtrMakeLastChild (MtrNode p) (MtrNode c) = unsafeIOToST $ c_mtrMakeLastChild p c
foreign import ccall unsafe "Mtr_MakeNextSibling"
c_mtrMakeNextSibling :: Ptr CMtrNode -> Ptr CMtrNode -> IO ()
mtrMakeNextSibling :: MtrNode s -> MtrNode s -> ST s ()
mtrMakeNextSibling (MtrNode f) (MtrNode s) = unsafeIOToST $ c_mtrMakeNextSibling f s
foreign import ccall unsafe "Mtr_PrintGroups"
c_mtrPrintGroups :: Ptr CMtrNode -> CInt -> IO ()
mtrPrintGroups :: MtrNode s -> Int -> ST s ()
mtrPrintGroups (MtrNode c) s = unsafeIOToST $ c_mtrPrintGroups c (fromIntegral s)
foreign import ccall unsafe "Mtr_PrintTree"
c_mtrPrintTree :: Ptr CMtrNode -> IO ()
mtrPrintTree :: MtrNode s -> ST s ()
mtrPrintTree (MtrNode c) = unsafeIOToST $ c_mtrPrintTree c
foreign import ccall unsafe "Mtr_MakeGroup"
c_mtrMakeGroup :: Ptr CMtrNode -> CInt -> CInt -> CInt -> IO (Ptr CMtrNode)
mtrMakeGroup :: MtrNode s -> Int -> Int -> Int -> ST s (MtrNode s)
mtrMakeGroup (MtrNode r) l s f = liftM MtrNode $ unsafeIOToST $ c_mtrMakeGroup r (fromIntegral l) (fromIntegral s) (fromIntegral f)
foreign import ccall unsafe "Mtr_InitGroupTree"
c_mtrInitGroupTree :: CInt -> CInt -> IO (Ptr CMtrNode)
mtrInitGroupTree :: Int -> Int -> ST s (MtrNode s)
mtrInitGroupTree l s = liftM MtrNode $ unsafeIOToST $ c_mtrInitGroupTree (fromIntegral l) (fromIntegral s)
foreign import ccall unsafe "Mtr_FindGroup"
c_mtrFindGroup :: Ptr CMtrNode -> CUInt -> CUInt -> IO (Ptr CMtrNode)
mtrFindGroup :: MtrNode s -> Int -> Int -> ST s (MtrNode s)
mtrFindGroup (MtrNode m) x y = liftM MtrNode $ unsafeIOToST $ c_mtrFindGroup m (fromIntegral x) (fromIntegral y)
foreign import ccall unsafe "Mtr_DissolveGroup"
c_mtrDissolveGroup :: Ptr CMtrNode -> IO ()
mtrDissolveGroup :: MtrNode s -> ST s ()
mtrDissolveGroup (MtrNode m) = unsafeIOToST $ c_mtrDissolveGroup m
data MTRType = Mtrdefault
| Mtrterminal
| Mtrsoft
| Mtrfixed
| Mtrnewnode
deriving (Show,Eq)
instance Enum MTRType where
succ Mtrdefault = Mtrterminal
succ Mtrterminal = Mtrsoft
succ Mtrsoft = Mtrfixed
succ Mtrfixed = Mtrnewnode
succ Mtrnewnode = error "MTRType.succ: Mtrnewnode has no successor"
pred Mtrterminal = Mtrdefault
pred Mtrsoft = Mtrterminal
pred Mtrfixed = Mtrsoft
pred Mtrnewnode = Mtrfixed
pred Mtrdefault = error "MTRType.pred: Mtrdefault has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from Mtrnewnode
fromEnum Mtrdefault = 0
fromEnum Mtrterminal = 1
fromEnum Mtrsoft = 2
fromEnum Mtrfixed = 4
fromEnum Mtrnewnode = 8
toEnum 0 = Mtrdefault
toEnum 1 = Mtrterminal
toEnum 2 = Mtrsoft
toEnum 4 = Mtrfixed
toEnum 8 = Mtrnewnode
toEnum unmatched = error ("MTRType.toEnum: Cannot match " ++ show unmatched)