{-# LANGUAGE CPP, OverloadedStrings #-}
#ifdef CALLSTACK_AVAILABLE
{-# LANGUAGE ImplicitParams #-}
#endif

module Graphics.UI.FLTK.LowLevel.Utils where
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
import Data.List
import Data.Maybe
import qualified Data.Text.Foreign as TF
import qualified Data.Text.Encoding as E
import Foreign
import qualified Foreign.Concurrent as FC
import Foreign.C
import qualified Data.ByteString as B
import qualified System.IO.Unsafe as Unsafe
import Debug.Trace
#if defined(CALLSTACK_AVAILABLE) || defined(HASCALLSTACK_AVAILABLE)
import GHC.Stack
#endif

foreign import ccall "wrapper"
        mkWidgetCallbackPtr :: CallbackWithUserDataPrim -> IO (FunPtr CallbackWithUserDataPrim)
foreign import ccall "wrapper"
        mkCallbackPtr :: CallbackPrim -> IO (FunPtr CallbackPrim)
foreign import ccall "wrapper"
        mkOpenCallbackPtr :: OpenCallbackPrim -> IO (FunPtr OpenCallbackPrim)
foreign import ccall "wrapper"
        mkCustomColorAveragePtr :: CustomColorAveragePrim -> IO (FunPtr CustomColorAveragePrim)
foreign import ccall "wrapper"
        mkGlobalEventHandlerPtr :: GlobalEventHandlerPrim -> IO (FunPtr GlobalEventHandlerPrim)
foreign import ccall "wrapper"
        mkDrawCallbackPrimPtr :: DrawCallbackPrim -> IO (FunPtr DrawCallbackPrim)
foreign import ccall "wrapper"
        mkCustomImageDrawPrimPtr :: CustomImageDrawPrim -> IO (FunPtr CustomImageDrawPrim)
foreign import ccall "wrapper"
        mkCustomImageCopyPrimPtr :: CustomImageCopyPrim -> IO (FunPtr CustomImageCopyPrim)
foreign import ccall "wrapper"
        mkUnfinishedStyleCbPrim :: UnfinishedStyleCbPrim -> IO (FunPtr UnfinishedStyleCbPrim)
foreign import ccall "wrapper"
        mkFinalizer :: (Ptr a -> IO ()) -> IO (FinalizerPtr a)
foreign import ccall "wrapper"
        mkFinalizerEnv :: (Ptr env -> Ptr a -> IO ()) -> IO (FinalizerEnvPtr env a)
foreign import ccall "wrapper"
        wrapBoxDrawFPrim :: BoxDrawFPrim -> IO (FunPtr BoxDrawFPrim)
foreign import ccall "dynamic"
        unwrapGlobalCallbackPtr :: FunPtr GlobalCallback -> GlobalCallback
foreign import ccall "dynamic"
        unwrapBoxDrawFPrim :: FunPtr BoxDrawFPrim -> BoxDrawFPrim
foreign import ccall "wrapper"
        mkTextModifyCb :: TextModifyCbPrim -> IO (FunPtr TextModifyCbPrim)
foreign import ccall "wrapper"
        mkTextPredeleteCb :: TextPredeleteCbPrim -> IO (FunPtr TextPredeleteCbPrim)
foreign import ccall "wrapper"
        mkFDHandlerPrim :: FDHandlerPrim -> IO (FunPtr FDHandlerPrim)
foreign import ccall "wrapper"
        mkGlobalCallbackPtr:: GlobalCallback -> IO (FunPtr GlobalCallback)
foreign import ccall "wrapper"
        mkMenuItemDrawFPtr :: MenuItemDrawF -> IO (FunPtr MenuItemDrawF)
foreign import ccall "wrapper"
        mkTabPositionsPrim :: TabPositionsPrim -> IO (FunPtr TabPositionsPrim)
foreign import ccall "wrapper"
        mkTabHeightPrim :: TabHeightPrim -> IO (FunPtr TabHeightPrim)
foreign import ccall "wrapper"
        mkTabWhichPrim :: TabWhichPrim -> IO (FunPtr TabWhichPrim)
foreign import ccall "wrapper"
        mkTabClientAreaPrim :: TabClientAreaPrim -> IO (FunPtr TabClientAreaPrim)
foreign import ccall "wrapper"
        mkGetDouble :: GetDoublePrim -> IO (FunPtr GetDoublePrim)
foreign import ccall "wrapper"
        mkGetInt :: GetIntPrim -> IO (FunPtr GetIntPrim)
foreign import ccall "wrapper"
        mkSetInt :: SetIntPrim -> IO (FunPtr SetIntPrim)
foreign import ccall "wrapper"
        mkColorSetPrim :: ColorSetPrim -> IO (FunPtr ColorSetPrim)
foreign import ccall "wrapper"
        mkDestroyCallbacksPtr :: DestroyCallbacksPrim -> IO (FunPtr DestroyCallbacksPrim)

toTabPositionsPrim :: (Ref a -> IO (Maybe AtIndex, Int, [(X,Width)])) -> IO (FunPtr TabPositionsPrim)
toTabPositionsPrim :: (Ref a -> IO (Maybe AtIndex, Int, [(X, Width)]))
-> IO (FunPtr TabPositionsPrim)
toTabPositionsPrim f :: Ref a -> IO (Maybe AtIndex, Int, [(X, Width)])
f =
  TabPositionsPrim -> IO (FunPtr TabPositionsPrim)
mkTabPositionsPrim (\tabPtr :: Ptr ()
tabPtr posPtr :: Ptr CInt
posPtr widthPtr :: Ptr CInt
widthPtr -> do
                          ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
tabPtr "Null pointer. toTabPositionsPrim"
                          (selected :: Maybe AtIndex
selected, padding :: Int
padding, posAndWidths :: [(X, Width)]
posAndWidths) <- Ref a -> IO (Maybe AtIndex, Int, [(X, Width)])
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp))
                          Ptr CInt -> [CInt] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CInt
posPtr ([Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding] [CInt] -> [CInt] -> [CInt]
forall a. [a] -> [a] -> [a]
++ (((X, Width) -> CInt) -> [(X, Width)] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map (\(X x :: Int
x,_) -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) [(X, Width)]
posAndWidths))
                          Ptr CInt -> [CInt] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CInt
widthPtr (((X, Width) -> CInt) -> [(X, Width)] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map (\(_,Width w :: Int
w) -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) [(X, Width)]
posAndWidths)
                          IO CInt -> (AtIndex -> IO CInt) -> Maybe AtIndex -> IO CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (0 :: CInt)) (\(AtIndex i :: Int
i) -> CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) Maybe AtIndex
selected
                      )

