diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-18 02:56:15 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-18 02:56:15 -0500 |
commit | b1fa4c0769d19b80dca5c67605d779a70bf2d3f6 (patch) | |
tree | b30e973f9817bb23f34a8711319d0b6b6f117f88 /axis.hs | |
parent | 4cde742b99fe000cf0bb7b0a0f28900a40ce140f (diff) |
Continue making axis.hs main loop smaller.
Diffstat (limited to 'axis.hs')
-rw-r--r-- | axis.hs | 42 |
1 files changed, 19 insertions, 23 deletions
@@ -224,7 +224,8 @@ data Env = Env { | |||
224 | _h :: Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode, | 224 | _h :: Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode, |
225 | _q :: Sound.ALSA.Sequencer.Queue.T, | 225 | _q :: Sound.ALSA.Sequencer.Queue.T, |
226 | _publicAddr :: Sound.ALSA.Sequencer.Address.T, | 226 | _publicAddr :: Sound.ALSA.Sequencer.Address.T, |
227 | _setVideoMode :: Int -> Int -> IO SDL.Surface | 227 | _setVideoMode :: Int -> Int -> IO SDL.Surface, |
228 | _warpMouse :: IO () | ||
228 | } | 229 | } |
229 | 230 | ||
230 | main :: IO () | 231 | main :: IO () |
@@ -236,10 +237,9 @@ main = | |||
236 | info <- SDL.getVideoInfo | 237 | info <- SDL.getVideoInfo |
237 | let sWidth = SDL.videoInfoWidth info | 238 | let sWidth = SDL.videoInfoWidth info |
238 | sHeight = SDL.videoInfoHeight info | 239 | sHeight = SDL.videoInfoHeight info |
239 | warpMouse = do | 240 | warpMouse = void $ SDL.warpMouse (fromIntegral (sWidth `div` 2)) (fromIntegral (sHeight `div` 2)) |
240 | _ <- SDL.warpMouse (fromIntegral (sWidth `div` 2)) (fromIntegral (sHeight `div` 2)) | ||
241 | return () | ||
242 | setVideoMode wid hei = SDL.setVideoMode wid hei 32 [SDL.HWSurface, SDL.Resizable, SDL.DoubleBuf] | 241 | setVideoMode wid hei = SDL.setVideoMode wid hei 32 [SDL.HWSurface, SDL.Resizable, SDL.DoubleBuf] |
242 | |||
243 | _ <- setVideoMode sWidth sHeight | 243 | _ <- setVideoMode sWidth sHeight |
244 | 244 | ||
245 | _ <- SDL.TTF.init | 245 | _ <- SDL.TTF.init |
@@ -253,7 +253,7 @@ main = | |||
253 | putStrLn "Initialized." | 253 | putStrLn "Initialized." |
254 | 254 | ||
255 | (_, ()) <- execRWST mainLoop | 255 | (_, ()) <- execRWST mainLoop |
256 | (Env h q publicAddr setVideoMode) | 256 | (Env h q publicAddr setVideoMode warpMouse) |
257 | (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font) | 257 | (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font) |
258 | return () | 258 | return () |
259 | 259 | ||
@@ -266,7 +266,7 @@ setFont resolution = do | |||
266 | 266 | ||
267 | parseEvents :: RWST Env () LoopState IO (Bool, Set.Set SDLKey, MidiPitchSet, (Int, Int), Integer) | 267 | parseEvents :: RWST Env () LoopState IO (Bool, Set.Set SDLKey, MidiPitchSet, (Int, Int), Integer) |
268 | parseEvents = do | 268 | parseEvents = do |
269 | Env h q publicAddr setVideoMode <- ask | 269 | Env h q publicAddr setVideoMode _ <- ask |
270 | LoopState _ colsRepeat midiKeysDown keysDown resolution _ <- get | 270 | LoopState _ colsRepeat midiKeysDown keysDown resolution _ <- get |
271 | 271 | ||
272 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution | 272 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution |
@@ -283,7 +283,7 @@ parseEvents = do | |||
283 | 283 | ||
284 | mainLoop :: RWST Env () LoopState IO () | 284 | mainLoop :: RWST Env () LoopState IO () |
285 | mainLoop = do | 285 | mainLoop = do |
286 | Env h q publicAddr setVideoMode <- ask | 286 | Env h q publicAddr setVideoMode _ <- ask |
287 | LoopState firstLoop _ midiKeysDown keysDown _ _ <- get | 287 | LoopState firstLoop _ midiKeysDown keysDown _ _ <- get |
288 | 288 | ||
289 | (restartVideo, keysDown', midiKeysDown', resolution, colsRepeat) <- parseEvents | 289 | (restartVideo, keysDown', midiKeysDown', resolution, colsRepeat) <- parseEvents |
@@ -307,9 +307,6 @@ mainLoop = do | |||
307 | 307 | ||
308 | when firstLoop $ liftIO allKeysOFF | 308 | when firstLoop $ liftIO allKeysOFF |
309 | 309 | ||
310 | -- when (x /= x' && x' /= "") $ do | ||
311 | -- textBand videoSurface videoClipRect (SDL.Rect 0 0 0 70) font x' | ||
312 | -- return () | ||
313 | let chanfilter = Set.filter (\(c, _) -> c /= Event.Channel 9) | 310 | let chanfilter = Set.filter (\(c, _) -> c /= Event.Channel 9) |
314 | beforeKeys = chanfilter midiKeysDown | 311 | beforeKeys = chanfilter midiKeysDown |
315 | nowKeys = chanfilter midiKeysDown' | 312 | nowKeys = chanfilter midiKeysDown' |
@@ -336,19 +333,8 @@ mainLoop = do | |||
336 | when (keyDown SDL.SDLK_BACKSPACE keysDown') $ liftIO allKeysOFF | 333 | when (keyDown SDL.SDLK_BACKSPACE keysDown') $ liftIO allKeysOFF |
337 | when (keyDown SDL.SDLK_c keysDown') $ liftIO allKeysReallyOFF | 334 | when (keyDown SDL.SDLK_c keysDown') $ liftIO allKeysReallyOFF |
338 | 335 | ||
339 | -- Control.Monad.when (keysDown' /= keysDown) $ do | 336 | when False $ mouseWarpTest videoSurface videoClipRect |
340 | -- let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown' | 337 | |
341 | -- textBand videoSurface videoClipRect (SDL.Rect 0 210 0 70) font chord | ||
342 | -- textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $ | ||
343 | -- if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else "" | ||
344 | -- return () | ||
345 | -- Control.Monad.when(False) $ do | ||
346 | -- | ||
347 | -- mouse <- SDL.getRelativeMouseState | ||
348 | -- let (x, y, button) = mouse | ||
349 | -- let text = ((show x) ++ " " ++ (show y) ++ " " ++ (show button)) | ||
350 | -- textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text | ||
351 | -- Control.Monad.when (x /= 0 || y /= 0) warpMouse | ||
352 | void $ liftIO $ SDL.flip videoSurface | 338 | void $ liftIO $ SDL.flip videoSurface |
353 | let framerate = 30 | 339 | let framerate = 30 |
354 | let delay = 1000 `div` framerate -- TODO: subtract delta | 340 | let delay = 1000 `div` framerate -- TODO: subtract delta |
@@ -357,6 +343,16 @@ mainLoop = do | |||
357 | put (LoopState False colsRepeat midiKeysDown' keysDown' resolution font) | 343 | put (LoopState False colsRepeat midiKeysDown' keysDown' resolution font) |
358 | mainLoop | 344 | mainLoop |
359 | 345 | ||
346 | mouseWarpTest videoSurface videoClipRect = do | ||
347 | warpMouse <- asks _warpMouse | ||
348 | font <- gets _sdlFont | ||
349 | |||
350 | mouse <- liftIO SDL.getRelativeMouseState | ||
351 | let (x, y, button) = mouse | ||
352 | let text = unwords [show x, show y, show button] | ||
353 | liftIO $ textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text | ||
354 | when (x /= 0 || y /= 0) $ liftIO warpMouse | ||
355 | |||
360 | zipzip :: [[b]] -> [[b]] | 356 | zipzip :: [[b]] -> [[b]] |
361 | zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls) | 357 | zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls) |
362 | 358 | ||