packages feed

hcheckers-0.1.0.0: src/Rules/Diagonal.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Rules.Diagonal (Diagonal, diagonal) where

import Data.Typeable

import Core.Types
import Core.Board
import Core.Evaluator
import Rules.Russian
import Rules.Generic

newtype Diagonal = Diagonal GenericRules
  deriving (Typeable, HasBoardOrientation)

instance Show Diagonal where
  show = rulesName

instance GameRules Diagonal where
  initBoard rnd r =
    let board = buildBoard rnd (boardOrientation r) (8, 8)
        labels1 = ["c1", "e1", "g1",
                   "d2", "f2", "h2",
                   "e3", "g3",
                   "f4", "h4",
                   "g5",
                   "h6"]
        labels2 = ["b8", "d8", "f8",
                   "a7", "c7", "e7",
                   "b6", "d6",
                   "a5", "c5",
                   "b4",
                   "a3"]
    in  setManyPieces' labels1 (Piece Man First) $ setManyPieces' labels2 (Piece Man Second) board

  boardSize _ = (8, 8)

  dfltEvaluator r = SomeEval $ defaultEvaluator r

  boardNotation _ = boardNotation russian

  parseNotation _ = parseNotation russian

  rulesName _ = "diagonal"

  possibleMoves _ = possibleMoves russian
  mobilityScore _ = mobilityScore russian

  updateRules r _ = r

  getGameResult = genericGameResult

  pdnId _ = "42"

diagonal :: Diagonal
diagonal = Diagonal $
  let rules = russianBase rules
  in  rules