{-# 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 "Ui/UiMsgC.hsc" #-}
module Ui.UiMsgC (get_ui_msgs) where
import qualified Util.FFI as FFI
import qualified Ui.Block as Block
import qualified Ui.PtrMap as PtrMap
import qualified Ui.Key as Key
import qualified Ui.UiMsg as UiMsg
import Types
import ForeignC
get_ui_msgs :: IO [UiMsg.UiMsg]
get_ui_msgs = with nullPtr $ \msgspp -> do
count <- c_get_ui_msgs msgspp
msgsp <- peek msgspp
msgs <- peekArray (int count) msgsp
c_clear_ui_msgs
return msgs
foreign import ccall unsafe "get_ui_msgs"
c_get_ui_msgs :: Ptr (Ptr UiMsg.UiMsg) -> IO CInt
foreign import ccall unsafe "clear_ui_msgs" c_clear_ui_msgs :: IO ()
instance CStorable UiMsg.UiMsg where
sizeOf _ = (88)
{-# LINE 34 "Ui/UiMsgC.hsc" #-}
alignment _ = alignment nullPtr
poke = error "UiMsg poke unimplemented"
peek = peek_msg
peek_msg :: Ptr UiMsg.UiMsg -> IO UiMsg.UiMsg
peek_msg msgp = do
type_num <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) msgp :: IO CInt
{-# LINE 41 "Ui/UiMsgC.hsc" #-}
(context, maybe_view_id) <- peek_context msgp
UiMsg.UiMsg context <$> case type_num of
(0) -> UiMsg.MsgEvent <$> peek_event msgp
{-# LINE 44 "Ui/UiMsgC.hsc" #-}
(7) -> do
{-# LINE 45 "Ui/UiMsgC.hsc" #-}
rect <- peek =<< ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp
{-# LINE 46 "Ui/UiMsgC.hsc" #-}
screen <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) msgp :: IO Int
{-# LINE 47 "Ui/UiMsgC.hsc" #-}
screens <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 60)) msgp :: IO Int
{-# LINE 48 "Ui/UiMsgC.hsc" #-}
return $ UiMsg.UpdateScreenSize screen screens rect
_ -> do
view_id <- maybe
(error $ "got a null view_id from a ui update: "
++ show type_num)
return maybe_view_id
UiMsg.UiUpdate view_id <$> peek_ui_update type_num msgp
peek_context :: Ptr UiMsg.UiMsg -> IO (UiMsg.Context, Maybe ViewId)
peek_context msgp = do
focusp <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) msgp :: IO (Ptr PtrMap.CView)
{-# LINE 59 "Ui/UiMsgC.hsc" #-}
focus <- lookup_id focusp
viewp <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) msgp :: IO (Ptr PtrMap.CView)
{-# LINE 61 "Ui/UiMsgC.hsc" #-}
view <- lookup_id viewp
track_type <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) msgp :: IO CChar
{-# LINE 64 "Ui/UiMsgC.hsc" #-}
tracknum <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 28)) msgp :: IO Int
{-# LINE 65 "Ui/UiMsgC.hsc" #-}
has_pos <- toBool <$> (((\hsc_ptr -> peekByteOff hsc_ptr 32)) msgp :: IO CChar)
{-# LINE 66 "Ui/UiMsgC.hsc" #-}
cpos <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) msgp
{-# LINE 67 "Ui/UiMsgC.hsc" #-}
let track = decode_track track_type tracknum has_pos cpos
is_floating_input = track_type == (2)
{-# LINE 69 "Ui/UiMsgC.hsc" #-}
return (UiMsg.Context focus track is_floating_input, view)
where
lookup_id p
| p == nullPtr = return Nothing
| otherwise = PtrMap.lookup_id p
decode_track :: CChar -> Int -> Bool -> ScoreTime
-> Maybe (TrackNum, UiMsg.Track)
decode_track track_type tracknum has_pos pos
| track_type == (0) = Nothing
{-# LINE 79 "Ui/UiMsgC.hsc" #-}
| has_pos = if track_type == (3)
{-# LINE 80 "Ui/UiMsgC.hsc" #-}
then Just (tracknum, UiMsg.Divider)
else Just (tracknum, UiMsg.Track pos)
| otherwise = Just (tracknum, UiMsg.SkeletonDisplay)
peek_event :: Ptr UiMsg.UiMsg -> IO UiMsg.MsgEvent
peek_event msgp = do
event <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp :: IO Int
{-# LINE 87 "Ui/UiMsgC.hsc" #-}
button <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 52)) msgp :: IO Int
{-# LINE 88 "Ui/UiMsgC.hsc" #-}
clicks <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) msgp :: IO Int
{-# LINE 89 "Ui/UiMsgC.hsc" #-}
is_click <- toBool <$> (((\hsc_ptr -> peekByteOff hsc_ptr 68)) msgp :: IO CInt)
{-# LINE 90 "Ui/UiMsgC.hsc" #-}
x <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 60)) msgp :: IO Int
{-# LINE 91 "Ui/UiMsgC.hsc" #-}
y <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) msgp :: IO Int
{-# LINE 92 "Ui/UiMsgC.hsc" #-}
key_code <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) msgp :: IO CInt
{-# LINE 93 "Ui/UiMsgC.hsc" #-}
text <- ((\hsc_ptr -> peekByteOff hsc_ptr 76)) msgp :: IO CChar
{-# LINE 94 "Ui/UiMsgC.hsc" #-}
modifier_state <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) msgp :: IO CInt
{-# LINE 95 "Ui/UiMsgC.hsc" #-}
is_repeat <- toBool <$> (((\hsc_ptr -> peekByteOff hsc_ptr 84)) msgp :: IO CChar)
{-# LINE 96 "Ui/UiMsgC.hsc" #-}
let mouse state = UiMsg.Mouse $ UiMsg.MouseEvent
{ mouse_state = state
, mouse_modifiers = mods
, mouse_coords = (x, y)
, mouse_clicks = clicks
, mouse_is_click = is_click
}
mods = Key.decode_modifiers modifier_state
key = Key.decode_key key_code
kbd state = UiMsg.Kbd state mods key $ if text == 0 then Nothing
else Just (toEnum (fromIntegral text))
aux = UiMsg.AuxMsg
return $ case event of
(1) -> mouse (UiMsg.MouseDown button)
{-# LINE 110 "Ui/UiMsgC.hsc" #-}
(5) -> mouse (UiMsg.MouseDrag button)
{-# LINE 111 "Ui/UiMsgC.hsc" #-}
(2) -> mouse (UiMsg.MouseUp button)
{-# LINE 112 "Ui/UiMsgC.hsc" #-}
(11) -> mouse UiMsg.MouseMove
{-# LINE 113 "Ui/UiMsgC.hsc" #-}
(8) -> kbd
{-# LINE 114 "Ui/UiMsgC.hsc" #-}
(if is_repeat then UiMsg.KeyRepeat else UiMsg.KeyDown)
(9) -> kbd UiMsg.KeyUp
{-# LINE 116 "Ui/UiMsgC.hsc" #-}
(3) -> aux UiMsg.Enter
{-# LINE 118 "Ui/UiMsgC.hsc" #-}
(4) -> aux UiMsg.Leave
{-# LINE 119 "Ui/UiMsgC.hsc" #-}
(6) -> aux UiMsg.Focus
{-# LINE 120 "Ui/UiMsgC.hsc" #-}
(7) -> aux UiMsg.Unfocus
{-# LINE 121 "Ui/UiMsgC.hsc" #-}
(12) -> aux UiMsg.Shortcut
{-# LINE 122 "Ui/UiMsgC.hsc" #-}
(13) -> aux UiMsg.Deactivate
{-# LINE 123 "Ui/UiMsgC.hsc" #-}
(14) -> aux UiMsg.Activate
{-# LINE 124 "Ui/UiMsgC.hsc" #-}
(15) -> aux UiMsg.Hide
{-# LINE 125 "Ui/UiMsgC.hsc" #-}
(16) -> aux UiMsg.Show
{-# LINE 126 "Ui/UiMsgC.hsc" #-}
_ -> UiMsg.Unhandled event
peek_ui_update :: CInt -> Ptr UiMsg.UiMsg -> IO UiMsg.UiUpdate
peek_ui_update type_num msgp = case type_num of
(1) -> do
{-# LINE 131 "Ui/UiMsgC.hsc" #-}
ctext <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp :: IO CString
{-# LINE 132 "Ui/UiMsgC.hsc" #-}
text <- if ctext == nullPtr then return Nothing
else Just <$> FFI.peekCString ctext
return $ UiMsg.UpdateInput text
(2) -> do
{-# LINE 136 "Ui/UiMsgC.hsc" #-}
scroll <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp :: IO Int
{-# LINE 137 "Ui/UiMsgC.hsc" #-}
return $ UiMsg.UpdateTrackScroll scroll
(3) -> do
{-# LINE 139 "Ui/UiMsgC.hsc" #-}
scroll <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp :: IO ScoreTime
{-# LINE 140 "Ui/UiMsgC.hsc" #-}
return $ UiMsg.UpdateTimeScroll scroll
(4) -> do
{-# LINE 142 "Ui/UiMsgC.hsc" #-}
rect <- peek =<< ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp
{-# LINE 143 "Ui/UiMsgC.hsc" #-}
padding <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) msgp :: IO Block.Padding
{-# LINE 144 "Ui/UiMsgC.hsc" #-}
return $ UiMsg.UpdateViewResize rect padding
(5) -> do
{-# LINE 146 "Ui/UiMsgC.hsc" #-}
width <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 48)) msgp
{-# LINE 147 "Ui/UiMsgC.hsc" #-}
suggested_width <-
int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 52)) msgp
{-# LINE 149 "Ui/UiMsgC.hsc" #-}
return $ UiMsg.UpdateTrackWidth width suggested_width
(6) -> return UiMsg.UpdateClose
{-# LINE 151 "Ui/UiMsgC.hsc" #-}
_ -> error $ "unknown UiMsg type: " ++ show type_num
int :: CInt -> Int
int = fromIntegral
instance CStorable Block.Padding where
sizeOf _ = (12)
{-# LINE 158 "Ui/UiMsgC.hsc" #-}
alignment _ = alignment (0 :: CInt)
poke = error "Block.Padding poke unimplemented"
peek p = do
left <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 162 "Ui/UiMsgC.hsc" #-}
top <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 163 "Ui/UiMsgC.hsc" #-}
bottom <- int <$> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 164 "Ui/UiMsgC.hsc" #-}
return $ Block.Padding { left = left, top = top, bottom = bottom }