toTabHeightPrim ::
  (Ref a -> IO Height) ->
  IO (FunPtr TabHeightPrim)
toTabHeightPrim :: (Ref a -> IO Height) -> IO (FunPtr TabHeightPrim)
toTabHeightPrim f :: Ref a -> IO Height
f =
  TabHeightPrim -> IO (FunPtr TabHeightPrim)
mkTabHeightPrim (\ptr :: Ptr ()
ptr -> do
                       ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
ptr "Null pointer. toTabHeightPrim"
                       (Height res :: Int
res) <- Ref a -> IO Height
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp))
                       CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res)
                   )

toCallbackPrim :: (Ref a -> IO ()) ->
                  IO (FunPtr (Ptr () -> IO ()))
toCallbackPrim :: (Ref a -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
toCallbackPrim f :: Ref a -> IO ()
f = (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
mkCallbackPtr ((Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ())))
-> (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ()
ptr -> do
  ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
ptr "Null pointer. toCallbackPrim"
  Ref a -> IO ()
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp))

toCallbackPrimWithUserData :: (Ref a -> IO ()) ->
                              IO (FunPtr (Ptr () -> Ptr () -> IO ()))
toCallbackPrimWithUserData :: (Ref a -> IO ()) -> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
toCallbackPrimWithUserData f :: Ref a -> IO ()
f = (Ptr () -> Ptr () -> IO ())
-> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
mkWidgetCallbackPtr ((Ptr () -> Ptr () -> IO ())
 -> IO (FunPtr (Ptr () -> Ptr () -> IO ())))
-> (Ptr () -> Ptr () -> IO ())
-> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ()
ptr _ -> do
  ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
ptr "Null pointer: toWidgetCallbackPrim"
  Ref a -> IO ()
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp))

toDestroyCallbacksPrim ::
  (Ref a -> [Maybe (FunPtr (IO ()))] -> IO ()) ->
  IO (FunPtr DestroyCallbacksPrim)
toDestroyCallbacksPrim :: (Ref a -> [Maybe (FunPtr (IO ()))] -> IO ())
-> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
toDestroyCallbacksPrim f :: Ref a -> [Maybe (FunPtr (IO ()))] -> IO ()
f =
  let marshalFps :: Ptr (FunPtr (IO ())) -> CInt -> [Maybe (FunPtr (IO ()))] -> IO [Maybe (FunPtr (IO ()))]
      marshalFps :: Ptr (FunPtr (IO ()))
-> CInt -> [Maybe (FunPtr (IO ()))] -> IO [Maybe (FunPtr (IO ()))]
marshalFps arrayPtr :: Ptr (FunPtr (IO ()))
arrayPtr numLeft :: CInt
numLeft accum :: [Maybe (FunPtr (IO ()))]
accum =
        if (CInt
numLeft CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0) then [Maybe (FunPtr (IO ()))] -> IO [Maybe (FunPtr (IO ()))]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe (FunPtr (IO ()))]
accum
        else do
          FunPtr (IO ())
fp <- Ptr (FunPtr (IO ())) -> IO (FunPtr (IO ()))
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr (IO ()))
arrayPtr
          Ptr (FunPtr (IO ()))
