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


{-# LINE 1 "src/Termbox.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Termbox
  ( C.Cell
  , C.changeCell
  , C.clear
  , C.height
  , C.present
  , C.putCell
  , C.setClearAttr
  , C.setCursor
  , C.shutdown
  , C.width
  , Event(..)
  , InputMode(..)
  , OutputMode(..)
  , getInputMode
  , getOutputMode
  , hideCursor
  , init
  , inputMode
  , peekEvent
  , pollEvent
  , setInputMode
  , setOutputMode
  ) where

import Control.Arrow (left)
import Control.Monad (void)
import Data.Bits
import Data.Int
import Data.Word
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable

import Prelude hiding (init, mod)

import qualified Termbox.C     as C
import qualified Termbox.Enums as E



-- | A termbox event.
data Event
  = KeyEvent Word8 Word16 Word32  -- ^ A key event: mod, key, ch
  | ResizeEvent Int32 Int32       -- ^ A resize event: w, h
  | MouseEvent Int32 Int32 Word16 -- ^ A mouse event: w, h, key
  deriving (Show, Eq)

-- | Termbox input modes.
data InputMode = InputMode
  { isEsc :: Bool   -- ^ ESC means "E.TB_KEY_ESC"
  , isAlt :: Bool   -- ^ ESC enables "E.TB_MOD_ALT" for next key event
  , isMouse :: Bool -- ^ Enable mouse events
  } deriving (Show, Eq)

inputMode :: InputMode
inputMode = InputMode False False False

-- | Termbox output modes.
data OutputMode
  = Normal      -- ^ 8 colors.
  | M256        -- ^ 256 colors.
  | M216        -- ^ 216 colors.
  | Grayscale   -- ^ 24 shades of gray.
  | Unknown Int -- ^ A mystery.
  deriving (Show, Eq)

-- | Initializes termbox.
init :: IO (Either String ())
init = check <$> C.tb_init
  where
    check e
      | e == -1 = Left "tb_init: unsupported terminal"
      | e == -2   = Left "tb_init: failed to open TTY"
      | e == -3      = Left "tb_init: pipe trap failed"
      | e < 0                                    = Left ("tb_init: errno " ++ (show e))
      | otherwise                                = Right ()

hideCursor :: IO ()
hideCursor = C.setCursor x x where x = -1
{-# LINE 81 "src/Termbox.chs" #-}


getInputMode :: IO InputMode
getInputMode = conv <$> (C.tb_select_input_mode 0)
  where
    conv bits = InputMode { isEsc   = 0 /= bits .&. 1
{-# LINE 86 "src/Termbox.chs" #-}

                          , isAlt   = 0 /= bits .&. 2
{-# LINE 87 "src/Termbox.chs" #-}

                          , isMouse = 0 /= bits .&. 4
{-# LINE 88 "src/Termbox.chs" #-}

                          }

setInputMode :: InputMode -> IO ()
setInputMode = void . C.tb_select_input_mode . conv
  where conv mode = let e = if isEsc mode   then 1   else 0
                        a = if isAlt mode   then 2   else 0
                        m = if isMouse mode then 4 else 0
                     in e .|. a .|. m

getOutputMode :: IO OutputMode
getOutputMode = (conv . toEnum) <$> C.tb_select_output_mode 0
{-# LINE 99 "src/Termbox.chs" #-}

  where
    conv i
      | i == E.TB_OUTPUT_NORMAL    = Normal
      | i == E.TB_OUTPUT_256       = M256
      | i == E.TB_OUTPUT_216       = M216
      | i == E.TB_OUTPUT_GRAYSCALE = Grayscale
      | otherwise                  = Unknown (fromEnum i)

setOutputMode :: OutputMode -> IO ()
setOutputMode = void . C.tb_select_output_mode . conv
  where
    conv Normal      = 1
{-# LINE 111 "src/Termbox.chs" #-}

    conv M256        = 2
{-# LINE 112 "src/Termbox.chs" #-}

    conv M216        = 3
{-# LINE 113 "src/Termbox.chs" #-}

    conv Grayscale   = 4
{-# LINE 114 "src/Termbox.chs" #-}

    conv (Unknown i) = fromIntegral i

-- | Wait for an event with a timeout.
peekEvent :: Int -> IO (Maybe Event)
peekEvent t = fmap (either (const Nothing) Just)
                   (C.tb_peek_event t >>= (flip C.withEvent) handleEvent)

-- | Wait for an event.
pollEvent :: IO (Either String Event)
pollEvent = fmap (left showError)
                 (C.tb_poll_event >>= (flip C.withEvent) handleEvent)
  where showError i = "tb_poll_event: invalid event type" ++ (show i)

handleEvent :: Ptr C.Event -> IO (Either Int Event)
handleEvent p = (\ptr -> do {peekByteOff ptr 0 :: IO CUChar}) p >>= conv
  where
    conv :: CUChar -> IO (Either Int Event)
    conv 1 = fmap Right $
      KeyEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 1 :: IO CUChar}) p)
               <*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 2 :: IO CUShort}) p)
               <*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 4 :: IO CUInt}) p)
    conv 2 = fmap Right $
      ResizeEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 8 :: IO CInt}) p)
                  <*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 12 :: IO CInt}) p)
    conv 3 = fmap Right $
      MouseEvent <$> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 16 :: IO CInt}) p)
                 <*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 20 :: IO CInt}) p)
                 <*> (fromIntegral <$> (\ptr -> do {peekByteOff ptr 2 :: IO CUShort}) p)
    conv i = return (Left (fromIntegral i))