-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathBoard.elm
179 lines (159 loc) · 7.26 KB
/
Board.elm
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
module Board where
import Dict
import List exposing (..)
import Maybe exposing (withDefault)
import Helpers exposing (..)
import GameTypes exposing (..)
import State
import Piece
import Player
type Direction = Vertical
| Horizontal
getBoardSize : Board -> Int
getBoardSize board =
if List.isEmpty <| Dict.toList board
then 5
else
let locations = Dict.keys board
xs = map fst locations
ys = map snd locations
maxX = max (maximumU xs) (abs <| minimumU xs)
maxY = max (maximumU ys) (abs <| minimumU ys)
distFromCenter = (max maxX maxY) + 2
in
(distFromCenter * 2) + 1
pieceAt : Location -> Board -> Piece
pieceAt loc board = withDefault NoPiece (Dict.get loc board)
findAbove : Location -> Board -> List Location
findAbove (x,y) board =
if Dict.member (x,y) board
then [(x,y)] ++ findAbove (x,y-1) board
else []
findBelow : Location -> Board -> List Location
findBelow (x,y) board =
if Dict.member (x,y) board
then [(x,y)] ++ findBelow (x,y+1) board
else []
findLeftward : Location -> Board -> List Location
findLeftward (x,y) board =
if Dict.member (x,y) board
then [(x,y)] ++ findLeftward (x-1,y) board
else []
findRightward : Location -> Board -> List Location
findRightward (x,y) board =
if Dict.member (x,y) board
then [(x,y)] ++ findRightward (x+1,y) board
else []
findColumn : Location -> Board -> List Location
findColumn (x,y) board = (findAbove (x,y-1) board) ++ (findBelow (x,y+1) board)
findRow : Location -> Board -> List Location
findRow (x,y) board = (findLeftward (x-1,y) board) ++ (findRightward (x+1,y) board)
isAdjacent : Location -> Location -> Bool
isAdjacent (x1, y1) (x2, y2) =
(y1 == y2 && abs (x1 - x2) == 1) || (x1 == x2 && abs (y1 - y2) == 1)
adjacentTiles : Location -> Board -> List Location
adjacentTiles (x, y) board =
filter (\loc -> isAdjacent loc (x, y)) (Dict.keys board)
isValidMove : Move -> Board -> Bool
isValidMove move board =
let isUnoccupied = not <| Dict.member move.location board
existingTile = Dict.get move.location board
canOverlapExistingTile = (move.piece == Kaarme || move.piece == SeppoIlmarinen)
&& not (existingTile == Just move.piece)
-- can't SeppoIlmarinen a SeppoIlmarinen, can't Kaarme a Kaarme
columnLength = length (findColumn move.location board) + 1
rowLength = length (findRow move.location board) + 1
longestLine = max columnLength rowLength
adjacents = adjacentTiles move.location board
hasAdjacentTile = not <| List.isEmpty adjacents
adjacentToKullervo = any (\loc -> pieceAt loc board == Kullervo) adjacents
in
(isUnoccupied || canOverlapExistingTile)
&& hasAdjacentTile
&& ((not adjacentToKullervo) || move.piece == Kullervo) -- only Kullervos can be placed next to other Kullervos
&& longestLine <= 7
scoreMove : Move -> Board -> Int
scoreMove move board =
let column = findColumn move.location board
columnSize = List.length column + 1
columnScores = map (\loc -> getTileValue loc Vertical move board) column
columnHighScore = if isEmpty column then 0 else maximumU columnScores
tileScoreInColumn = getTileValue move.location Vertical move board
columnPoints = if (tileScoreInColumn > columnHighScore && columnSize >= 2) then columnSize else 0
row = findRow move.location board
rowSize = List.length row + 1
rowScores = map (\loc -> getTileValue loc Horizontal move board) row
rowHighScore = if isEmpty row then 0 else maximumU rowScores
tileScoreInRow = getTileValue move.location Horizontal move board
rowPoints = if (tileScoreInRow > rowHighScore && rowSize >= 2) then rowSize else 0
in
columnPoints + rowPoints
getTileValue : Location -> Direction -> Move -> Board -> Int
getTileValue (x,y) dir move board =
let piece = pieceAt (x,y) board
adjacentToLemminkainen loc = any (\l -> pieceAt l board == Lemminkainen) <| adjacentTiles loc board
isCurrentTile = (move.location == (x,y)) -- is this the tile that was placed this turn?
in
if | piece == Joukahainen ->
let line = (case dir of Horizontal -> findRow
Vertical -> findColumn) (x,y) board ++ [(x,y)]
numJoukahainens = length <| filter (\loc -> not (adjacentToLemminkainen loc) &&
pieceAt loc board == Joukahainen &&
(not (loc == move.location) || isCurrentTile)) line
-- don't count Joukahainen placed this turn for other Joukahainens (this is so that Joukahainens can beat other Joukahainens)
in
4 * numJoukahainens
| piece == Louhi && isCurrentTile && hasSamePieceAtOtherEnd (x,y) board dir ->
100 -- i.e. instantly score line
| adjacentToLemminkainen (x,y) && not (piece == Lemminkainen) ->
0 -- Lemminkainen makes all tiles around him 0 (except other Lemminkainens)
| otherwise ->
Piece.baseValue piece
-- this is just used for determining piece images
-- TODO: remove overlap between this and getTileValue (but note that there are subtle differences!)
getDisplayedTileValue : Location -> Board -> String
getDisplayedTileValue (x,y) board =
let piece = pieceAt (x,y) board
adjacentToLemminkainen = any (\l -> pieceAt l board == Lemminkainen) <| adjacentTiles (x,y) board
in
if | adjacentToLemminkainen && not (piece == Lemminkainen) ->
"0"
| piece == Joukahainen ->
let row = findRow (x,y) board
column = findColumn (x,y) board
in
if any (\loc -> not (adjacentToLemminkainen) && pieceAt loc board == Joukahainen) (row ++ column)
then "4_star"
else "4"
| otherwise ->
toString <| Piece.baseValue piece
-- is this piece at one end of a line with the same kind of piece at the other end? (used by Louhi)
hasSamePieceAtOtherEnd : Location -> Board -> Direction -> Bool
hasSamePieceAtOtherEnd (x,y) board dir =
let last list = headU <| reverse list
samePieces pos1 pos2 = pieceAt pos1 board == pieceAt pos2 board
above = findAbove (x,y-1) board
below = findBelow (x,y+1) board
left = findLeftward (x-1,y) board
right = findRightward (x+1,y) board
samePieceBelow = isEmpty above && not (isEmpty below) && samePieces (last below) (x,y)
samePieceAbove = isEmpty below && not (isEmpty above) && samePieces (last above) (x,y)
samePieceLeft = isEmpty right && not (isEmpty left) && samePieces (last left) (x,y)
samePieceRight = isEmpty left && not (isEmpty right) && samePieces (last right) (x,y)
in
case dir of
Horizontal -> samePieceLeft || samePieceRight
Vertical -> samePieceBelow || samePieceAbove
isValidSquareToMove : State -> Location -> Int -> Bool
isValidSquareToMove state (x,y) size =
if State.isPlayerTurn state
then
case state.heldPiece of
Just idx ->
let hand = Player.getHand state.turn state
piece = Piece.fromString <| headU <| drop idx hand
location = (x - (size // 2), y - (size // 2))
in
isValidMove { piece = piece, idx = idx, location = location } state.board
Nothing -> False
else False