new accessors

This commit is contained in:
nek0 2016-12-12 02:11:31 +01:00
parent 05b126ef94
commit 4eaa644cbf

View file

@ -68,16 +68,15 @@ load _ = do
drawInit :: Affection UserData () drawInit :: Affection UserData ()
drawInit = do drawInit = do
AffectionData{..} <- get UserData{..} <- getAffection
let UserData{..} = userState
present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True present (nodeGraph M.! "over") foreground (GeglRectangle 0 0 800 600) True
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do
traceM "drawing" traceM "drawing"
AffectionData{..} <- get ad <- get
let UserData{..} = userState UserData{..} <- getAffection
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad
let (w, h) = (fromIntegral rw, fromIntegral rh) let (w, h) = (fromIntegral rw, fromIntegral rh)
liftIO $ clearArea foreground (GeglRectangle 0 0 w h) liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
maybe (return ()) (\(x, y) -> maybe (return ()) (\(x, y) ->
@ -92,19 +91,17 @@ draw = do
update :: Double -> AffectionState (AffectionData UserData) IO () update :: Double -> AffectionState (AffectionData UserData) IO ()
update sec = do update sec = do
traceM "updating" traceM "updating"
ad@AffectionData{..} <- get ad <- get
let ud@UserData{..} = userState ud <- getAffection
traceM $ (show $ 1 / sec) ++ " FPS" traceM $ (show $ 1 / sec) ++ " FPS"
ev <- liftIO $ SDL.pollEvent ev <- liftIO $ SDL.pollEvent
maybe (return ()) (\e -> maybe (return ()) (\e ->
case SDL.eventPayload e of case SDL.eventPayload e of
SDL.MouseMotionEvent dat -> do SDL.MouseMotionEvent dat -> do
let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
put $ ad putAffection $ ud
{ userState = ud
{ coordinates = Just (fromIntegral x, fromIntegral y) { coordinates = Just (fromIntegral x, fromIntegral y)
} }
}
SDL.WindowClosedEvent _ -> do SDL.WindowClosedEvent _ -> do
traceM "seeya!" traceM "seeya!"
put $ ad put $ ad