summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-17 22:21:29 -0500
committerAndrew Cady <d@jerkface.net>2015-12-17 22:21:29 -0500
commit9cd1f630d077de4851fc8783ff80e62b7ef3bf3e (patch)
treeddc0c83e52753dffc9ae3ff73a5862e241464872
parent84350cf791beb1b0b42c1bd8b9cc82214d54f39a (diff)
axis.hs: move a few things out of the giant main loop
-rw-r--r--axis.hs30
1 files changed, 21 insertions, 9 deletions
diff --git a/axis.hs b/axis.hs
index 6a0a844..89ba636 100644
--- a/axis.hs
+++ b/axis.hs
@@ -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
239mainLoop :: RWST Env () LoopState IO () 239setFont resolution' = do
240mainLoop = 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
246parseEvents = 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
262mainLoop :: RWST Env () LoopState IO ()
263mainLoop = 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