diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-17 22:21:29 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-17 22:21:29 -0500 |
commit | 9cd1f630d077de4851fc8783ff80e62b7ef3bf3e (patch) | |
tree | ddc0c83e52753dffc9ae3ff73a5862e241464872 | |
parent | 84350cf791beb1b0b42c1bd8b9cc82214d54f39a (diff) |
axis.hs: move a few things out of the giant main loop
-rw-r--r-- | axis.hs | 30 |
1 files changed, 21 insertions, 9 deletions
@@ -236,30 +236,42 @@ main = | |||
236 | (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font) | 236 | (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font) |
237 | return () | 237 | return () |
238 | 238 | ||
239 | mainLoop :: RWST Env () LoopState IO () | 239 | setFont resolution' = do |
240 | mainLoop = do | 240 | font <- gets _sdlFont |
241 | let (w, h) = resolution' | ||
242 | fontSize = chooseFontSize w h | ||
243 | font' <- liftIO $ SDL.TTF.openFont "LiberationMono-Bold.ttf" fontSize | ||
244 | modify $ \s -> s { _sdlFont = font' } | ||
245 | |||
246 | parseEvents = do | ||
241 | Env h q publicAddr setVideoMode <- ask | 247 | Env h q publicAddr setVideoMode <- ask |
242 | LoopState firstLoop colsRepeat midiKeysDown keysDown resolution font <- get | 248 | LoopState _ colsRepeat midiKeysDown keysDown resolution _ <- get |
243 | 249 | ||
244 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution | 250 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution |
245 | midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr) | 251 | midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr) |
252 | |||
246 | let colsRepeat' = | 253 | let colsRepeat' = |
247 | case firstDigitDown keysDown' of | 254 | case firstDigitDown keysDown' of |
248 | Nothing -> colsRepeat | 255 | Nothing -> colsRepeat |
249 | (Just 0) -> colsRepeat | 256 | (Just 0) -> colsRepeat |
250 | (Just n) -> n | 257 | (Just n) -> n |
251 | |||
252 | let restartVideo = resolution' /= resolution || colsRepeat' /= colsRepeat | 258 | let restartVideo = resolution' /= resolution || colsRepeat' /= colsRepeat |
253 | 259 | ||
260 | return (restartVideo, keysDown', midiKeysDown', resolution', colsRepeat') | ||
261 | |||
262 | mainLoop :: RWST Env () LoopState IO () | ||
263 | mainLoop = do | ||
264 | Env h q publicAddr setVideoMode <- ask | ||
265 | LoopState firstLoop _ midiKeysDown keysDown _ _ <- get | ||
266 | |||
267 | (restartVideo, keysDown', midiKeysDown', resolution', colsRepeat') <- parseEvents | ||
268 | |||
254 | when restartVideo $ do | 269 | when restartVideo $ do |
255 | let (w, h) = resolution' | 270 | let (w, h) = resolution' |
256 | void $ liftIO $ setVideoMode w h | 271 | void $ liftIO $ setVideoMode w h |
272 | setFont resolution' | ||
257 | 273 | ||
258 | let (w, h) = resolution' | 274 | font' <- gets _sdlFont |
259 | fontSize = chooseFontSize w h | ||
260 | font' <- if restartVideo | ||
261 | then liftIO $ SDL.TTF.openFont "LiberationMono-Bold.ttf" fontSize | ||
262 | else return font | ||
263 | 275 | ||
264 | videoSurface <- liftIO SDL.getVideoSurface | 276 | videoSurface <- liftIO SDL.getVideoSurface |
265 | videoClipRect <- liftIO $ SDL.getClipRect videoSurface | 277 | videoClipRect <- liftIO $ SDL.getClipRect videoSurface |