-> CInt -> [Maybe (FunPtr (IO ()))] -> IO [Maybe (FunPtr (IO ()))]
marshalFps
            (Ptr (FunPtr (IO ()))
arrayPtr Ptr (FunPtr (IO ())) -> Int -> Ptr (FunPtr (IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (FunPtr (IO ()) -> Int
forall a. Storable a => a -> Int
sizeOf (FunPtr (IO ())
forall a. HasCallStack => a
undefined :: FunPtr (IO ()))))
            (CInt
numLeft CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 1)
            (if (FunPtr (IO ())
fp FunPtr (IO ()) -> FunPtr (IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr (IO ())
forall a. FunPtr a
nullFunPtr)
             then  ([Maybe (FunPtr (IO ()))]
accum [Maybe (FunPtr (IO ()))]
-> [Maybe (FunPtr (IO ()))] -> [Maybe (FunPtr (IO ()))]
forall a. [a] -> [a] -> [a]
++ [Maybe (FunPtr (IO ()))
forall a. Maybe a
Nothing])
             else ([Maybe (FunPtr (IO ()))]
accum [Maybe (FunPtr (IO ()))]
-> [Maybe (FunPtr (IO ()))] -> [Maybe (FunPtr (IO ()))]
forall a. [a] -> [a] -> [a]
++ [FunPtr (IO ()) -> Maybe (FunPtr (IO ()))
forall a. a -> Maybe a
Just FunPtr (IO ())
fp]))
  in
  (Ptr () -> Ptr () -> IO ())
-> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
mkDestroyCallbacksPtr ((Ptr () -> Ptr () -> IO ())
 -> IO (FunPtr (Ptr () -> Ptr () -> IO ())))
-> (Ptr () -> Ptr () -> IO ())
-> IO (FunPtr (Ptr () -> Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ()
ptr fpts :: Ptr ()
fpts -> do
    ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
ptr "Null pointer. toDestroyCallbacksPrim"
    (numFps :: CInt
numFps, fpArray :: Ptr (FunPtr (IO ()))
fpArray) <- Ptr () -> IO (CInt, Ptr (FunPtr (IO ())))
unpackFunctionPointerToFreeStruct Ptr ()
fpts
    [Maybe (FunPtr (IO ()))]
cbs <- Ptr (FunPtr (IO ()))
-> CInt -> [Maybe (FunPtr (IO ()))] -> IO [Maybe (FunPtr (IO ()))]
marshalFps Ptr (FunPtr (IO ()))
fpArray CInt
numFps []
    Ref a -> [Maybe (FunPtr (IO ()))] -> IO ()
f (Ref Any -> Ref a
forall a r. Ref a -> Ref r
castTo (ForeignPtr (Ptr ()) -> Ref Any
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp)) [Maybe (FunPtr (IO ()))]
cbs

cFromEnum :: (Enum a, Integral b) => a -> b
cFromEnum :: a -> b
cFromEnum = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
cToEnum :: (Integral b, Enum a) => b -> a
cToEnum :: b -> a
cToEnum = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (b -> Int) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
cToBool :: (Eq a, Num a, Ord a) => a -> Bool
cToBool :: a -> Bool
cToBool status :: a
status =
  if (a
status a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
  then Bool
True
  else Bool
False

cFromBool :: (Eq a, Num a) => Bool -> a
cFromBool :: Bool -> a
cFromBool status :: Bool
status = if Bool
status then 1 else 0

toFunPtr :: (a -> FunPtr a) -> a -> FunPtr a
toFunPtr :: (a -> FunPtr a) -> a -> FunPtr a
toFunPtr f :: a -> FunPtr a
f a :: a
a = a -> FunPtr a
f a
a

extract :: (Enum a) => [a] -> CInt -> [a]
extract :: [a] -> CInt -> [a]
extract allCodes :: [a]
allCodes compoundCode :: CInt
compoundCode
    = (CInt -> a) -> [CInt] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> a
forall b a. (Integral b, Enum a) => b -> a
cToEnum ([CInt] -> [a]) -> [CInt] -> [a]
forall a b. (a -> b) -> a -> b
$
      (CInt -> Bool) -> [CInt] -> [CInt]
forall a. (a -> Bool) -> [a] -> [a]
filter (CInt -> CInt -> Bool
masks CInt
compoundCode) ([CInt] -> [CInt]) -> [CInt] -> [CInt]
forall a b. (a -> b) -> a -> b
$
      (a -> CInt) -> [a] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map a -> CInt
forall a b. (Enum a, Integral b) => a -> b
cFromEnum [a]
allCodes

combine :: (Enum a, Ord a) => [a] -> Int
combine :: [a] -> Int
combine = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> ([a] -> a) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
head) ([[a]] -> [Int]) -> ([a] -> [[a]]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

masks :: CInt -> CInt -> Bool
masks :: CInt -> CInt -> Bool
masks compoundCode :: CInt
compoundCode code :: CInt
code = (CInt
compoundCode CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
code) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
code

keySequenceToCInt :: [EventState] -> KeyType -> CInt
keySequenceToCInt :: [EventState] -> KeyType -> CInt
keySequenceToCInt modifiers :: [EventState]
modifiers char :: KeyType
char =
  let charCode :: CInt
charCode = case KeyType
char of
        SpecialKeyType c' :: SpecialKey
c' -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ SpecialKey -> Int
forall a. Enum a => a -> Int
fromEnum SpecialKey
c'
        NormalKeyType c' :: Char
c' -> CChar -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CChar -> CInt) -> CChar -> CInt
forall a b. (a -> b) -> a -> b
$ Char -> CChar
castCharToCChar Char
c'
    in (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [EventState] -> Int
forall a. (Enum a, Ord a) => [a] -> Int
combine [EventState]
modifiers) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
charCode

cIntToKeySequence :: CInt -> Maybe ShortcutKeySequence
cIntToKeySequence :: CInt -> Maybe ShortcutKeySequence
cIntToKeySequence i :: CInt
i =
  let evs :: [EventState]
evs = [EventState] -> CInt -> [EventState]
forall a. Enum a => [a] -> CInt -> [a]
extract [EventState]
allEventStates CInt
i
      masked :: CInt
masked = (CInt
i CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ KeyboardKeyMask -> Int
forall a. Enum a => a -> Int
fromEnum KeyboardKeyMask
Kb_KeyMask))
      special :: [SpecialKey]
special = (CInt -> SpecialKey) -> [CInt] -> [SpecialKey]
forall a b. (a -> b) -> [a] -> [b]
map CInt -> SpecialKey
forall b a. (Integral b, Enum a) => b -> a
cToEnum ([CInt] -> [SpecialKey]) -> [CInt] -> [SpecialKey]
forall a b. (a -> b) -> a -> b
$ (CInt -> Bool) -> [CInt] -> [CInt]
forall a. (a -> Bool) -> [a] -> [a]
filter (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
(==) CInt
masked) [CInt]
allShortcutSpecialKeys
  in
    if (CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
    then Maybe ShortcutKeySequence
forall a. Maybe a
Nothing
    else if ([SpecialKey] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SpecialKey]
special)
         then ShortcutKeySequence -> Maybe ShortcutKeySequence
forall a. a -> Maybe a
Just ([EventState] -> KeyType -> ShortcutKeySequence
ShortcutKeySequence [EventState]
evs (Char -> KeyType
NormalKeyType (Char -> KeyType) -> Char -> KeyType
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
masked))
         else ShortcutKeySequence -> Maybe ShortcutKeySequence
forall a. a -> Maybe a
Just ([EventState] -> KeyType -> ShortcutKeySequence
ShortcutKeySequence [EventState]
evs (SpecialKey -> KeyType
SpecialKeyType (SpecialKey -> KeyType) -> SpecialKey -> KeyType
forall a b. (a -> b) -> a -> b
$ [SpecialKey] -> SpecialKey
forall a. [a] -> a
head [SpecialKey]
special))

#ifdef CALLSTACK_AVAILABLE
wrapNonNull :: (?loc :: CallStack) => Ptr a -> String -> IO (ForeignPtr (Ptr a))
#elif defined(HASCALLSTACK_AVAILABLE)
wrapNonNull :: (HasCallStack) => Ptr a -> String -> IO (ForeignPtr (Ptr a))
#else
wrapNonNull :: Ptr a -> String -> IO (ForeignPtr (Ptr a))
#endif
wrapNonNull :: Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull ptr :: Ptr a
ptr msg :: String
msg = if (Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr)
                      then String -> IO (ForeignPtr (Ptr a))
forall a. HasCallStack => String -> a
error String
msg
                      else do
                        Ptr (Ptr a)
pptr <- IO (Ptr (Ptr a))
forall a. Storable a => IO (Ptr a)
malloc
                        Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
pptr Ptr a
ptr
                        Ptr (Ptr a) -> IO () -> IO (ForeignPtr (Ptr a))
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
FC.newForeignPtr Ptr (Ptr a)
pptr (Ptr (Ptr a) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr a)
pptr)


toGlobalEventHandlerPrim :: GlobalEventHandlerF -> IO (FunPtr GlobalEventHandlerPrim)
toGlobalEventHandlerPrim :: GlobalEventHandlerF -> IO (FunPtr (CInt -> IO CInt))
toGlobalEventHandlerPrim f :: GlobalEventHandlerF
f = (CInt -> IO CInt) -> IO (FunPtr (CInt -> IO CInt))
mkGlobalEventHandlerPtr
                             (\eventNumber :: CInt
eventNumber ->
                                let event :: Event
event = CInt -> Event
forall b a. (Integral b, Enum a) => b -> a
cToEnum (CInt
eventNumber :: CInt)
                                in GlobalEventHandlerF
f Event
event IO Int -> (Int -> IO CInt) -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> (Int -> CInt) -> Int -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

toGlobalCallbackPrim :: GlobalCallback -> IO (FunPtr CallbackPrim)
toGlobalCallbackPrim :: IO () -> IO (FunPtr (Ptr () -> IO ()))
toGlobalCallbackPrim f :: IO ()
f = (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
mkCallbackPtr (\_ -> IO ()
f)

toDrawCallback :: DrawCallback -> IO (FunPtr DrawCallbackPrim)
toDrawCallback :: DrawCallback -> IO (FunPtr DrawCallbackPrim)
toDrawCallback f :: DrawCallback
f = DrawCallbackPrim -> IO (FunPtr DrawCallbackPrim)
mkDrawCallbackPrimPtr
                   (\string' :: CString
string' length' :: CInt
length' x' :: CInt
x' y' :: CInt
y' -> do
                      Text
str' <- CStringLen -> IO Text
TF.peekCStringLen (CString
string', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
length')
                      DrawCallback
f Text
str' (X -> Y -> Position
Position (Int -> X
X (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x')) (Int -> Y
Y (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y'))))

toBoxDrawF :: BoxDrawFPrim -> BoxDrawF
toBoxDrawF :: BoxDrawFPrim -> BoxDrawF
toBoxDrawF boxDrawPrim :: BoxDrawFPrim
boxDrawPrim =
    (\r :: Rectangle
r c :: Color
c ->
       let (x_pos :: Int
x_pos,y_pos :: Int
y_pos,width :: Int
width,height :: Int
height) = Rectangle -> (Int, Int, Int, Int)
fromRectangle Rectangle
r
           colorPrim :: CUInt
colorPrim = Color -> CUInt
cFromColor Color
c
       in
         BoxDrawFPrim
boxDrawPrim ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x_pos) :: CInt)
                     ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y_pos) :: CInt)
                     ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) :: CInt)
                     ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) :: CInt)
                     CUInt
colorPrim
    )

toBoxDrawFPrim :: BoxDrawF -> BoxDrawFPrim
toBoxDrawFPrim :: BoxDrawF -> BoxDrawFPrim
toBoxDrawFPrim f :: BoxDrawF
f =
    (\xPrim :: CInt
xPrim yPrim :: CInt
yPrim wPrim :: CInt
wPrim hPrim :: CInt
hPrim colorPrim :: CUInt
colorPrim ->
       let r :: Rectangle
r = (Int, Int, Int, Int) -> Rectangle
toRectangle (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
xPrim,
                            CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
yPrim,
                            CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
wPrim,
                            CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
hPrim)
           c :: Color
c = CUInt -> Color
cToColor CUInt
colorPrim
       in
           BoxDrawF
f Rectangle
r Color
c)

toTextModifyCbPrim :: TextModifyCb -> IO (FunPtr TextModifyCbPrim)
toTextModifyCbPrim :: TextModifyCb -> IO (FunPtr TextModifyCbPrim)
toTextModifyCbPrim f :: TextModifyCb
f =
  TextModifyCbPrim -> IO (FunPtr TextModifyCbPrim)
mkTextModifyCb
    (
      \pos' :: CInt
pos' nInserted' :: CInt
nInserted' nDeleted' :: CInt
nDeleted' nRestyled' :: CInt
nRestyled' stringPtr :: CString
stringPtr _ ->
       HasCallStack => CString -> IO Text
CString -> IO Text
cStringToText CString
stringPtr IO Text -> (Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \deletedText :: Text
deletedText ->
       TextModifyCb
f (Int -> AtIndex
AtIndex (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pos'))
         (Int -> NumInserted
NumInserted (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nInserted'))
         (Int -> NumDeleted
NumDeleted (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nDeleted'))
         (Int -> NumRestyled
NumRestyled (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nRestyled'))
         (Text -> DeletedText
DeletedText Text
deletedText)
    )

toTextPredeleteCbPrim :: TextPredeleteCb -> IO (FunPtr TextPredeleteCbPrim)
toTextPredeleteCbPrim :: TextPredeleteCb -> IO (FunPtr TextPredeleteCbPrim)
toTextPredeleteCbPrim f :: TextPredeleteCb
f =
  TextPredeleteCbPrim -> IO (FunPtr TextPredeleteCbPrim)
mkTextPredeleteCb
    (
      \pos' :: CInt
pos' nDeleted' :: CInt
nDeleted' _ ->
       TextPredeleteCb
f (Int -> AtIndex
AtIndex (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pos')) (Int -> NumDeleted
NumDeleted (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nDeleted'))
    )

toFDHandlerPrim :: FDHandler -> IO (FunPtr FDHandlerPrim)
toFDHandlerPrim :: FDHandler -> IO (FunPtr FDHandlerPrim)
toFDHandlerPrim f :: FDHandler
f = FDHandlerPrim -> IO (FunPtr FDHandlerPrim)
mkFDHandlerPrim (\fd :: CInt
fd _ -> FDHandler
f (CInt -> FlSocket
FlSocket CInt
fd))

toUnfinishedStyleCbPrim :: UnfinishedStyleCb -> IO (FunPtr UnfinishedStyleCbPrim)
toUnfinishedStyleCbPrim :: UnfinishedStyleCb -> IO (FunPtr FDHandlerPrim)
toUnfinishedStyleCbPrim f :: UnfinishedStyleCb
f =
    FDHandlerPrim -> IO (FunPtr FDHandlerPrim)
mkUnfinishedStyleCbPrim
     (
       \pos' :: CInt
pos' _ -> UnfinishedStyleCb
f (Int -> AtIndex
AtIndex (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pos'))
     )

orNullFunPtr :: (a -> IO (FunPtr b)) -> Maybe a -> IO (FunPtr b)
orNullFunPtr :: (a -> IO (FunPtr b)) -> Maybe a -> IO (FunPtr b)
orNullFunPtr = IO (FunPtr b) -> (a -> IO (FunPtr b)) -> Maybe a -> IO (FunPtr b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FunPtr b -> IO (FunPtr b)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr b
forall a. FunPtr a
nullFunPtr)

arrayToRefs:: (Ptr (Ptr ())) -> Int -> IO [(Ref a)]
arrayToRefs :: Ptr (Ptr ()) -> Int -> IO [Ref a]
arrayToRefs arrayPtr :: Ptr (Ptr ())
arrayPtr numElements :: Int
numElements =
    Ptr (Ptr ()) -> Int -> [Ref a] -> IO [Ref a]
forall t a.
(Eq t, Num t) =>
Ptr (Ptr ()) -> t -> [Ref a] -> IO [Ref a]
go Ptr (Ptr ())
arrayPtr Int
numElements []
    where
      go :: Ptr (Ptr ()) -> t -> [Ref a] -> IO [Ref a]
go _ 0 accum :: [Ref a]
accum =  [Ref a] -> IO [Ref a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ref a]
accum
      go currPtr :: Ptr (Ptr ())
currPtr numLeft :: t
numLeft accum :: [Ref a]
accum = do
        Ptr ()
curr <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
currPtr
        Ref a
ref <- Ptr () -> IO (Ref a)
forall a. Ptr () -> IO (Ref a)
toRef Ptr ()
curr
        Ptr (Ptr ()) -> t -> [Ref a] -> IO [Ref a]
go (Ptr (Ptr ())
currPtr Ptr (Ptr ()) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Ptr (Ptr Any) -> Int
forall a. Storable a => a -> Int
sizeOf (forall a. Ptr (Ptr a)
forall a. HasCallStack => a
undefined :: Ptr (Ptr a))))
           (t
numLeft t -> t -> t
forall a. Num a => a -> a -> a
- 1)
           ([Ref a]
accum [Ref a] -> [Ref a] -> [Ref a]
forall a. [a] -> [a] -> [a]
++ [Ref a
ref])

staticArrayToRefs:: (Ptr ()) -> Int -> IO [(Ref a)]
staticArrayToRefs :: Ptr () -> Int -> IO [Ref a]
staticArrayToRefs arrayPtr :: Ptr ()
arrayPtr numElements :: Int
numElements =
    Ptr () -> Int -> [Ref a] -> IO [Ref a]
forall t a. (Eq t, Num t) => Ptr () -> t -> [Ref a] -> IO [Ref a]
go Ptr ()
arrayPtr Int
numElements []
    where
      go :: Ptr () -> t -> [Ref a] -> IO [Ref a]
go _ 0 accum :: [Ref a]
accum =  [Ref a] -> IO [Ref a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ref a]
accum
      go currPtr :: Ptr ()
currPtr numLeft :: t
numLeft accum :: [Ref a]
accum = do
        let nextPtr :: Ptr ()
nextPtr = Ptr ()
currPtr Ptr () -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Ptr Any -> Int
forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
forall a. HasCallStack => a
undefined :: Ptr a))
        Ref a
ref <- Ptr () -> IO (Ref a)
forall a. Ptr () -> IO (Ref a)
toRef Ptr ()
currPtr
        Ptr () -> t -> [Ref a] -> IO [Ref a]
go Ptr ()
nextPtr
           (t
numLeft t -> t -> t
forall a. Num a => a -> a -> a
- 1)
           ([Ref a]
accum [Ref a] -> [Ref a] -> [Ref a]
forall a. [a] -> [a] -> [a]
++ [Ref a
ref])

refOrError :: String -> Ptr () -> IO (Ref b)
refOrError :: String -> Ptr () -> IO (Ref b)
refOrError errorMessage :: String
errorMessage p :: Ptr ()
p = Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
p String
errorMessage IO (ForeignPtr (Ptr ()))
-> (ForeignPtr (Ptr ()) -> IO (Ref b)) -> IO (Ref b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                               Ref b -> IO (Ref b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref b -> IO (Ref b))
-> (ForeignPtr (Ptr ()) -> Ref b)
-> ForeignPtr (Ptr ())
-> IO (Ref b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr (Ptr ()) -> Ref b
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef
toShortcut :: [KeyType] -> FlShortcut
toShortcut :: [KeyType] -> CUInt
toShortcut =
  Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> ([KeyType] -> Int) -> [KeyType] -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([KeyType] -> [Int]) -> [KeyType] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (KeyType -> Int) -> [KeyType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
   (\k :: KeyType
k -> case KeyType
k of
     (SpecialKeyType sk' :: SpecialKey
sk') -> SpecialKey -> Int
forall a. Enum a => a -> Int
fromEnum SpecialKey
sk'
     (NormalKeyType c' :: Char
c') -> Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c'
   )

cToKeyType :: CInt -> KeyType
cToKeyType :: CInt -> KeyType
cToKeyType cint :: CInt
cint =
  let findSpecialKey :: Maybe SpecialKey
findSpecialKey = (SpecialKey -> Bool) -> [SpecialKey] -> Maybe SpecialKey
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                        (\sk :: SpecialKey
sk -> CInt
cint CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ SpecialKey -> Int
forall a. Enum a => a -> Int
fromEnum SpecialKey
sk))
                        [SpecialKey]
allSpecialKeys
  in
  case Maybe SpecialKey
findSpecialKey of
    Just sk :: SpecialKey
sk -> SpecialKey -> KeyType
SpecialKeyType SpecialKey
sk
    Nothing -> if CInt
cint CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10FFFF
               then Char -> KeyType
NormalKeyType (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint)
               else SpecialKey -> KeyType
SpecialKeyType SpecialKey
Kb_Unrecognized

cFromKeyType :: KeyType -> CInt
cFromKeyType :: KeyType -> CInt
cFromKeyType kt :: KeyType
kt = case KeyType
kt of
  SpecialKeyType sk :: SpecialKey
sk -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ SpecialKey -> Int
forall a. Enum a => a -> Int
fromEnum SpecialKey
sk
  NormalKeyType nk :: Char
nk -> Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
nk

toRef ::  Ptr () -> IO (Ref a)
toRef :: Ptr () -> IO (Ref a)
toRef ptr :: Ptr ()
ptr = IO (Ref a) -> IO (Ref a)
forall a. IO a -> IO a
throwStackOnError (IO (Ref a) -> IO (Ref a)) -> IO (Ref a) -> IO (Ref a)
forall a b. (a -> b) -> a -> b
$
                  do
                    ForeignPtr (Ptr ())
pp <- Ptr () -> String -> IO (ForeignPtr (Ptr ()))
forall a.
HasCallStack =>
Ptr a -> String -> IO (ForeignPtr (Ptr a))
wrapNonNull Ptr ()
ptr "Null Pointer Error"
                    let result :: Ref a
result = ForeignPtr (Ptr ()) -> Ref a
forall a. ForeignPtr (Ptr ()) -> Ref a
wrapInRef ForeignPtr (Ptr ())
pp
                    Ref a -> IO (Ref a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref a -> IO (Ref a)) -> Ref a -> IO (Ref a)
forall a b. (a -> b) -> a -> b
$ Ref a
result

#ifdef CALLSTACK_AVAILABLE
cStringToText :: (?loc :: CallStack) => CString -> IO T.Text
#elif defined(HASCALLSTACK_AVAILABLE)
cStringToText :: (HasCallStack) => CString -> IO T.Text
#else
cStringToText :: CString -> IO T.Text
#endif
cStringToText :: CString -> IO Text
cStringToText = (Maybe Text -> Text) -> IO (Maybe Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "") (IO (Maybe Text) -> IO Text)
-> (CString -> IO (Maybe Text)) -> CString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => CString -> IO (Maybe Text)
CString -> IO (Maybe Text)
cStringToMaybeText

#ifdef CALLSTACK_AVAILABLE
cStringToMaybeText :: (?loc :: CallStack) => CString -> IO (Maybe T.Text)
#elif defined(HASCALLSTACK_AVAILABLE)
cStringToMaybeText :: (HasCallStack) => CString -> IO (Maybe T.Text)
#else
cStringToMaybeText :: CString -> IO (Maybe T.Text)
#endif
cStringToMaybeText :: CString -> IO (Maybe Text)
cStringToMaybeText cstring :: CString
cstring =
    if (CString
cstring CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr) then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    else do
      ByteString
byteString <- CString -> IO ByteString
B.packCString CString
cstring
      (UnicodeException -> IO (Maybe Text))
-> (Text -> IO (Maybe Text))
-> Either UnicodeException Text
-> IO (Maybe Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: UnicodeException
e -> String -> IO (Maybe Text) -> IO (Maybe Text)
forall a. String -> a -> a
traceStack (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e) (String -> IO (Maybe Text)
forall a. HasCallStack => String -> a
error ""))
             (Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text))
-> (Text -> Maybe Text) -> Text -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)
             (ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
byteString)

toMaybeRef :: Ptr () -> IO (Maybe (Ref a))
toMaybeRef :: Ptr () -> IO (Maybe (Ref a))
toMaybeRef ptr' :: Ptr ()
ptr' = if Ptr ()
ptr' Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr then Maybe (Ref a) -> IO (Maybe (Ref a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ref a)
forall a. Maybe a
Nothing else Ptr () -> IO (Ref a)
forall a. Ptr () -> IO (Ref a)
toRef Ptr ()
ptr' IO (Ref a) -> (Ref a -> IO (Maybe (Ref a))) -> IO (Maybe (Ref a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Ref a) -> IO (Maybe (Ref a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ref a) -> IO (Maybe (Ref a)))
-> (Ref a -> Maybe (Ref a)) -> Ref a -> IO (Maybe (Ref a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref a -> Maybe (Ref a)
forall a. a -> Maybe a
Just

supressWarningAboutRes :: a -> ()
supressWarningAboutRes :: a -> ()
supressWarningAboutRes _ = ()

foldl1WithDefault :: a -> (a -> a -> a) -> [a] -> a
foldl1WithDefault :: a -> (a -> a -> a) -> [a] -> a
foldl1WithDefault emptyCase :: a
emptyCase _ [] = a
emptyCase
foldl1WithDefault _ f :: a -> a -> a
f as :: [a]
as = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 a -> a -> a
f [a]
as

integralToMaybe :: (Integral a, Integral b) => a -> Maybe b
integralToMaybe :: a -> Maybe b
integralToMaybe n :: a
n = if (a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0) then Maybe b
forall a. Maybe a
Nothing else (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)

countDirectionToCChar :: CountDirection -> CChar
countDirectionToCChar :: CountDirection -> CChar
countDirectionToCChar d :: CountDirection
d =
  case CountDirection
d of
   CountUp -> 1
   CountDown -> 0

ccharToCountDirection :: CChar -> CountDirection
ccharToCountDirection :: CChar -> CountDirection
ccharToCountDirection c :: CChar
c = if (CChar
c CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
== 0) then CountDirection
CountDown else CountDirection
CountUp

oneKb :: Int
oneKb :: Int
oneKb = 1024

alignmentsToInt :: Alignments -> Int
alignmentsToInt :: Alignments -> Int
alignmentsToInt (Alignments aligntypes' :: [AlignType]
aligntypes') = [AlignType] -> Int
forall a. (Enum a, Ord a) => [a] -> Int
combine [AlignType]
aligntypes'
intToAlignments :: Int -> Alignments
intToAlignments :: Int -> Alignments
intToAlignments alignmentCode :: Int
alignmentCode = [AlignType] -> Alignments
Alignments ([AlignType] -> CInt -> [AlignType]
forall a. Enum a => [a] -> CInt -> [a]
extract [AlignType]
allAlignTypes (CInt -> [AlignType]) -> CInt -> [AlignType]
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alignmentCode)

menuItemFlagsToInt :: MenuItemFlags -> Int
menuItemFlagsToInt :: MenuItemFlags -> Int
menuItemFlagsToInt (MenuItemFlags menuItemFlags' :: [MenuItemFlag]
menuItemFlags') = [MenuItemFlag] -> Int
forall a. (Enum a, Ord a) => [a] -> Int
combine [MenuItemFlag]
menuItemFlags'
intToMenuItemFlags :: Int -> Maybe MenuItemFlags
intToMenuItemFlags :: Int -> Maybe MenuItemFlags
intToMenuItemFlags flags' :: Int
flags' =
  if (Int
flags' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
  then Maybe MenuItemFlags
forall a. Maybe a
Nothing
  else MenuItemFlags -> Maybe MenuItemFlags
forall a. a -> Maybe a
Just (MenuItemFlags -> Maybe MenuItemFlags)
-> MenuItemFlags -> Maybe MenuItemFlags
forall a b. (a -> b) -> a -> b
$ ([MenuItemFlag] -> MenuItemFlags
MenuItemFlags ([MenuItemFlag] -> MenuItemFlags)
-> (Int -> [MenuItemFlag]) -> Int -> MenuItemFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MenuItemFlag] -> CInt -> [MenuItemFlag]
forall a. Enum a => [a] -> CInt -> [a]
extract [MenuItemFlag]
allMenuItemFlags (CInt -> [MenuItemFlag]) -> (Int -> CInt) -> Int -> [MenuItemFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int
flags'

modesToInt :: Modes -> Int
modesToInt :: Modes -> Int
modesToInt (Modes ms :: [Mode]
ms) = [Mode] -> Int
forall a. (Enum a, Ord a) => [a] -> Int
combine [Mode]
ms
intToModes :: Int -> Modes
intToModes :: Int -> Modes
intToModes modeCode :: Int
modeCode = [Mode] -> Modes
Modes ([Mode] -> CInt -> [Mode]
forall a. Enum a => [a] -> CInt -> [a]
extract [Mode]
allModes (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
modeCode))

withPixmap :: PixmapHs -> ((Ptr (Ptr CChar)) -> IO a) -> IO a
withPixmap :: PixmapHs -> (Ptr CString -> IO a) -> IO a
withPixmap (PixmapHs strings :: [Text]
strings) f :: Ptr CString -> IO a
f = do
  [CString]
cStrings <- [IO CString] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Text -> IO CString) -> [Text] -> [IO CString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> IO CString
copyTextToCString [Text]
strings)
  Ptr CString
ptr <- [CString] -> IO (Ptr CString)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [CString]
cStrings
  Ptr CString -> IO a
f Ptr CString
ptr

withBitmap :: BitmapHs -> ((Ptr CChar) -> Int -> Int -> IO a) -> IO a
withBitmap :: BitmapHs -> (CString -> Int -> Int -> IO a) -> IO a
withBitmap (BitmapHs bitmap :: ByteString
bitmap (Size (Width width' :: Int
width') (Height height' :: Int
height'))) f :: CString -> Int -> Int -> IO a
f =
   ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString
     ByteString
bitmap
     (\ptr :: CString
ptr -> CString -> Int -> Int -> IO a
f CString
ptr Int
width' Int
height')

withStrings :: [T.Text] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withStrings :: [Text] -> (Ptr CString -> IO a) -> IO a
withStrings ss :: [Text]
ss f :: Ptr CString -> IO a
f = do
  [CString]
copies <- (Text -> IO CString) -> [Text] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
             (
               \s :: Text
s ->
                 ByteString -> (CStringLen -> IO CString) -> IO CString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen
                   (Text -> ByteString
E.encodeUtf8 Text
s)
                   (
                     \(ptr :: CString
ptr, len :: Int
len) -> do
                         CString
arrPtr <- Int -> IO CString
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
len
                         CString -> CString -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
arrPtr CString
ptr Int
len
                         CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
arrPtr
                   )
             )
             [Text]
ss
  a
result <- Int -> (Ptr CString -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([CString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CString]
copies) Ptr CString -> IO a
f
  (CString -> IO ()) -> [CString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CString -> IO ()
forall a. Ptr a -> IO ()
free [CString]
copies
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

copyByteStringToCString :: B.ByteString -> IO CString
copyByteStringToCString :: ByteString -> IO CString
copyByteStringToCString bs :: ByteString
bs =
  ByteString -> (CStringLen -> IO CString) -> IO CString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
bs
    (\(cstring :: CString
cstring,len :: Int
len) -> do
        CString
dest <- Int -> IO CString
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
        CString -> CString -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray CString
dest CString
cstring Int
len
        CString -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff CString
dest Int
len (0 :: CChar)
        CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
dest
    )

copyTextToCString :: T.Text -> IO CString
copyTextToCString :: Text -> IO CString
copyTextToCString t :: Text
t =
  let bs :: ByteString
bs = Text -> ByteString
E.encodeUtf8 Text
t
  in
    ByteString -> IO CString
copyByteStringToCString ByteString
bs

withText :: T.Text -> (CString -> IO a) -> IO a
withText :: Text -> (CString -> IO a) -> IO a
withText t :: Text
t f :: CString -> IO a
f = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (Text -> ByteString
E.encodeUtf8 Text
t) CString -> IO a
f

#ifdef CALLSTACK_AVAILABLE
drawShortcutFromC :: (?loc :: CallStack) => CChar -> Maybe DrawShortcut
#elif defined(HASCALLSTACK_AVAILABLE)
drawShortcutFromC :: (HasCallStack) => CChar -> Maybe DrawShortcut
#else
drawShortcutFromC ::  CChar -> Maybe DrawShortcut
#endif
drawShortcutFromC :: CChar -> Maybe DrawShortcut
drawShortcutFromC c :: CChar
c =
  case CChar
c of
    0 -> Maybe DrawShortcut
forall a. Maybe a
Nothing
    1 -> DrawShortcut -> Maybe DrawShortcut
forall a. a -> Maybe a
Just DrawShortcut
NormalDrawShortcut
    2 -> DrawShortcut -> Maybe DrawShortcut
forall a. a -> Maybe a
Just DrawShortcut
ElideAmpersandDrawShortcut
    _ -> String -> Maybe DrawShortcut
forall a. HasCallStack => String -> a
error "fl_draw_shortcut should be 0,1 or 2."

drawShortcutToC :: Maybe DrawShortcut -> CChar
drawShortcutToC :: Maybe DrawShortcut -> CChar
drawShortcutToC ds :: Maybe DrawShortcut
ds =
  case Maybe DrawShortcut
ds of
    Nothing -> 0
    Just NormalDrawShortcut -> 1
    Just ElideAmpersandDrawShortcut -> 2