-- GENERATED by C->Haskell Compiler, version 0.25.2 Snowboundest, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Termbox/C.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Termbox.C
  ( changeCell
  , clear
  , height
  , present
  , putCell
  , setClearAttr
  , setCursor
  , shutdown
  , width

  -- | Low level
  , Event, withEvent
  , Cell, withCell
  , tb_init
  , tb_peek_event
  , tb_poll_event
  , tb_select_input_mode
  , tb_select_output_mode
  , tb_cell_buffer
  ) where

import Control.Monad ((>=>))
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr



newtype Cell = Cell (ForeignPtr (Cell))
withCell :: Cell -> (Ptr Cell -> IO b) -> IO b
withCell (Cell fptr) = withForeignPtr fptr
{-# LINE 31 "src/Termbox/C.chs" #-}

newtype Event = Event (ForeignPtr (Event))
withEvent :: Event -> (Ptr Event -> IO b) -> IO b
withEvent (Event fptr) = withForeignPtr fptr
{-# LINE 32 "src/Termbox/C.chs" #-}

tb_init :: IO ((Int))
tb_init =
  tb_init'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 33 "src/Termbox/C.chs" #-}

tb_peek_event :: (Int) -> IO ((Event))
tb_peek_event a2 =
  mallocForeignPtrBytes 24 >>= \a1'' -> withForeignPtr a1'' $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  tb_peek_event'_ a1' a2' >>
  return (Event a1'')

{-# LINE 34 "src/Termbox/C.chs" #-}

tb_poll_event :: IO ((Event))
tb_poll_event =
  mallocForeignPtrBytes 24 >>= \a1'' -> withForeignPtr a1'' $ \a1' -> 
  tb_poll_event'_ a1' >>
  return (Event a1'')

{-# LINE 35 "src/Termbox/C.chs" #-}

tb_select_input_mode :: (Int) -> IO ((Int))
tb_select_input_mode a1 =
  let {a1' = fromIntegral a1} in 
  tb_select_input_mode'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 36 "src/Termbox/C.chs" #-}

tb_select_output_mode :: (Int) -> IO ((Int))
tb_select_output_mode a1 =
  let {a1' = fromIntegral a1} in 
  tb_select_output_mode'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 37 "src/Termbox/C.chs" #-}

tb_cell_buffer :: IO ((Cell))
tb_cell_buffer =
  tb_cell_buffer'_ >>= \res ->
  (newForeignPtr_ >=> (return . Cell)) res >>= \res' ->
  return (res')

{-# LINE 38 "src/Termbox/C.chs" #-}


changeCell :: (Int) -> (Int) -> (CUInt) -> (CUShort) -> (CUShort) -> IO ()
changeCell 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' = fromIntegral a5} in 
  changeCell'_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 40 "src/Termbox/C.chs" #-}

clear :: IO ()
clear =
  clear'_ >>
  return ()

{-# LINE 41 "src/Termbox/C.chs" #-}

height :: IO ((Int))
height =
  height'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 42 "src/Termbox/C.chs" #-}

present :: IO ()
present =
  present'_ >>
  return ()

{-# LINE 43 "src/Termbox/C.chs" #-}

putCell :: (Int) -> (Int) -> (Cell) -> IO ()
putCell a1 a2 a3 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  (withCell) a3 $ \a3' -> 
  putCell'_ a1' a2' a3' >>
  return ()

{-# LINE 44 "src/Termbox/C.chs" #-}

setClearAttr :: (CUShort) -> (CUShort) -> IO ()
setClearAttr a1 a2 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  setClearAttr'_ a1' a2' >>
  return ()

{-# LINE 45 "src/Termbox/C.chs" #-}

setCursor :: (Int) -> (Int) -> IO ()
setCursor a1 a2 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  setCursor'_ a1' a2' >>
  return ()

{-# LINE 46 "src/Termbox/C.chs" #-}

shutdown :: IO ()
shutdown =
  shutdown'_ >>
  return ()

{-# LINE 47 "src/Termbox/C.chs" #-}

width :: IO ((Int))
width =
  width'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 48 "src/Termbox/C.chs" #-}


foreign import ccall unsafe "Termbox/C.chs.h tb_init"
  tb_init'_ :: (IO CInt)

foreign import ccall unsafe "Termbox/C.chs.h tb_peek_event"
  tb_peek_event'_ :: ((Ptr (Event)) -> (CInt -> (IO CInt)))

foreign import ccall unsafe "Termbox/C.chs.h tb_poll_event"
  tb_poll_event'_ :: ((Ptr (Event)) -> (IO CInt))

foreign import ccall unsafe "Termbox/C.chs.h tb_select_input_mode"
  tb_select_input_mode'_ :: (CInt -> (IO CInt))

foreign import ccall unsafe "Termbox/C.chs.h tb_select_output_mode"
  tb_select_output_mode'_ :: (CInt -> (IO CInt))

foreign import ccall unsafe "Termbox/C.chs.h tb_cell_buffer"
  tb_cell_buffer'_ :: (IO (Ptr (Cell)))

foreign import ccall unsafe "Termbox/C.chs.h tb_change_cell"
  changeCell'_ :: (CInt -> (CInt -> (CUInt -> (CUShort -> (CUShort -> (IO ()))))))

foreign import ccall unsafe "Termbox/C.chs.h tb_clear"
  clear'_ :: (IO ())

foreign import ccall unsafe "Termbox/C.chs.h tb_height"
  height'_ :: (IO CInt)

foreign import ccall unsafe "Termbox/C.chs.h tb_present"
  present'_ :: (IO ())

foreign import ccall unsafe "Termbox/C.chs.h tb_put_cell"
  putCell'_ :: (CInt -> (CInt -> ((Ptr (Cell)) -> (IO ()))))

foreign import ccall unsafe "Termbox/C.chs.h tb_set_clear_attributes"
  setClearAttr'_ :: (CUShort -> (CUShort -> (IO ())))

foreign import ccall unsafe "Termbox/C.chs.h tb_set_cursor"
  setCursor'_ :: (CInt -> (CInt -> (IO ())))

foreign import ccall unsafe "Termbox/C.chs.h tb_shutdown"
  shutdown'_ :: (IO ())

foreign import ccall unsafe "Termbox/C.chs.h tb_width"
  width'_ :: (IO CInt)