midimory-0.0.2: src/Game.hs

module Game where

import qualified Configuration as Config

import qualified Sound.ALSA.Sequencer.Event as Event

import qualified System.Random as Rnd

import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.Trans.Class as MT
import Control.Monad (forM)
import Control.Applicative ((<$>))

import qualified Data.Sequence as Seq
import qualified Data.Array as Array
import Data.Sequence (Seq, ViewL((:<)), (><), )
import Data.Array (Array)



data Player = PlayerA | PlayerB

switchPlayer :: Player -> Player
switchPlayer PlayerA = PlayerB
switchPlayer PlayerB = PlayerA

formatPlayer :: Player -> String
formatPlayer PlayerA = "Player A"
formatPlayer PlayerB = "Player B"


data Choice = First | Second

makeMessage :: Player -> Choice -> String
makeMessage player choice =
   formatPlayer player ++ ": Hit " ++
   (case choice of First -> "first"; Second -> "second") ++
   " button!"

completeMessage :: (Ord a, Num a) => a -> Player -> (a, a) -> String
completeMessage maxScore pl (a,b) =
   let winners =
         if a+b < maxScore
           then []
           else
              case compare a b of
                 GT -> [PlayerA]
                 LT -> [PlayerB]
                 EQ -> [PlayerA, PlayerB]
   in case winners of
         [] -> makeMessage pl First
         [winner] -> "Game Over! The winner is " ++ formatPlayer winner
         _ -> "Game Over! Stalemate!"



pick :: Int -> Seq a -> (a, Seq a)
pick n as =
   let (prefix, suffix) = Seq.splitAt n as
   in  case Seq.viewl suffix of
          Seq.EmptyL -> error "pick: index too large"
          a :< rest -> (a, prefix >< rest)

shuffle :: (Rnd.RandomGen g) => [a] -> MS.State g [a]
shuffle xs =
   flip MS.evalStateT (Seq.fromList xs) $
   forM (takeWhile (>=0) $ tail $ iterate (subtract 1) (length xs)) $ \maxN -> do
      n <- MT.lift $ MS.state $ Rnd.randomR (0, maxN)
      MS.state $ pick n

shufflePitches ::
   (Rnd.RandomGen g) => Config.T -> MS.State g (Array (Int, Int) Event.Pitch)
shufflePitches cfg =
   Array.listArray ((0, 0), (Config.rows cfg - 1, Config.columns cfg - 1))
   <$>
   shuffle ((\ps -> ps++ps) $ Config.pitches cfg)