module Main where import qualified GUI import qualified Game import qualified Configuration as Config import qualified Option import qualified MIDI import Game (Choice(First,Second), Player(PlayerA,PlayerB), switchPlayer) import qualified Sound.ALSA.Sequencer.Event as Event import qualified Graphics.UI.WX as WX import Graphics.UI.WX (Prop((:=)), text, selection, command, on) import qualified System.Random as Rnd import qualified Control.Monad.Trans.State as MS import Control.Monad (forM_) import Control.Applicative (liftA2, liftA3, (<$>)) import Data.Array (Array, (!)) import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef, ) shufflePitches :: Config.T -> IO (Array (Int, Int) Event.Pitch) shufflePitches cfg = MS.evalState (Game.shufflePitches cfg) . Rnd.mkStdGen <$> Rnd.randomIO type State = (IORef (Array (Int, Int) Event.Pitch), IORef (Maybe (WX.Button (), Event.Pitch)), IORef Player) move :: MIDI.Sequencer -> GUI.T -> State -> ((Int,Int), WX.Button ()) -> IO () move sequ gui (pitches, selected, player) (pos,b) = do pitch <- (!pos) <$> readIORef pitches MIDI.sendNote sequ pitch mfirst <- readIORef selected case mfirst of Nothing -> do writeIORef selected $ Just (b, pitch) WX.set b [ WX.enabled := False ] pl <- readIORef player WX.set (GUI.message gui) [ text := Game.makeMessage pl Second ] Just (firstButton, firstPitch) -> do writeIORef selected Nothing pl <- readIORef player if firstPitch == pitch then do WX.set b [ WX.enabled := False ] let score = case pl of PlayerA -> GUI.scoreA gui PlayerB -> GUI.scoreB gui n <- WX.get score selection WX.set score [ selection := succ n ] else do WX.set firstButton [ WX.enabled := True ] modifyIORef player switchPlayer newpl <- readIORef player score <- liftA2 (,) (WX.get (GUI.scoreA gui) selection) (WX.get (GUI.scoreB gui) selection) WX.set (GUI.message gui) [ text := Game.completeMessage (GUI.maxScore gui) newpl score ] restart :: Config.T -> GUI.T -> State -> IO () restart cfg gui (pitches, selected, player) = do mapM_ (\(_pos,b) -> WX.set b [ WX.enabled := True ]) $ concat $ GUI.matrix gui WX.set (GUI.scoreA gui) [ selection := 0 ] WX.set (GUI.scoreB gui) [ selection := 0 ] WX.set (GUI.message gui) [ text := Game.makeMessage PlayerA First ] writeIORef pitches =<< shufflePitches cfg writeIORef selected Nothing writeIORef player PlayerA runGUI :: Config.T -> MIDI.Sequencer -> IO () runGUI cfg sequ = do gui <- GUI.create cfg state <- liftA3 (,,) (newIORef =<< shufflePitches cfg) (newIORef Nothing) (newIORef PlayerA) forM_ (concat $ GUI.matrix gui) $ \(pos,b) -> WX.set b [ on command := move sequ gui state (pos,b) ] WX.set (GUI.restart gui) [ on command := restart cfg gui state ] main :: IO () main = do (config, (dests,chan)) <- Option.multiArgs "Concentration game for tones" MIDI.withSequencer "Midimory" chan $ \sequ -> do mapM_ (MIDI.parseAndConnect sequ) dests WX.start $ runGUI config sequ