axis.hs: convert remaining mainloop parameters to use RWST

1 files changed, 23 insertions, 19 deletions

diff --git a/axis.hs b/axis.hs
index cdbcc7c..51805fc 100644
--- a/axis.hs
+++ b/axis.hs
@@ -184,21 +184,26 @@ rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi
 
 chooseFontSize h w = 30 * d `div` 1024 where d = min h w
 
-data LoopState = LoopState {
-  firstLoop :: Bool,
-  repeatCols :: Integer
-} deriving (Show)
-
 _SDL_DIGITS = Set.fromList [SDL.SDLK_1, SDL.SDLK_2, SDL.SDLK_3, SDL.SDLK_4, SDL.SDLK_5, SDL.SDLK_6, SDL.SDLK_7, SDL.SDLK_8, SDL.SDLK_9, SDL.SDLK_0]
 firstDigitDown :: Set.Set SDL.Keysym.SDLKey -> Maybe Integer
 firstDigitDown k = if Set.null digitsDown then Nothing else Just $ (-48 +) $ fromIntegral $ SDL.Util.fromEnum $ Set.findMin digitsDown
   where digitsDown = Set.intersection _SDL_DIGITS k
 
-data Env = Env
-                (Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode)
-                Sound.ALSA.Sequencer.Queue.T
-                Sound.ALSA.Sequencer.Address.T
-                (Int -> Int -> IO SDL.Surface)
+data LoopState = LoopState {
+   _firstLoop :: Bool,
+   _repeatCols :: Integer,
+   _midiKeysDown :: Set.Set (Event.Channel, Event.Pitch),
+   _sdlKeysDown :: Set.Set SDLKey,
+   _sdlResolution :: (Int, Int),
+   _sdlFont :: SDL.TTF.Font
+}
+
+data Env = Env {
+   _h :: Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode,
+   _q :: Sound.ALSA.Sequencer.Queue.T,
+   _publicAddr :: Sound.ALSA.Sequencer.Address.T,
+   _setVideoMode :: Int -> Int -> IO SDL.Surface
+}
 
 main =
   withAlsaInit $ \h public private q publicAddr privateAddr -> do
@@ -223,16 +228,15 @@ main =
       -- SDL.createRGBSurfaceEndian [] 1 1 24
       putStrLn "Initialized."
 
-      (_, ()) <- execRWST
-                    (mainLoop Set.empty Set.empty (sWidth, sHeight) font)
-                    (Env h q publicAddr setVideoMode) (LoopState True _AXIS_COLS_REPEAT)
+      (_, ()) <- execRWST mainLoop
+                          (Env h q publicAddr setVideoMode)
+                          (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font)
       return ()
 
-mainLoop :: (MonadIO f, MonadState LoopState f, MonadReader Env f)
-         => Set.Set (Event.Channel, Event.Pitch) -> Set.Set SDLKey -> (Int, Int) -> SDL.TTF.Font -> f ()
-mainLoop midiKeysDown keysDown resolution font = do
+mainLoop :: RWST Env () LoopState IO ()
+mainLoop = do
     Env h q publicAddr setVideoMode <- ask
-    LoopState firstLoop colsRepeat <- get
+    LoopState firstLoop colsRepeat midiKeysDown keysDown resolution font <- get
 
     (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution
     midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr)
@@ -312,8 +316,8 @@ mainLoop midiKeysDown keysDown resolution font = do
     let delay = 1000 `div` framerate -- TODO: subtract delta
     liftIO $ SDL.delay delay
     unless (keyDown SDL.SDLK_ESCAPE keysDown) $ do
-        put (LoopState False colsRepeat')
-        mainLoop  midiKeysDown' keysDown' resolution' font'
+        put (LoopState False colsRepeat' midiKeysDown' keysDown' resolution' font')
+        mainLoop
 
 zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls)