other kind of dragging

This commit is contained in:
nek0 2019-09-29 20:02:43 +02:00
parent 409b56f846
commit c060a7f740

View file

@ -216,8 +216,8 @@ networkDescription (listenerah, _) rotvar transvar = mdo
_ <- changes blistener
emouse <- fromAddHandler =<< registerMouseEvent passfire mouseah
epass <- fromAddHandler =<< registerPassEvent passah
eClickHold <- fromAddHandler =<< registerClickHoldEvent clickholdah
clickHoldBehaviour <- RBC.stepper False eClickHold
eClickHold <- fromAddHandler =<< registerClickHoldEvent passfire clickholdah
clickHoldBehaviour <- RBC.stepper True eClickHold
mouseMoveBehaviour <- RBC.stepper (V2 1 1) epass
let moveReaction = fmap (\x -> do
let input = (\(V2 xx _) ->
@ -230,10 +230,15 @@ networkDescription (listenerah, _) rotvar transvar = mdo
clickReaction = fmap (\x -> do
let input = (fmap (\foo -> foo - 1) x) / V2 400 300
void $ atomically $ swapTMVar transvar input
print input)
-- print input)
)
mouseMoveBehaviour
printReaction = fmap print blistener
ecPrint <- changes printReaction
reactimate' ecPrint
reactimate moveReaction
reactimate' =<< (whenE clickHoldBehaviour <$> changes clickReaction)
ecReaction <- changes clickReaction
reactimate' $ whenE clickHoldBehaviour ecReaction
registerListenerEvent
:: (MonadIO m)
@ -245,21 +250,32 @@ registerListenerEvent listenerah mousefire clickholdfire = do
void $ liftIO $
register listenerah $ \evs -> do
let filteredMoveEvents = filter (\ev -> case SDL.eventPayload ev of
SDL.MouseMotionEvent _ -> True
SDL.MouseMotionEvent
(SDL.MouseMotionEventData _ _ _ _ _) ->
True
_ -> False
) evs
filteredClickEvents = filter (\ev -> case SDL.eventPayload ev of
SDL.MouseMotionEvent
(SDL.MouseMotionEventData _ _ [SDL.ButtonLeft] _ _) ->
-- SDL.MouseMotionEvent
-- (SDL.MouseMotionEventData _ _ [SDL.ButtonLeft] _ _) ->
-- True
SDL.MouseButtonEvent
(SDL.MouseButtonEventData _ _ _ SDL.ButtonLeft _ _) ->
True
_ -> False
) evs
if null filteredMoveEvents
then return ()
else mousefire (head $ reverse $ filteredMoveEvents)
else mousefire (head $ filteredMoveEvents)
if null filteredClickEvents
then clickholdfire False
else clickholdfire True
then
return ()
-- clickholdfire False
else
clickholdfire
(any (\x -> SDL.Pressed == SDL.mouseButtonEventMotion
((\(SDL.MouseButtonEvent dat) -> dat) $
SDL.eventPayload x)) filteredClickEvents)
return listenerah
registerMouseEvent
@ -268,11 +284,16 @@ registerMouseEvent
-> AddHandler SDL.Event
-> m (AddHandler SDL.Event)
registerMouseEvent passFire mouseah = do
void $ liftIO $ register mouseah $
\(SDL.Event _ (SDL.MouseMotionEvent dat)) ->
void $ liftIO $ register mouseah $ digestEvent
return mouseah
where
digestEvent (SDL.Event _ (SDL.MouseMotionEvent dat)) =
passFire (fmap fromIntegral $ (\(SDL.P a) -> a) $
SDL.mouseMotionEventPos dat)
return mouseah
digestEvent (SDL.Event _ (SDL.MouseButtonEvent dat)) =
passFire (fmap fromIntegral $ (\(SDL.P a) -> a) $
SDL.mouseButtonEventPos dat)
digestEvent _ = return ()
registerPassEvent
:: MonadIO m
@ -284,8 +305,14 @@ registerPassEvent passah = do
registerClickHoldEvent
:: MonadIO m
=> AddHandler Bool
=> (V2 Float -> IO ())
-> AddHandler Bool
-> m (AddHandler Bool)
registerClickHoldEvent clickholdah = do
void $ liftIO $ register clickholdah $ \_ -> return ()
registerClickHoldEvent passfire clickholdah = do
void $ liftIO $ register clickholdah $ \x -> if x
then do
SDL.P vect <- SDL.getAbsoluteMouseLocation
passfire $ fmap fromIntegral vect
else
return ()
return clickholdah