diff options
-rw-r--r-- | axis.hs | 42 |
1 files changed, 23 insertions, 19 deletions
@@ -184,21 +184,26 @@ rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi | |||
184 | 184 | ||
185 | chooseFontSize h w = 30 * d `div` 1024 where d = min h w | 185 | chooseFontSize h w = 30 * d `div` 1024 where d = min h w |
186 | 186 | ||
187 | data LoopState = LoopState { | ||
188 | firstLoop :: Bool, | ||
189 | repeatCols :: Integer | ||
190 | } deriving (Show) | ||
191 | |||
192 | _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] | 187 | _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] |
193 | firstDigitDown :: Set.Set SDL.Keysym.SDLKey -> Maybe Integer | 188 | firstDigitDown :: Set.Set SDL.Keysym.SDLKey -> Maybe Integer |
194 | firstDigitDown k = if Set.null digitsDown then Nothing else Just $ (-48 +) $ fromIntegral $ SDL.Util.fromEnum $ Set.findMin digitsDown | 189 | firstDigitDown k = if Set.null digitsDown then Nothing else Just $ (-48 +) $ fromIntegral $ SDL.Util.fromEnum $ Set.findMin digitsDown |
195 | where digitsDown = Set.intersection _SDL_DIGITS k | 190 | where digitsDown = Set.intersection _SDL_DIGITS k |
196 | 191 | ||
197 | data Env = Env | 192 | data LoopState = LoopState { |
198 | (Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode) | 193 | _firstLoop :: Bool, |
199 | Sound.ALSA.Sequencer.Queue.T | 194 | _repeatCols :: Integer, |
200 | Sound.ALSA.Sequencer.Address.T | 195 | _midiKeysDown :: Set.Set (Event.Channel, Event.Pitch), |
201 | (Int -> Int -> IO SDL.Surface) | 196 | _sdlKeysDown :: Set.Set SDLKey, |
197 | _sdlResolution :: (Int, Int), | ||
198 | _sdlFont :: SDL.TTF.Font | ||
199 | } | ||
200 | |||
201 | data Env = Env { | ||
202 | _h :: Sound.ALSA.Sequencer.T Sound.ALSA.Sequencer.DuplexMode, | ||
203 | _q :: Sound.ALSA.Sequencer.Queue.T, | ||
204 | _publicAddr :: Sound.ALSA.Sequencer.Address.T, | ||
205 | _setVideoMode :: Int -> Int -> IO SDL.Surface | ||
206 | } | ||
202 | 207 | ||
203 | main = | 208 | main = |
204 | withAlsaInit $ \h public private q publicAddr privateAddr -> do | 209 | withAlsaInit $ \h public private q publicAddr privateAddr -> do |
@@ -223,16 +228,15 @@ main = | |||
223 | -- SDL.createRGBSurfaceEndian [] 1 1 24 | 228 | -- SDL.createRGBSurfaceEndian [] 1 1 24 |
224 | putStrLn "Initialized." | 229 | putStrLn "Initialized." |
225 | 230 | ||
226 | (_, ()) <- execRWST | 231 | (_, ()) <- execRWST mainLoop |
227 | (mainLoop Set.empty Set.empty (sWidth, sHeight) font) | 232 | (Env h q publicAddr setVideoMode) |
228 | (Env h q publicAddr setVideoMode) (LoopState True _AXIS_COLS_REPEAT) | 233 | (LoopState True _AXIS_COLS_REPEAT Set.empty Set.empty (sWidth, sHeight) font) |
229 | return () | 234 | return () |
230 | 235 | ||
231 | mainLoop :: (MonadIO f, MonadState LoopState f, MonadReader Env f) | 236 | mainLoop :: RWST Env () LoopState IO () |
232 | => Set.Set (Event.Channel, Event.Pitch) -> Set.Set SDLKey -> (Int, Int) -> SDL.TTF.Font -> f () | 237 | mainLoop = do |
233 | mainLoop midiKeysDown keysDown resolution font = do | ||
234 | Env h q publicAddr setVideoMode <- ask | 238 | Env h q publicAddr setVideoMode <- ask |
235 | LoopState firstLoop colsRepeat <- get | 239 | LoopState firstLoop colsRepeat midiKeysDown keysDown resolution font <- get |
236 | 240 | ||
237 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution | 241 | (keysDown', resolution') <- liftIO $ parseSDLEvents keysDown resolution |
238 | midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr) | 242 | midiKeysDown' <- liftIO $ parseAlsaEvents h midiKeysDown (forwardNoteEvent h q publicAddr) |
@@ -312,8 +316,8 @@ mainLoop midiKeysDown keysDown resolution font = do | |||
312 | let delay = 1000 `div` framerate -- TODO: subtract delta | 316 | let delay = 1000 `div` framerate -- TODO: subtract delta |
313 | liftIO $ SDL.delay delay | 317 | liftIO $ SDL.delay delay |
314 | unless (keyDown SDL.SDLK_ESCAPE keysDown) $ do | 318 | unless (keyDown SDL.SDLK_ESCAPE keysDown) $ do |
315 | put (LoopState False colsRepeat') | 319 | put (LoopState False colsRepeat' midiKeysDown' keysDown' resolution' font') |
316 | mainLoop midiKeysDown' keysDown' resolution' font' | 320 | mainLoop |
317 | 321 | ||
318 | zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls) | 322 | zipzip ls = if null (head ls) then [] else map head ls : zipzip (map tail ls) |
319 | 323 | ||