new accessors
This commit is contained in:
parent
05b126ef94
commit
4eaa644cbf
1 changed files with 8 additions and 11 deletions
|
@ -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,18 +91,16 @@ 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!"
|
||||||
|
|
Loading…
Reference in a new issue