Computer Chess Program which used Haskell Data.Array

gistfile1.hs

module Bd where
import Array
import Char
import Utils

-- types
data Pc=Pc {co::Co, pcType::PcType} deriving Eq
data PcType = Ro | Ni | Bi |
              Ki | Qu | Pa deriving (Eq,Enum)
data Co = Bl | Wh deriving (Eq,Enum)

type Pos=(Int, Int)
type Mv = (Pos,Pos)
type Sq = Maybe Pc
type Game = [Mv]
type Bd = Array Pos Sq

-- output functions
instance Show Co where
  show Bl = "B"
  show Wh = "W"
instance Show PcType where
  show Ki = "K"
  show Qu = "Q"
  show Ni = "N"
  show Ro = "R"
  show Bi = "B"
  show Pa = "P"
  
bound1=(0,7)
bound2=((0,0),(7,7))
range1=range bound1
rangeRow r=range((r,0),(r,7))
range2=range bound2

-- 升目の駒の表示
prettySq::Sq->String
prettySq Nothing="--"
prettySq(Just(Pc t c))=show c++show t
-- 升目の駒を文字列化して結合（行ごと）し、[行]をunlinesしてStringにする
prettyBd::Bd->String
prettyBd b=concatMap(('\n':).line) range1
  where
    line r=concatMap(\i->(++" ")$prettySq(b!(r,i))) range1
-- 各行をxだけインデントして盤面を出力
prettyBdIndent::Int->Bd->String
prettyBdIndent x =
  (concatMap(('\n':take x (repeat ' '))++))
  .lines.prettyBd
-- 色の反転
oppCo::Co->Co
oppCo Wh = Bl
oppCo Bl = Wh

-- 升目が空か判定
isEmpty::Bd->Pos->Bool
isEmpty bd pos = Nothing == getSq bd pos

-- 空のマス
emptySq::Sq
emptySq = Nothing

-- ある位置のSqを得る
getSq::Bd->Pos->Sq
getSq = (!)

-- BdのPosの位置をSqに変更
updateBd::Pos->Sq->Bd->Bd
updateBd p s=(//[(p,s)])

-- Posの位置を空のマスemptySqに更新
deleteSq::Pos->Bd->Bd
deleteSq p = updateBd p emptySq

-- mvs the pc at p1 to p2
-- p1にある駒を消し、p1の駒をp2に配置する
mvPos::Mv->Bd->Bd
mvPos (s1,s2) b = b//[(s1,b!s2),(s2,b!s1)]

mv::String->String->Bd->Bd
mv pc1 pc2 = mvPos (toPos pc1,toPos pc2)

-- computes the internal representation of "a1:h8"
-- a1とかh8を、内部表現(0,7),(7,0)とかに直す
toPos::String->Pos
toPos [x, y] = (7 - (ord y - ord '1'), ord x - ord 'a')

-- outsideはPosが盤外なら、Boolで返す
-- insideはPosが盤面かを、Boolで返す
outside,inside::Pos->Bool
outside (a, b) = a < 0 || b < 0 || a > 7 || b > 7
inside = not . outside

-- Coの駒すべてをBdから取って、[Pos]として返す
coPos::Co->Bd->[Pos]
coPos f bd = [(a, b)|a<-[0..7],b<-[0..7], hasCo f (getSq bd (a,b))]

-- Coの駒がSqにある
hasCo::Co->Sq->Bool
hasCo _ Nothing = False
hasCo c1 (Just (Pc c2 t)) = c1 == c2

-- **************** some bds *******************
iniBd::Bd
iniBd=(//(row0++row1++row6++row7))empBd
  where
    row0=bdLineList 0 Bl [Ro,Ni,Bi,Qu,Ki,Bi,Ni,Ro]
    row1=bdLineList 1 Bl $replicate 8 Pa
    row6=bdLineList 6 Wh $replicate 8 Pa
    row7=bdLineList 7 Wh [Ro,Ni,Bi,Qu,Ki,Bi,Ni,Ro]
    bdLineList r c pcs=
      zip (rangeRow r) (map(\t->Just(Pc c t))pcs)

empBd=array bound2[(i,Nothing)|i<-range2]