{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module ArithmeticProgressionGame where import Data.List (intercalate) import Boardgame ( Player(..) , Position(..) , PositionalGame(..) , patternMatchingGameOver ) #ifdef WASM import Data.Aeson ( ToJSON(..) , object , (.=) ) #endif ------------------------------------------------------------------------------- -- * Arithmetic Progression Game ------------------------------------------------------------------------------- data ArithmeticProgressionGame = ArithmeticProgressionGame Int [Position] createArithmeticProgressionGame :: Int -> Int -> Maybe ArithmeticProgressionGame createArithmeticProgressionGame n k = if k < n then Just $ ArithmeticProgressionGame k (replicate n Empty) else Nothing instance Show ArithmeticProgressionGame where show (ArithmeticProgressionGame _ ps) = (\(is, ps) -> intercalate "," is ++ "\n" ++ intercalate "," ps) $ unzip $ zipWith (\i p -> (pad $ show i, pad $ showP p)) [1..] ps where showP Empty = " _" showP (Occupied Player1) = " \ESC[34mO\ESC[0m" showP (Occupied Player2) = " \ESC[31mX\ESC[0m" pad x = replicate (3 - length x) ' ' ++ x #ifdef WASM instance ToJSON ArithmeticProgressionGame where toJSON (ArithmeticProgressionGame n ps) = object [ "n" .= toJSON n , "positions" .= toJSON ps ] #endif instance PositionalGame ArithmeticProgressionGame Int where positions (ArithmeticProgressionGame _ l) = l getPosition (ArithmeticProgressionGame _ l) i = if i <= length l then Just $ l !! (i - 1) else Nothing setPosition (ArithmeticProgressionGame k l) i p = if i <= length l then Just $ ArithmeticProgressionGame k (take (i - 1) l ++ p : drop i l) else Nothing gameOver a@(ArithmeticProgressionGame k l) = let n = length l in patternMatchingGameOver (filter (all (<= n)) $ concat [[take k [i,i+j..] | j <- [1..n-i]] | i <- [1..n]]) a