12Janggi/Helper.hs at master · bmaclach/12Janggi · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
module Helper (isPlaceable, getValidMoves, currentPlayer, otherPlayer,
  yourTerritory, enemyTerritory, isActive) where

import Model
import Control.Lens ((^.), set, over, _1)
import Prelude hiding (Left, Right)

isPlaceable :: Position -> GameState -> Bool
isPlaceable pos gs = let allPieces = gs ^. player1 ++ gs ^. player2
  in isValidPosition pos && not
    (pos `elem` map (^. position) allPieces
    || pos ^. _1 == enemyTerritory gs)

getValidMoves :: GameState -> [Move]
getValidMoves gs = let
  yourTurn = gs ^. turnTracker
  movementModifier = if yourTurn then 1 else -1
  you = gs ^. currentPlayer gs
  opponent = gs ^. otherPlayer gs
  getValidMovesForPiece :: [Move] -> Piece -> [Move]
  getValidMovesForPiece mvs pc =
    mvs ++ (map (uncurry Mv . over _1 (flip (set position) pc)) (getPossibleMoves pc))
  getPossibleMoves :: Piece -> [(Position, Direction)]
  getPossibleMoves (P _ _ (0,0)) = []
  getPossibleMoves (P _ r (x,y)) = let
    direcs = getMovableDirections r
    newPos = map (\d ->
      (x + (movementModifier * xMovement d),
      y + (movementModifier * yMovement d))) direcs
    in [(p, d) | (p, d) <- zip newPos direcs,
    isValidPosition p, p `notElem` map (^. position) you]
  in foldl getValidMovesForPiece [] you

getMovableDirections :: Role -> [Direction]
getMovableDirections Man = [Forward]
getMovableDirections General = [Forward, Back, Right, Left]
getMovableDirections Minister = [ForwardRight, ForwardLeft, BackRight, BackLeft]
getMovableDirections King = [Forward, Back, Right, Left, ForwardRight,
  ForwardLeft, BackRight, BackLeft]
getMovableDirections FeudalLord = [Forward, Back, Right, Left, ForwardRight,
  ForwardLeft]

isValidPosition :: Position -> Bool
isValidPosition (x,y) = 0 < x && x < 5 && 0 < y && y < 4

isActive :: Piece -> Bool
isActive pc = pc ^. position /= (0,0)

isForward :: Direction -> Bool
isForward Forward = True
isForward ForwardRight = True
isForward ForwardLeft = True
isForward _ = False

isBack :: Direction -> Bool
isBack Back = True
isBack BackRight = True
isBack BackLeft = True
isBack _ = False

xMovement :: Direction -> Int
xMovement d
  | isForward d = 1
  | isBack d = -1
  | otherwise = 0

isRight :: Direction -> Bool
isRight Right = True
isRight ForwardRight = True
isRight BackRight = True
isRight _ = False

isLeft :: Direction -> Bool
isLeft Left = True
isLeft ForwardLeft = True
isLeft BackLeft = True
isLeft _ = False

yMovement :: Direction -> Int
yMovement d
  | isRight d = 1
  | isLeft d = -1
  | otherwise = 0

currentPlayer gs = if gs ^. turnTracker then player1 else player2
otherPlayer gs = if gs ^. turnTracker then player2 else player1
yourTerritory gs = if gs ^. turnTracker then 1 else 4
enemyTerritory gs = if gs ^. turnTracker then 4 else 1