51 lines
1.8 KiB
Text
51 lines
1.8 KiB
Text
open list core generic
|
|
|
|
type Field = Field a
|
|
type Color = White | Black
|
|
type Direction = Lft | Fwd | Rgt | Bwd
|
|
field s = Field [[White \\ _ <- [1..s]] \\ _ <- [1..s]]
|
|
|
|
isBlack Black = true
|
|
isBlack _ = false
|
|
|
|
newfield xc yc (Field xs) = Field (newfield' 0 xs)
|
|
where newfield' _ [] = []
|
|
newfield' n (x::xs)
|
|
| n == yc = row 0 x :: xs
|
|
| else = x :: newfield' (n+1) xs
|
|
where row _ [] = []
|
|
row n (x::xs)
|
|
| n == xc = toggle x :: xs
|
|
| else = x :: row (n+1) xs
|
|
where toggle White = Black
|
|
toggle Black = White
|
|
|
|
showPath (Field xs) = toString <| show' "" xs
|
|
where show' sb [] = sb +> ""
|
|
show' sb (x::xs) = show' (showRow sb x +> "\r\n") xs
|
|
where showRow sb [] = sb +> ""
|
|
showRow sb (x::xs) = showRow (sb +> s) xs
|
|
where s | isBlack x = "#"
|
|
| else = "_"
|
|
|
|
move s xc yc = move' (Fwd,xc,yc) (field s)
|
|
where move' (pos,xc,yc)@coor fld
|
|
| xc >= s || yc >= s || xc < 0 || yc < 0 = fld
|
|
| else = fld |> newfield xc yc |> move' (matrix (dir fld) coor)
|
|
where dir (Field xs)
|
|
| `isBlack` (xs:yc):xc = Lft
|
|
| else = Rgt
|
|
matrix Lft (pos,x,y) = go (left pos,x,y)
|
|
matrix Rgt (pos,x,y) = go (right pos,x,y)
|
|
go (Lft,x,y) = (Lft,x - 1,y)
|
|
go (Rgt,x,y) = (Rgt,x+1,y)
|
|
go (Fwd,x,y) = (Fwd,x,y - 1)
|
|
go (Bwd,x,y) = (Bwd,x,y+1)
|
|
right Lft = Fwd
|
|
right Fwd = Rgt
|
|
right Rgt = Bwd
|
|
right Bwd = Lft
|
|
left Lft = Bwd
|
|
left Bwd = Rgt
|
|
left Rgt = Fwd
|
|
left Fwd = Lft
|