-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.TextSelection
       (
       -- * Hierarchy
       --
       -- $hierarchy

       -- * Functions
       --
       -- $functions
       )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr 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.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch

set' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
set' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  set''_ a1' a2' a3' >>
  return ()

{-# LINE 24 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (BufferRange -> IO ())) => Op (Set ()) TextSelection orig impl where
  runOp _ _ text_selection (BufferRange (BufferOffset start'') (BufferOffset end'')) = withRef text_selection $ \text_selectionPtr -> set' text_selectionPtr start'' end''
update' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> IO ()
update' a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  update''_ a1' a2' a3' a4' >>
  return ()

{-# LINE 27 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (BufferOffset -> Int -> Int ->  IO ())) => Op (Update ()) TextSelection orig impl where
  runOp _ _ text_selection (BufferOffset pos) ndeleted ninserted = withRef text_selection $ \text_selectionPtr -> update' text_selectionPtr pos ndeleted ninserted
start' :: (Ptr ()) -> IO ((Int))
start' a1 =
  let {a1' = id a1} in 
  start''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 30 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ IO BufferOffset) => Op (Start ()) TextSelection orig impl where
  runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> start' text_selectionPtr >>= return . BufferOffset
end' :: (Ptr ()) -> IO ((Int))
end' a1 =
  let {a1' = id a1} in 
  end''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 33 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (IO (BufferOffset))) => Op (End ()) TextSelection orig impl where
  runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> end' text_selectionPtr >>= return . BufferOffset
selected' :: (Ptr ()) -> IO ((Bool))
selected' a1 =
  let {a1' = id a1} in 
  selected''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 36 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ IO (Bool)) => Op (Selected ()) TextSelection orig impl where
  runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> selected' text_selectionPtr
setSelected' :: (Ptr ()) -> (Bool) -> IO ()
setSelected' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = cFromBool a2} in 
  setSelected''_ a1' a2' >>
  return ()

{-# LINE 39 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (Bool ->  IO ())) => Op (SetSelected ()) TextSelection orig impl where
  runOp _ _ text_selection b = withRef text_selection $ \text_selectionPtr -> setSelected' text_selectionPtr b
includes' :: (Ptr ()) -> (Int) -> IO ((Bool))
includes' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  includes''_ a1' a2' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 42 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (BufferOffset ->  IO (Bool))) => Op (Includes ()) TextSelection orig impl where
  runOp _ _ text_selection (BufferOffset pos) = withRef text_selection $ \text_selectionPtr -> includes' text_selectionPtr pos
position' :: (Ptr ()) -> (Ptr CInt) -> (Ptr CInt) -> IO ((Int))
position' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  position''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 45 "src/Graphics/UI/FLTK/LowLevel/TextSelection.chs" #-}

instance  ( impl ~ (IO (Maybe BufferRange))) => Op (GetPosition ()) TextSelection orig impl where
  runOp _ _ text_selection =
    withRef text_selection $ \text_selectionPtr ->
    statusToBufferRange $ position' text_selectionPtr

-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.TextSelection"
-- @

-- $functions
-- @
-- end :: 'Ref' 'TextSelection' -> 'IO' 'BufferOffset'
--
-- getPosition :: 'Ref' 'TextSelection' -> 'IO' ('Maybe' 'BufferRange')
--
-- includes :: 'Ref' 'TextSelection' -> 'BufferOffset' -> 'IO' 'Bool'
--
-- selected :: 'Ref' 'TextSelection' -> 'IO' 'Bool'
--
-- set :: 'Ref' 'TextSelection' -> 'BufferRange' -> 'IO' ()
--
-- setSelected :: 'Ref' 'TextSelection' -> 'Bool' -> 'IO' ()
--
-- start :: 'Ref' 'TextSelection' -> 'IO' 'BufferOffset'
--
-- update :: 'Ref' 'TextSelection' -> 'BufferOffset' -> 'Int' -> 'Int' -> 'IO' ()
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_set"
  set''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_update"
  update''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_start"
  start''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_end"
  end''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_selected"
  selected''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_set_selected"
  setSelected''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_includes"
  includes''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TextSelection.chs.h Fl_Text_Selection_position"
  position''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))