-
Notifications
You must be signed in to change notification settings - Fork 3
/
Bloxorz.hs
103 lines (72 loc) · 2.46 KB
/
Bloxorz.hs
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
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module ProgFun.Bloxorz where
import Prelude hiding (Left, Right)
import GraphClass
import BFS
type Pos = (Int, Int)
type Block = (Pos, Pos)
terrian :: Pos -> Bool
terrian (x,y) = inBounds (x,y)
bounds :: Pos
bounds = (4, 4)
showBlock :: Block -> String
showBlock (a,b) = concat $
[[ case () of
_ | (x, y) == a || (x, y) == b -> '#'
| terrian (x, y) -> 'o'
| otherwise -> ' '
| y <- [0..(fst bounds)]] ++ "\n"
| x <- [0..(snd bounds)]]
isStanding :: Block -> Bool
isStanding (a,b) = a == b
isHorizontal :: Block -> Bool
isHorizontal (a,b) = not (isStanding (a,b)) &&
fst a == fst b
isLegal :: Block -> Bool
isLegal (a,b) = terrian a && terrian b &&
inBounds a && inBounds b
inBounds :: Pos -> Bool
inBounds (x, y) = x >= 0 && y >= 0 &&
x <= bx && y <= by
where (bx, by) = bounds
data Dir = Left | Right | Up | Down
deriving (Show, Ord, Eq)
directions :: [Dir]
directions = [Left, Right, Up, Down]
type MoveMatrix = ((Int, Int), (Int, Int))
moveMatrix :: Dir -> Block -> MoveMatrix
moveMatrix Left blk
| isStanding blk = ((0,-2),(0,-1))
| isHorizontal blk = ((0,-1),(0,-2))
| otherwise = ((0,-1),(0,-1))
moveMatrix Right blk
| isStanding blk = ((0,1),(0,2))
| isHorizontal blk = ((0,2),(0,1))
| otherwise = ((0,1),(0,1))
moveMatrix Up blk
| isStanding blk = ((-2,0),(-1,0))
| isHorizontal blk = ((-1,0),(-1,0))
| otherwise = ((-1,0),(-2,0))
moveMatrix Down blk
| isStanding blk = ((1,0),(2,0))
| isHorizontal blk = ((1,0),(1,0))
| otherwise = ((2,0),(1,0))
moveBlockByMatrix :: MoveMatrix -> Block -> Block
moveBlockByMatrix ((dx1,dy1),(dx2,dy2)) ((x1,y1),(x2,y2)) =
((x1 + dx1, y1 + dy1), (x2 + dx2, y2 + dy2))
move :: Dir -> Block -> Block
move dir b = moveBlockByMatrix (moveMatrix dir b) b
possibleMoves :: Block -> [LEdge Block Dir]
possibleMoves b = filter (isLegal . target) $
map (\dir -> ((b, move dir b), dir)) directions
instance Node Block
-- instance BFSNode Block
data T = T
instance Graph T Block Dir where
edgesFor T = possibleMoves
l :: Maybe [Dir]
l = bfsSearch T beg end
where beg = ((0,0),(0,0)) :: Block
end = ((0,3),(0,3)) :: Block