Continue making axis.hs main loop smaller.

1 files changed, 19 insertions, 23 deletions

diff --git a/axis.hs b/axis.hs
index 711fb9c..5363c36 100644
--- a/axis.hs
+++ b/axis.hs
@@ -224,7 +224,8 @@ 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
+   _setVideoMode :: Int -> Int -> IO SDL.Surface,
+   _warpMouse :: IO ()
 }
 
 main :: IO ()
@@ -236,10 +237,9 @@ main =
       info <- SDL.getVideoInfo
       let sWidth = SDL.videoInfoWidth info
           sHeight = SDL.videoInfoHeight info
-          warpMouse = do
-            _ <- SDL.warpMouse (fromIntegral (sWidth `div` 2)) (fromIntegral (sHeight `div` 2))
-            return ()
+          warpMouse = void $ SDL.warpMouse (fromIntegral (sWidth `div` 2)) (fromIntegral (sHeight `div` 2))
           setVideoMode wid hei = SDL.setVideoMode wid hei 32 [SDL.HWSurface, SDL.Resizable, SDL.DoubleBuf]
+
       _ <- setVideoMode sWidth sHeight
 
       _ <- SDL.TTF.init
@@ -253,7 +253,7 @@ main =
       putStrLn "Initialized."
 
       (_, ()) <- execRWST mainLoop
-                          (Env h q publicAddr setVideoMode)
+                          (Env h q publicAddr setVideoMode warpMouse)
                           (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font)
       return ()
 
@@ -266,7 +266,7 @@ setFont resolution = do
 
 parseEvents :: RWST Env () LoopState IO (Bool, Set.Set SDLKey, MidiPitchSet, (Int, Int), Integer)
 parseEvents = do
-    Env h q publicAddr setVideoMode <- ask
+    Env h q publicAddr setVideoMode _ <- ask
     LoopState _ colsRepeat midiKeysDown keysDown resolution _ <- get
 
     (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution
@@ -283,7 +283,7 @@ parseEvents = do
 
 mainLoop :: RWST Env () LoopState IO ()
 mainLoop = do
-    Env h q publicAddr setVideoMode <- ask
+    Env h q publicAddr setVideoMode _ <- ask
     LoopState firstLoop _ midiKeysDown keysDown _ _ <- get
 
     (restartVideo, keysDown', midiKeysDown', resolution, colsRepeat) <- parseEvents
@@ -307,9 +307,6 @@ mainLoop = do
 
     when firstLoop $ liftIO allKeysOFF
 
-    --      when (x /= x' && x' /= "") $ do
-    --        textBand videoSurface videoClipRect (SDL.Rect 0 0 0 70) font x'
-    --        return ()
     let chanfilter = Set.filter (\(c, _) -> c /= Event.Channel 9)
         beforeKeys = chanfilter midiKeysDown
         nowKeys = chanfilter midiKeysDown'
@@ -336,19 +333,8 @@ mainLoop = do
         when (keyDown SDL.SDLK_BACKSPACE keysDown') $ liftIO allKeysOFF
         when (keyDown SDL.SDLK_c keysDown') $ liftIO allKeysReallyOFF
 
-    --    Control.Monad.when (keysDown' /= keysDown) $ do
-    --      let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown'
-    --      textBand videoSurface videoClipRect (SDL.Rect 0 210 0 70) font chord
-    --      textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $
-    --        if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else ""
-    --      return ()
-    --    Control.Monad.when(False) $ do
-    --
-    --      mouse <- SDL.getRelativeMouseState
-    --      let (x, y, button) = mouse
-    --      let text = ((show x) ++ " " ++ (show y) ++ " " ++ (show button))
-    --      textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text
-    --      Control.Monad.when (x /= 0 || y /= 0) warpMouse
+    when False $ mouseWarpTest videoSurface videoClipRect
+
     void $ liftIO $ SDL.flip videoSurface
     let framerate = 30
     let delay = 1000 `div` framerate -- TODO: subtract delta
@@ -357,6 +343,16 @@ mainLoop = do
         put (LoopState False colsRepeat midiKeysDown' keysDown' resolution font)
         mainLoop
 
+mouseWarpTest videoSurface videoClipRect = do
+    warpMouse <- asks _warpMouse
+    font <- gets _sdlFont
+
+    mouse <- liftIO SDL.getRelativeMouseState
+    let (x, y, button) = mouse
+    let text = unwords [show x, show y, show button]
+    liftIO $ textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text
+    when (x /= 0 || y /= 0) $ liftIO warpMouse
+
 zipzip :: [[b]] -> [[b]]
 zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls)