From 9cd1f630d077de4851fc8783ff80e62b7ef3bf3e Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Thu, 17 Dec 2015 22:21:29 -0500
Subject: axis.hs: move a few things out of the giant main loop

---
 axis.hs | 30 +++++++++++++++++++++---------
 1 file 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 =
                           (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font)
       return ()
 
-mainLoop :: RWST Env () LoopState IO ()
-mainLoop = do
+setFont resolution' = do
+    font <- gets _sdlFont
+    let (w, h) = resolution'
+        fontSize = chooseFontSize w h
+    font' <- liftIO $ SDL.TTF.openFont "LiberationMono-Bold.ttf" fontSize
+    modify $ \s -> s { _sdlFont = font' }
+
+parseEvents = do
     Env h q publicAddr setVideoMode <- ask
-    LoopState firstLoop colsRepeat midiKeysDown keysDown resolution font <- get
+    LoopState _ colsRepeat midiKeysDown keysDown resolution _ <- get
 
     (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution
     midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr)
+
     let colsRepeat' =
             case firstDigitDown keysDown' of
             Nothing  -> colsRepeat
             (Just 0) -> colsRepeat
             (Just n) -> n
-
     let restartVideo = resolution' /= resolution || colsRepeat' /= colsRepeat
 
+    return (restartVideo, keysDown', midiKeysDown', resolution', colsRepeat')
+
+mainLoop :: RWST Env () LoopState IO ()
+mainLoop = do
+    Env h q publicAddr setVideoMode <- ask
+    LoopState firstLoop _ midiKeysDown keysDown _ _ <- get
+
+    (restartVideo, keysDown', midiKeysDown', resolution', colsRepeat') <- parseEvents
+
     when restartVideo $ do
         let (w, h) = resolution'
         void $ liftIO $ setVideoMode w h
+        setFont resolution'
 
-    let (w, h) = resolution'
-        fontSize = chooseFontSize w h
-    font' <- if restartVideo
-                then liftIO $ SDL.TTF.openFont "LiberationMono-Bold.ttf" fontSize
-                else return font
+    font' <- gets _sdlFont
 
     videoSurface <- liftIO SDL.getVideoSurface
     videoClipRect <- liftIO $ SDL.getClipRect videoSurface
-- 
cgit v1.2.3