Commit 5c2f830e authored by Peter Achten's avatar Peter Achten

fixed missing illegal moves in Trax

parent 032b64dc
Pipeline #26428 passed with stage
in 5 minutes and 50 seconds
......@@ -10,23 +10,26 @@ import Trax.UoD
:: RenderMode = ViewMode | PlayMode
updateTraxEditor :: Bool -> UpdateOption TraxSt TraxSt
updateTraxEditor turn = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updModel = flip const
})
updateTraxEditor turn = UpdateUsing id (const id) (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage PlayMode turn
, updModel = flip const
})
viewTraxEditor :: ViewOption TraxSt
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode False
, updModel = flip const
})
viewTraxEditor = ViewUsing id (fromSVGEditor
{ initView = id
, renderImage = \_ -> toImage ViewMode False
, updModel = flip const
})
whiteColor = toSVGColor "white"
redColor = toSVGColor "red"
freeTileColor = toSVGColor "lightgrey"
transparentColor = toSVGColor "none"
whiteColor = toSVGColor "white"
redColor = toSVGColor "red"
freeTileColor = toSVGColor "lightgrey"
transparentColor = toSVGColor "none"
font = normalFontDef "Arial" 14.0
tileSize = px 50.0
toImage :: RenderMode Bool TraxSt *TagSource -> Image TraxSt
toImage ViewMode _ st _
......@@ -34,65 +37,67 @@ toImage ViewMode _ st _
toImage PlayMode my_turn st=:{turn} _
= above (repeat AtMiddleX) [] Nothing [] [text font message, board it_is_my_turn tileSize st] NoHost
where
it_is_my_turn = my_turn == turn
message = if it_is_my_turn "Select a tile" "Wait for other player..."
it_is_my_turn = my_turn == turn
message = if it_is_my_turn "Select a tile" "Wait for other player..."
board :: Bool Span TraxSt -> Image TraxSt
board it_is_my_turn d st=:{trax}
| no_of_tiles trax == zero
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise = voidImage d
| otherwise = grid (Rows (maxy - miny + 3)) (RowMajor, LeftToRight, TopToBottom) (repeat (AtMiddleX,AtMiddleY)) [] [] []
[ case tile_at trax coord of
Nothing = if (it_is_my_turn && isMember coord free_coords) (freeImage d coord st) (voidImage d)
Just tile = tileImage d tile
\\ row <- [miny - 1 .. maxy + 1]
, col <- [minx - 1 .. maxx + 1]
, let coord = fromTuple (col,row)
] NoHost
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise = voidImage d
| otherwise = grid (Rows (maxy - miny + 3)) (RowMajor, LeftToRight, TopToBottom) (repeat (AtMiddleX,AtMiddleY)) [] [] []
[ case tile_at trax coord of
Nothing = if (it_is_my_turn && isMember coord free_coords) (freeImage d coord st) (voidImage d)
Just tile = tileImage d tile
\\ row <- [miny - 1 .. maxy + 1]
, col <- [minx - 1 .. maxx + 1]
, let coord = fromTuple (col,row)
] NoHost
where
((minx,maxx),(miny,maxy)) = bounds trax
(o_x, o_y) = (abs (min 0 (minx-1)), abs (min 0 (miny-1)))
free_coords = free_coordinates trax
((minx,maxx),(miny,maxy)) = bounds trax
(o_x, o_y) = (abs (min 0 (minx-1)), abs (min 0 (miny-1)))
free_coords = free_coordinates trax
voidImage :: Span -> Image a
voidImage d = empty d d
voidImage d = empty d d
illegalImage :: Span -> Image a
illegalImage d = tileShape d <@< {fill = transparentColor}
unselectedImage :: Span -> Image a
unselectedImage d = tileShape d <@< {fill = freeTileColor}
freeImage :: Span Coordinate TraxSt -> Image TraxSt
freeImage d coord {trax,choice}
| maybe True (\c -> coord <> c) choice
= unselected
| otherwise = above (repeat AtMiddleX) [] (Just d) []
[tileImage (d /. nr_of_candidates) tile <@< {onclick = settile coord tile, local = False} \\ tile <- candidates]
(Host unselected)
| isEmpty candidates = illegalImage d
| maybe True ((<>) coord) choice = unselectedImage d <@< {onclick = setcell coord, local = False}
| otherwise = above (repeat AtMiddleX) [] (Just d) []
[tileImage (d /. no_of_candidates) tile <@< {onclick = settile coord tile, local = False} \\ tile <- candidates]
(Host (unselectedImage d))
where
candidates = possible_tiles (linecolors trax coord)
nr_of_candidates = length candidates
unselected = tileShape d <@< {fill = freeTileColor} <@< {onclick = setcell coord, local = False}
candidates = [tile \\ tile <- possible_tiles trax coord | isJust (mandatory_moves (add_tile coord tile trax) coord)]
no_of_candidates = length candidates
tileImage :: Span TraxTile -> Image a
tileImage d tile = fromJust (lookup tile [ (horizontal,rotate (deg 0.0) horizontal_tile)
, (vertical, rotate (deg 90.0) horizontal_tile)
, (northwest, rotate (deg 0.0) northwest_tile)
, (northeast, rotate (deg 90.0 ) northwest_tile)
, (southeast, rotate (deg 180.0) northwest_tile)
, (southwest, rotate (deg 270.0) northwest_tile)
])
tileImage d tile = fromJust (lookup tile [ (horizontal,rotate (deg 0.0) horizontal_tile)
, (vertical, rotate (deg 90.0) horizontal_tile)
, (northwest, rotate (deg 0.0) northwest_tile)
, (northeast, rotate (deg 90.0 ) northwest_tile)
, (southeast, rotate (deg 180.0) northwest_tile)
, (southwest, rotate (deg 270.0) northwest_tile)
])
where
brick = Host (tileShape d <@< {stroke = whiteColor} <@< {strokewidth = d /. 20})
horizontal_tile = overlay (repeat (AtMiddleX,AtMiddleY)) [] [bar yline whiteColor, bar xline redColor] brick
northwest_tile = (overlay [] [(d /. 2, d /. 2),(d /. -2, d /. -2)]
[ arc whiteColor, arc redColor ]
brick
) <@< { MaskAttr | mask = tileShape d <@< {fill = whiteColor}}
bar line c = line d <@< {stroke = c} <@< {strokewidth = d /. 5}
arc c = circle d <@< {stroke = c} <@< {strokewidth = d /. 5} <@< {fill = transparentColor}
brick = Host (tileShape d <@< {stroke = whiteColor} <@< {strokewidth = d /. 20})
horizontal_tile = overlay (repeat (AtMiddleX,AtMiddleY)) [] [bar yline whiteColor, bar xline redColor] brick
northwest_tile = (overlay [] [(d /. 2, d /. 2),(d /. -2, d /. -2)]
[ arc whiteColor, arc redColor ]
brick
) <@< { MaskAttr | mask = tileShape d <@< {fill = whiteColor}}
bar line c = line d <@< {stroke = c} <@< {strokewidth = d /. 5}
arc c = circle d <@< {stroke = c} <@< {strokewidth = d /. 5} <@< {fill = transparentColor}
tileShape :: Span -> Image a
tileShape d = square d <@< {xradius = d /. 10} <@< {yradius = d /. 10}
font = normalFontDef "Arial" 14.0
tileSize = px 50.0
tileShape d = square d <@< {xradius = d /. 10} <@< {yradius = d /. 10}
......@@ -74,7 +74,6 @@ col :: !Coordinate -> Int
*/
row :: !Coordinate -> Int
:: Trax
derive gEditor Trax
derive gText Trax
......@@ -140,10 +139,10 @@ free_coordinates :: !Trax -> [Coordinate]
*/
linecolors :: !Trax !Coordinate -> LineColors
/** possible_tiles @colors = @trax:
returns those @trax that match with @colors.
/** possible_tiles @trax @coordinate = @tiles:
returns those @tiles that constitute a legal move in @trax at @coordinate.
*/
possible_tiles :: !LineColors -> [TraxTile]
possible_tiles :: !Trax !Coordinate -> [TraxTile]
:: Line
......@@ -171,13 +170,6 @@ loops :: !Trax -> [(LineColor,Line)]
*/
winning_lines :: !Trax -> [(LineColor,Line)]
/** mandatory_moves @trax @coordinate = @trax`:
assumes that the tile at @coordinate in @trax is the most recently placed tile.
It performs the mandatory moves that require filling empty places next to this
tile, and all subsequent other empty places, thus resulting in @trax`.
*/
mandatory_moves :: !Trax !Coordinate -> Trax
:: TraxSt
= { trax :: !Trax // the current set of placed tiles
, names :: ![User] // the current two players
......@@ -185,6 +177,16 @@ mandatory_moves :: !Trax !Coordinate -> Trax
, choice :: !Maybe Coordinate
}
/** mandatory_moves @trax @coordinate = Just @trax`:
assumes that the tile at @coordinate in @trax is the most recently placed tile.
It performs the mandatory moves that require filling empty places next to this
tile, and all subsequent other empty places, resulting in @trax`.
mandatory_moves @trax @coordinate = Nothing:
at least one mandatory move occurred that resulted in an illegal configuration:
an empty tile with three or four of the same line colors.
*/
mandatory_moves :: !Trax !Coordinate -> Maybe Trax
/** game_over @st:
returns True only if the given configuration in @st.trax contains one or more
lines that connect opposite board edges, or one or more closed loops.
......
......@@ -57,22 +57,22 @@ other_edge :: !TraxTile !TileEdge -> TileEdge
other_edge tile edge = if (edge == tile.end1) tile.end2 tile.end1
instance ~ TraxTile where ~ tile = lookup1 tile [(horizontal,vertical )
,(vertical, horizontal)
,(northwest, southeast )
,(northeast, southwest )
,(southwest, northeast )
,(southeast, northwest )
]
,(vertical, horizontal)
,(northwest, southeast )
,(northeast, southwest )
,(southwest, northeast )
,(southeast, northwest )
]
derive gFDomain TileEdge
derive gLexOrd TileEdge
instance == TileEdge where == e1 e2 = e1 === e2
instance < TileEdge where < e1 e2 = (e1 =?= e2) === LT
instance ~ TileEdge where ~ e = case e of
North = South
South = North
West = East
East = West
North = South
South = North
West = East
East = West
derive gFDomain LineColor
instance == LineColor where == c1 c2 = c1 === c2
......@@ -82,7 +82,7 @@ instance ~ LineColor where ~ RedLine = WhiteLine
derive gLexOrd Coordinate
instance == Coordinate where == c1 c2 = c1 === c2
instance < Coordinate where < c1 c2 = (c1 =?= c2) === LT
instance zero Coordinate where zero = {col=zero, row=zero}//(zero,zero)
instance zero Coordinate where zero = {col=zero, row=zero}
derive gPrint Coordinate
instance toString Coordinate where toString c = printToString c
......@@ -91,27 +91,21 @@ instance toTuple Int Int Coordinate where toTuple {col,row} = (col,row)
col :: !Coordinate -> Int
col coordinate = coordinate.col
//col (col,_) = col
row :: !Coordinate -> Int
row coordinate = coordinate.row
//row (_,row) = row
north :: !Coordinate -> Coordinate
north coordinate = {coordinate & row = coordinate.row-1}
//north (col,row) = (col, row-1)
south :: !Coordinate -> Coordinate
south coordinate = {coordinate & row = coordinate.row+1}
//south (col,row) = (col, row+1)
west :: !Coordinate -> Coordinate
west coordinate = {coordinate & col = coordinate.col-1}
//west (col,row) = (col-1, row)
east :: !Coordinate -> Coordinate
east coordinate = {coordinate & col = coordinate.col+1}
//east (col,row) = (col+1, row)
go :: !TileEdge -> Coordinate -> Coordinate
go North = north
......@@ -120,7 +114,7 @@ go South = south
go West = west
:: Trax // actually, Trax ought to be opaque
:: Trax
= { tiles :: ![(Coordinate,TraxTile)] // tiles that are placed on a certain location
}
derive gEditor Trax
......@@ -244,9 +238,12 @@ color_at_tile :: !TileEdge !TraxTile -> LineColor
color_at_tile edge tile
= fromJust (lookup1 edge (tilecolors tile))
possible_tiles :: !LineColors -> [TraxTile]
possible_tiles colors
= [tile \\ tile <- gFDomain{|*|} | linecolors_match colors (tilecolors tile)]
possible_tiles :: !Trax !Coordinate -> [TraxTile]
possible_tiles trax free
= matching_tiles
where
tile_pattern = linecolors trax free
matching_tiles = [tile \\ tile <- gFDomain{|*|} | linecolors_match tile_pattern (tilecolors tile)]
/** track @trax @color @edge @coordinate = @line:
computes the entire reachable @line, starting at @coordinate in @trax, and starting
......@@ -280,7 +277,6 @@ where
| otherwise = loops
where
line = track trax color (start_edge tile color) coordinate
// loops = color_loops (removeMembersBy (\(c,t) c` -> c == c`) tiles (cut_loop line)) color
loops = color_loops (deleteFirstsBy (\c` (c,t) -> c == c`) tiles (cut_loop line)) color
/** start_edge @tile @color = @edge:
......@@ -334,27 +330,56 @@ where
, (South,(maxy,miny,row))
]
/** mandatory_tiles @trax @coordinate = @candidates:
@candidates are those immediate, free, neighbours of the tile at @coordinate in @trax
at which two of the same line colors end.
:: MoveStatus // a move status is either:
= ForcedMove // a forced move (two identical edge colors)
| IllegalMove // an illegal move (more than two identical edge colors)
| UnforcedMove // an unforced move (less than two identical edge colors, for both line colors)
derive gEq MoveStatus
instance == MoveStatus where == s1 s2 = s1 === s2
/** tiles_status @trax @coordinate = @tiles:
@tiles are the immediate, free, neighbours of the tile at @coordinate in @trax
together with information about their MoveStatus.
*/
mandatory_tiles :: !Trax !Coordinate -> [Coordinate]
mandatory_tiles trax coordinate
tiles_status :: !Trax !Coordinate -> [(MoveStatus,Coordinate)]
tiles_status trax coordinate
= case tile_at trax coordinate of
Nothing = []
_ = [free \\ free <- free_neighbours trax coordinate
| hasDup (filter isJust (map snd (linecolors trax free)))
]
_ = [(move_status trax free,free) \\ free <- free_neighbours trax coordinate]
where
move_status :: !Trax !Coordinate -> MoveStatus
move_status trax free
| no_of_reds == 2 || no_of_whites == 2 = ForcedMove
| no_of_reds > 2 || no_of_whites > 2 = IllegalMove
| otherwise = UnforcedMove
where
edge_colors = [c \\ (_,Just c) <- linecolors trax free]
no_of_reds = length (filter ((==) RedLine) edge_colors)
no_of_whites = length (filter ((==) WhiteLine) edge_colors)
mandatory_moves :: !Trax !Coordinate -> Trax
mandatory_moves :: !Trax !Coordinate -> Maybe Trax
mandatory_moves trax coordinate
| isNothing (tile_at trax coordinate)
= abort ("Trax.UoD.mandatory_moves: a tile is expected at coordinate " <+ coordinate <+ "\n")
| otherwise
= qfoldl mandatory_tiles move trax (mandatory_tiles trax coordinate)
= qfoldl mandatory_tiles` move (Just trax) (tiles_status trax coordinate)
where
move :: !Trax !Coordinate -> Trax
move trax filler = add_tile filler (hd (possible_tiles (linecolors trax filler))) trax
move :: !(Maybe Trax) !(!MoveStatus,!Coordinate) -> Maybe Trax
move (Just trax) (ForcedMove,filler)
| isEmpty matches = Nothing
| otherwise = Just (add_tile filler (hd matches) trax)
where
matches = possible_tiles trax filler
move (Just trax) (UnforcedMove,_)
= Just trax
move _ _ = Nothing
mandatory_tiles` :: !(Maybe Trax) !(!MoveStatus,!Coordinate) -> [(MoveStatus,Coordinate)]
mandatory_tiles` (Just trax) (ForcedMove,coordinate) = tiles_status trax coordinate
mandatory_tiles` _ _ = []
derive gPrint Trax, TraxTile, TileEdge
instance toString Trax where toString trax = printToString trax
game_over :: !TraxSt -> Bool
game_over st=:{trax}
......@@ -372,4 +397,9 @@ setcell coord st
settile :: !Coordinate !TraxTile !TraxSt -> TraxSt
settile coord tile st=:{trax,turn}
= {st & trax = mandatory_moves (add_tile coord tile trax) coord, choice = Nothing, turn = not turn}
| isNothing trax`
= abort ("Trax.UoD.settile: adding this tile is an illegal move.\n")
| otherwise
= {st & trax = fromJust trax`, choice = Nothing, turn = not turn}
where
trax` = mandatory_moves (add_tile coord tile trax) coord
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment