midimory-0.0.2.3: src/Main.hs

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