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