module Graphics.UI.FLTK.LowLevel.TextEditor
(
textEditorNew,
KeyBinding(..),
KeyFunc(..),
KeyFuncPrim,
keyFuncToFunRef,
toKeyFuncPrim,
keyBindingsToArray,
arrayToKeyBindings
)
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Foreign.C.Types
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import Graphics.UI.FLTK.LowLevel.Utils
import Data.List
data KeyBinding = KeyBinding KeyBindingKeySequence FunRef
data KeyFunc = forall a. (Parent a TextEditor) => KeyFunc (Ref a -> Char -> IO ())
type KeyFuncPrim = CInt -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkKeyFuncPrim :: KeyFuncPrim -> IO (FunPtr KeyFuncPrim)
toKeyFuncPrim :: KeyFunc -> IO (FunPtr KeyFuncPrim)
toKeyFuncPrim (KeyFunc f) =
mkKeyFuncPrim
(
\char' ptr -> do
ref <- toRef ptr
f ref (castCCharToChar $ fromIntegral char')
)
keyFuncToFunRef :: KeyFunc -> IO FunRef
keyFuncToFunRef f = toKeyFuncPrim f >>= return . toFunRef
keyBindingsToArray :: [KeyBinding] -> IO (Ptr ())
keyBindingsToArray kbs =
case kbs of
(kb':kbs') -> foldl'
(
\p' kb'' -> do
curr <- ptrToKb kb''
p' >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr ()))}) curr
return curr
)
(ptrToKb kb')
kbs'
[] -> return nullPtr
where
extractCodes (KeyBindingKeySequence es key') =
let keyNum = case key' of
SpecialKeyType c' -> fromIntegral $ fromEnum c'
NormalKeyType c' -> fromIntegral $ castCharToCChar c'
stateCode = maybe 0 (fromIntegral . combine) es
in
(stateCode, keyNum)
ptrToKb (KeyBinding kb fr) =
let (sc,kn) = extractCodes kb
in do
p <- mallocBytes 24
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)}) p kn
(\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)}) p sc
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))}) p (castFunPtr (fromFunRef fr))
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr ()))}) p nullPtr
return p
arrayToKeyBindings :: Ptr () -> IO [KeyBinding]
arrayToKeyBindings p | p == nullPtr = return []
arrayToKeyBindings p =
go [] p
where
go accum p' | p' == nullPtr = return accum
go accum p' = do
key' <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CInt}) p' >>= return . fromIntegral
state' <- (\ptr -> do {C2HSImp.peekByteOff ptr 4 :: IO C2HSImp.CInt}) p'
function' <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.FunPtr (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))}) p'
next' <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO (C2HSImp.Ptr ())}) p'
free p'
let skCandidates = filter (\sk -> fromEnum sk == key') allSpecialKeys
let keyType = if (null skCandidates)
then (NormalKeyType $ castCCharToChar $ fromIntegral key')
else (SpecialKeyType $ head skCandidates)
let evs = if (state' == 0)
then Nothing
else Just $ extract allEventStates state'
let currKb = KeyBinding (KeyBindingKeySequence evs keyType) (toFunRef function')
go (accum ++ [currKb]) next'
textEditorNew' :: (Int) -> (Int) -> (Int) -> (Int) -> IO ((Ptr ()))
textEditorNew' a1 a2 a3 a4 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
textEditorNew''_ a1' a2' a3' a4' >>= \res ->
let {res' = id res} in
return (res')
textEditorNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (String) -> IO ((Ptr ()))
textEditorNewWithLabel' a1 a2 a3 a4 a5 =
let {a1' = fromIntegral a1} in
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
let {a5' = unsafeToCString a5} in
textEditorNewWithLabel''_ a1' a2' a3' a4' a5' >>= \res ->
let {res' = id res} in
return (res')
textEditorNew :: Rectangle -> Maybe String -> IO (Ref TextEditor)
textEditorNew rectangle l' =
let (x_pos, y_pos, width, height) = fromRectangle rectangle
in case l' of
Nothing -> textEditorNew' x_pos y_pos width height >>= toRef
Just l -> textEditorNewWithLabel' x_pos y_pos width height l >>= toRef
handle' :: (Ptr ()) -> (Int) -> IO ((Int))
handle' a1 a2 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
handle''_ a1' a2' >>= \res ->
let {res' = fromIntegral res} in
return (res')
instance (impl ~ (Event -> IO (Int))) => Op (Handle ()) TextEditor orig impl where
runOp _ _ text_editor e = withRef text_editor $ \text_editorPtr -> handle' text_editorPtr (fromEnum e)
textEditorDestroy' :: (Ptr ()) -> IO ((()))
textEditorDestroy' a1 =
let {a1' = id a1} in
textEditorDestroy''_ a1' >>= \res ->
let {res' = supressWarningAboutRes res} in
return (res')
instance (impl ~ (IO ())) => Op (Destroy ()) TextEditor orig impl where
runOp _ _ editor = swapRef editor $ \editorPtr -> do
textEditorDestroy' editorPtr
return nullPtr
setInsertMode' :: (Ptr ()) -> (Bool) -> IO ()
setInsertMode' a1 a2 =
let {a1' = id a1} in
let {a2' = cFromBool a2} in
setInsertMode''_ a1' a2' >>
return ()
instance (impl ~ (Bool -> IO ())) => Op (SetInsertMode ()) TextEditor orig impl where
runOp _ _ text_editor b = withRef text_editor $ \text_editorPtr -> setInsertMode' text_editorPtr b
insertMode' :: (Ptr ()) -> IO ((Bool))
insertMode' a1 =
let {a1' = id a1} in
insertMode''_ a1' >>= \res ->
let {res' = cToBool res} in
return (res')
instance (impl ~ ( IO (Bool))) => Op (GetInsertMode ()) TextEditor orig impl where
runOp _ _ text_editor = withRef text_editor $ \text_editorPtr -> insertMode' text_editorPtr
addDefaultKeyBindings' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
addDefaultKeyBindings' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
addDefaultKeyBindings''_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
instance (impl ~ (IO [KeyBinding])) => Op (GetDefaultKeyBindings ()) TextEditor orig impl where
runOp _ _ text_editor = withRef text_editor $ \text_editorPtr -> do
p' <- addDefaultKeyBindings' text_editorPtr nullPtr
kbs <- arrayToKeyBindings p'
return kbs
replaceKeyBindings' :: (Ptr ()) -> (Ptr ()) -> IO ()
replaceKeyBindings' a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
replaceKeyBindings''_ a1' a2' >>
return ()
instance (impl ~ ([KeyBinding] -> IO ())) => Op (ReplaceKeyBindings ()) TextEditor orig impl where
runOp _ _ text_editor kbs = withRef text_editor $ \text_editorPtr -> do
p <- keyBindingsToArray kbs
replaceKeyBindings' text_editorPtr p
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_New"
textEditorNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_New_WithLabel"
textEditorNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_handle"
handle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_Destroy"
textEditorDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_set_insert_mode"
setInsertMode''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_insert_mode"
insertMode''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_add_default_key_bindings"
addDefaultKeyBindings''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))
foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextEditor.chs.h Fl_Text_Editor_replace_key_bindings"
replaceKeyBindings''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))