{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90205 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Instrument/BrowserC.hsc" #-}
-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

module Instrument.BrowserC where
import Data.Text (Text)

import ForeignC
import qualified Util.FFI as FFI
import qualified Util.Fltk as Fltk




type Window = Fltk.Window MsgType

create :: Int -> Int -> Int -> Int -> Fltk.Fltk (Fltk.Window MsgType)
create x y w h = Fltk.fltk $
    Fltk.create_window decode_type c_create_browser x y w h "instrument browser"

foreign import ccall "create_browser"
    c_create_browser :: CInt -> CInt -> CInt -> CInt -> CString
        -> FunPtr Fltk.MsgCallback -> IO (Ptr Window)

insert_line :: Window -> Int -> Text -> Fltk.Fltk ()
insert_line win n line = Fltk.fltk $ FFI.withText line $ \linep ->
    c_insert_line (Fltk.win_ptr win) (fromIntegral n) linep
foreign import ccall "insert_line"
    c_insert_line :: Ptr Window -> CInt -> CString -> IO ()

remove_line :: Window -> Int -> Fltk.Fltk ()
remove_line win n = Fltk.fltk $
    c_remove_line (Fltk.win_ptr win) (fromIntegral n)

foreign import ccall "remove_line" c_remove_line :: Ptr Window -> CInt -> IO ()

set_info :: Window -> Text -> Fltk.Fltk ()
set_info win info = Fltk.fltk $ FFI.withText info $ \infop ->
    c_set_info (Fltk.win_ptr win) infop

foreign import ccall "set_info" c_set_info :: Ptr Window -> CString -> IO ()


-- * implementation

data MsgType = Select | Choose | Query | Unknown CInt deriving (Show)

decode_type :: CInt -> MsgType
decode_type msg_type = case msg_type of
    (0) -> Select
{-# LINE 51 "Instrument/BrowserC.hsc" #-}
    (1) -> Choose
{-# LINE 52 "Instrument/BrowserC.hsc" #-}
    (2) -> Query
{-# LINE 53 "Instrument/BrowserC.hsc" #-}
    _ -> Unknown msg_type