epsilon working
This commit is contained in:
parent
b77716c6bc
commit
50a01efc5f
555
app/Main.hs
555
app/Main.hs
@ -19,8 +19,8 @@ data Game = Game {
|
|||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
do args <- getArgs
|
do args <- getArgs
|
||||||
case args of
|
case args of
|
||||||
x:_ | Just w <- Map.lookup x worldList ->
|
x:_ | Just w <- Map.lookup x worldList ->
|
||||||
bracket (mkVty =<< userConfig) shutdown \vty ->
|
bracket (mkVty =<< userConfig) shutdown \vty ->
|
||||||
loop vty Game {
|
loop vty Game {
|
||||||
gameWorlds = pure w,
|
gameWorlds = pure w,
|
||||||
@ -28,13 +28,13 @@ main =
|
|||||||
}
|
}
|
||||||
_ ->
|
_ ->
|
||||||
do putStrLn "Usage: parabox <worldname>"
|
do putStrLn "Usage: parabox <worldname>"
|
||||||
putStrLn ""
|
putStrLn ""
|
||||||
putStrLn "Available worlds:"
|
putStrLn "Available worlds:"
|
||||||
mapM_ putStrLn (Map.keys worldList)
|
mapM_ putStrLn (Map.keys worldList)
|
||||||
|
|
||||||
loop :: Vty -> Game -> IO ()
|
loop :: Vty -> Game -> IO ()
|
||||||
loop vty game =
|
loop vty game =
|
||||||
do let world = NonEmpty.head (gameWorlds game)
|
do let world = NonEmpty.head (gameWorlds game)
|
||||||
update vty (render (gameFlat game) (NonEmpty.head (gameWorlds game)))
|
update vty (render (gameFlat game) (NonEmpty.head (gameWorlds game)))
|
||||||
ev <- nextEvent vty
|
ev <- nextEvent vty
|
||||||
case ev of
|
case ev of
|
||||||
@ -67,6 +67,12 @@ worldList = Map.fromList
|
|||||||
, ("player10", player10)
|
, ("player10", player10)
|
||||||
, ("player11", player11)
|
, ("player11", player11)
|
||||||
, ("player18", player18)
|
, ("player18", player18)
|
||||||
|
, ("infiniteExit5", infiniteExit5)
|
||||||
|
, ("infiniteExit15", infiniteExit15)
|
||||||
|
, ("infiniteEnter17", infiniteEnter17)
|
||||||
|
, ("infiniteEnter19", infiniteEnter19)
|
||||||
|
, ("infiniteEnter20", infiniteEnter20)
|
||||||
|
, ("multiInfinite8", multiInfinite8)
|
||||||
]
|
]
|
||||||
|
|
||||||
smallWorld :: World
|
smallWorld :: World
|
||||||
@ -491,7 +497,7 @@ world0 = World {
|
|||||||
('y', Box {
|
('y', Box {
|
||||||
boxColor = withForeColor defAttr magenta,
|
boxColor = withForeColor defAttr magenta,
|
||||||
boxLocation = Location '1' 0 (-2),
|
boxLocation = Location '1' 0 (-2),
|
||||||
boxType = Original $ makeWalls [
|
boxType = Original $ makeWalls [
|
||||||
"▓▓ ▓ ",
|
"▓▓ ▓ ",
|
||||||
" ",
|
" ",
|
||||||
"▓▓ ▓▓▓ ",
|
"▓▓ ▓▓▓ ",
|
||||||
@ -799,4 +805,539 @@ player18 =
|
|||||||
])
|
])
|
||||||
'u'
|
'u'
|
||||||
(Set.singleton (Location 'u' (-1) 2))
|
(Set.singleton (Location 'u' (-1) 2))
|
||||||
(Location 'u' 1 (-2))
|
(Location 'u' 1 (-2))
|
||||||
|
|
||||||
|
|
||||||
|
infiniteExit5 :: World
|
||||||
|
infiniteExit5 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('a',
|
||||||
|
Box (Location 'a' 3 (-1))
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓ ",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr yellow)
|
||||||
|
False),
|
||||||
|
('∞',
|
||||||
|
Box
|
||||||
|
(Location 'a' (-2) (-3))
|
||||||
|
(Infinity 'a')
|
||||||
|
(withForeColor defAttr yellow)
|
||||||
|
True),
|
||||||
|
('p',
|
||||||
|
Box
|
||||||
|
(Location 'a' 0 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr magenta)
|
||||||
|
True)
|
||||||
|
])
|
||||||
|
'p'
|
||||||
|
(Set.singleton (Location 'a' 0 1))
|
||||||
|
(Location 'a' (-1) 1)
|
||||||
|
|
||||||
|
|
||||||
|
infiniteExit15 :: World
|
||||||
|
infiniteExit15 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('A', -- extra frame to accomodate the larger level
|
||||||
|
Box (Location 'F' 3 3)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓ ▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr cyan)
|
||||||
|
True),
|
||||||
|
('a',
|
||||||
|
Box
|
||||||
|
(Location 'A' 0 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓ ▓▓▓▓▓",
|
||||||
|
" ▓▓▓▓",
|
||||||
|
" ▓▓ ",
|
||||||
|
" ▓ ▓",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓▓▓▓",
|
||||||
|
" ▓▓▓▓",
|
||||||
|
" ▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr cyan)
|
||||||
|
False),
|
||||||
|
('b',
|
||||||
|
Box
|
||||||
|
(Location 'a' 1 (-2))
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr magenta)
|
||||||
|
True),
|
||||||
|
('g',
|
||||||
|
Box
|
||||||
|
(Location 'a' 0 (-1))
|
||||||
|
(Original (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('G',
|
||||||
|
Box
|
||||||
|
(Location 'a' (-4) (-1))
|
||||||
|
(Link 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
True),
|
||||||
|
('Γ',
|
||||||
|
Box
|
||||||
|
(Location 'a' 2 (-1))
|
||||||
|
(Infinity 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('p',
|
||||||
|
Box
|
||||||
|
(Location 'a' 0 (-3))
|
||||||
|
(Original (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
False),
|
||||||
|
('P',
|
||||||
|
Box
|
||||||
|
(Location 'a' (-2) (-3))
|
||||||
|
(Link 'p')
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
True),
|
||||||
|
('Π',
|
||||||
|
Box
|
||||||
|
(Location 'a' 2 (-3))
|
||||||
|
(Infinity 'p')
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
False)
|
||||||
|
])
|
||||||
|
'b'
|
||||||
|
(Set.fromList [Location 'a' 0 2, Location 'a' (-1) 2, Location 'a' (-1) 3, Location 'a' (-2) 3])
|
||||||
|
(Location 'a' (-2) 4)
|
||||||
|
|
||||||
|
|
||||||
|
infiniteEnter17 :: World
|
||||||
|
infiniteEnter17 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('g',
|
||||||
|
Box (Location 'g' 2 (-2))
|
||||||
|
(Original (makeWalls [
|
||||||
|
" ▓▓",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓ ▓",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('∞',
|
||||||
|
Box
|
||||||
|
(Location 'g' 0 3)
|
||||||
|
(Infinity 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('G',
|
||||||
|
Box
|
||||||
|
(Location 'g' 1 2)
|
||||||
|
(Link 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
True),
|
||||||
|
('ε',
|
||||||
|
Box
|
||||||
|
(Location 'g' 3 0)
|
||||||
|
(Epsilon 'g' (makeWalls [
|
||||||
|
"▓▓▓▓▓▓ ▓▓",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('1',
|
||||||
|
Box
|
||||||
|
(Location 'ε' 0 0)
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('p',
|
||||||
|
Box
|
||||||
|
(Location 'g' 0 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr magenta)
|
||||||
|
True)
|
||||||
|
])
|
||||||
|
'p'
|
||||||
|
(Set.fromList [Location 'g' (-2) (-1), Location 'g' (-2) (-2)])
|
||||||
|
(Location 'g' (-2) 0)
|
||||||
|
|
||||||
|
|
||||||
|
infiniteEnter19 :: World
|
||||||
|
infiniteEnter19 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('w',
|
||||||
|
Box (Location 'w' 3 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓",
|
||||||
|
"▓▓ ▓▓",
|
||||||
|
"▓▓ ▓▓",
|
||||||
|
"▓ ▓ ▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓▓▓▓▓ ▓",
|
||||||
|
"▓ ▓▓ ▓▓ ▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr white)
|
||||||
|
False),
|
||||||
|
('g',
|
||||||
|
Box (Location 'w' (-3) (-1))
|
||||||
|
(Original (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ▓ ",
|
||||||
|
" "
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('∞',
|
||||||
|
Box
|
||||||
|
(Location 'w' 2 (-3))
|
||||||
|
(Infinity 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('G',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-3) 1)
|
||||||
|
(Link 'g')
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
True),
|
||||||
|
('ε',
|
||||||
|
Box
|
||||||
|
(Location 'w' 2 3)
|
||||||
|
(Epsilon 'g' (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr green)
|
||||||
|
False),
|
||||||
|
('p',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-1) 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr magenta)
|
||||||
|
True)
|
||||||
|
])
|
||||||
|
'p'
|
||||||
|
(Set.fromList [Location 'w' 0 (-3), Location 'w' 0 (3)])
|
||||||
|
(Location 'w' 0 0)
|
||||||
|
|
||||||
|
infiniteEnter20 :: World
|
||||||
|
infiniteEnter20 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('_', Box
|
||||||
|
(Location '_' 0 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"]))
|
||||||
|
(withForeColor defAttr white)
|
||||||
|
True),
|
||||||
|
('w',
|
||||||
|
Box (Location '_' 0 2)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓ ▓▓ ▓",
|
||||||
|
"▓ ▓▓ ▓",
|
||||||
|
"▓ ▓▓▓▓",
|
||||||
|
"▓ ▓ ▓",
|
||||||
|
"▓▓ ▓▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓▓ ▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr white)
|
||||||
|
False),
|
||||||
|
('r',
|
||||||
|
Box (Location 'w' 2 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ▓▓▓ ",
|
||||||
|
" ▓▓▓ ",
|
||||||
|
" ▓▓▓ ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
False),
|
||||||
|
('a',
|
||||||
|
Box
|
||||||
|
(Location 'w' 1 3)
|
||||||
|
(Link 'r')
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
True),
|
||||||
|
('b',
|
||||||
|
Box
|
||||||
|
(Location 'w' 2 3)
|
||||||
|
(Link 'r')
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
True),
|
||||||
|
('ε',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-2) 3)
|
||||||
|
(Epsilon 'r' (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr red)
|
||||||
|
False),
|
||||||
|
('1',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-3) (-3))
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('2',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-3) (-1))
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('3',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-1) (-3))
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('4',
|
||||||
|
Box
|
||||||
|
(Location 'w' (-1) 0)
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('5',
|
||||||
|
Box
|
||||||
|
(Location 'w' 2 (-3))
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True)
|
||||||
|
])
|
||||||
|
'r'
|
||||||
|
Set.empty
|
||||||
|
(Location 'w' (-3) 3)
|
||||||
|
|
||||||
|
|
||||||
|
multiInfinite8 :: World
|
||||||
|
multiInfinite8 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('b', Box
|
||||||
|
(Location 'b' 3 1)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓ ▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"]))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
False),
|
||||||
|
('p',
|
||||||
|
Box
|
||||||
|
(Location 'b' (-1) 0)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr magenta)
|
||||||
|
True),
|
||||||
|
('A',
|
||||||
|
Box (Location 'b' (-1) 2)
|
||||||
|
(Link 'b')
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('1',
|
||||||
|
Box
|
||||||
|
(Location 'b' (-1) (-3))
|
||||||
|
(Epsilon 'b' (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ▓ ",
|
||||||
|
" ",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓ ",
|
||||||
|
" ▓▓",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
False),
|
||||||
|
('2',
|
||||||
|
Box
|
||||||
|
(Location 'b' 1 (-3))
|
||||||
|
(Epsilon '1' (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ▓ ",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓ ",
|
||||||
|
" ▓▓",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
False),
|
||||||
|
('3',
|
||||||
|
Box
|
||||||
|
(Location 'b' 3 (-3))
|
||||||
|
(Epsilon '2' (makeWalls [
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" ▓▓",
|
||||||
|
" ▓ ",
|
||||||
|
" ▓▓",
|
||||||
|
" ",
|
||||||
|
" ",
|
||||||
|
" "]))
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
False),
|
||||||
|
('x',
|
||||||
|
Box
|
||||||
|
(Location '2' 4 1)
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr yellow)
|
||||||
|
True),
|
||||||
|
('B',
|
||||||
|
Box
|
||||||
|
(Location '1' 0 0)
|
||||||
|
(Link 'b')
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True),
|
||||||
|
('C',
|
||||||
|
Box
|
||||||
|
(Location '2' 4 (-1))
|
||||||
|
(Link 'b')
|
||||||
|
(withForeColor defAttr blue)
|
||||||
|
True)
|
||||||
|
])
|
||||||
|
'p'
|
||||||
|
Set.empty
|
||||||
|
(Location '3' 0 0)
|
||||||
77
app/Model.hs
77
app/Model.hs
@ -24,13 +24,17 @@ boxWalls world box =
|
|||||||
case boxType box of
|
case boxType box of
|
||||||
Original walls -> walls
|
Original walls -> walls
|
||||||
Link c -> boxWalls world (worldBoxes world Map.! c)
|
Link c -> boxWalls world (worldBoxes world Map.! c)
|
||||||
|
Infinity c -> boxWalls world (worldBoxes world Map.! c)
|
||||||
|
Epsilon _ walls -> walls
|
||||||
|
|
||||||
data BoxType
|
data BoxType
|
||||||
= Original (Array Coord Bool)
|
= Original (Array Coord Bool)
|
||||||
| Link Char
|
| Link Char
|
||||||
|
| Infinity Char
|
||||||
|
| Epsilon Char (Array Coord Bool)
|
||||||
deriving (Show, Read, Eq)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
data Location = Location Char Int Int
|
data Location = Location { locName :: Char, locY :: Int, locX :: Int }
|
||||||
deriving (Read, Show, Ord, Eq)
|
deriving (Read, Show, Ord, Eq)
|
||||||
|
|
||||||
data World = World {
|
data World = World {
|
||||||
@ -115,7 +119,7 @@ moveBlock world visited loc dir offset =
|
|||||||
do (loc', offset') <- nextLoc world dir loc offset
|
do (loc', offset') <- nextLoc world dir loc offset
|
||||||
--traceM (show "Next loc " ++ show loc' ++ " offset " ++ show offset')
|
--traceM (show "Next loc " ++ show loc' ++ " offset " ++ show offset')
|
||||||
guard (not (isWall world loc'))
|
guard (not (isWall world loc'))
|
||||||
moveBlock' world visited loc loc' dir name box offset'
|
moveBlock' world visited loc loc' dir name box Set.empty offset'
|
||||||
|
|
||||||
moveBlock' ::
|
moveBlock' ::
|
||||||
World ->
|
World ->
|
||||||
@ -125,9 +129,10 @@ moveBlock' ::
|
|||||||
Movement ->
|
Movement ->
|
||||||
Char ->
|
Char ->
|
||||||
Box ->
|
Box ->
|
||||||
|
Set Location ->
|
||||||
Rational {- ^ offset -} ->
|
Rational {- ^ offset -} ->
|
||||||
Maybe (Map Location Location)
|
Maybe (Map Location Location)
|
||||||
moveBlock' world visited loc loc' dir name box offset =
|
moveBlock' world visited loc loc' dir name box enters offset =
|
||||||
msum [moveTo, moveInto, moveToEat]
|
msum [moveTo, moveInto, moveToEat]
|
||||||
where
|
where
|
||||||
moveTo =
|
moveTo =
|
||||||
@ -135,32 +140,43 @@ moveBlock' world visited loc loc' dir name box offset =
|
|||||||
|
|
||||||
moveInto =
|
moveInto =
|
||||||
do (n,b) <- boxAt world loc'
|
do (n,b) <- boxAt world loc'
|
||||||
let (locI, offset') = enterLoc world n b dir offset
|
(locI, offset') <- enterLoc world n b dir offset
|
||||||
moveBlock' world visited loc locI dir name box offset' -- beware epsilon!
|
if Set.member locI enters then do
|
||||||
|
epsilon <- findEpsilon world (locName loc')
|
||||||
|
let eBox = worldBoxes world Map.! epsilon
|
||||||
|
(locI, offset') <- enterLoc world epsilon eBox dir offset
|
||||||
|
moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset'
|
||||||
|
else
|
||||||
|
moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset'
|
||||||
|
|
||||||
moveToEat =
|
moveToEat =
|
||||||
do let dir' = invert dir
|
do let dir' = invert dir
|
||||||
let (locE, _) = enterLoc world name box dir' 0
|
(locE, _) <- enterLoc world name box dir' 0
|
||||||
(name', box') <- boxAt world loc'
|
(name', box') <- boxAt world loc'
|
||||||
moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' 0
|
moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' Set.empty 0
|
||||||
|
|
||||||
enterLoc :: World -> Char -> Box -> Movement -> Rational -> (Location, Rational)
|
enterLoc :: World -> Char -> Box -> Movement -> Rational -> Maybe (Location, Rational)
|
||||||
enterLoc world name box dir@(dy,dx) offset =
|
enterLoc world name box dir@(dy,dx) offset =
|
||||||
case dir of
|
do name' <-
|
||||||
(-1, 0) -> go yhi (midpoint xlo xhi offset)
|
case boxType box of
|
||||||
( 1, 0) -> go ylo (midpoint xlo xhi offset)
|
Link c -> Just c
|
||||||
( 0,-1) -> go (midpoint ylo yhi offset) xhi
|
Original{} -> Just name
|
||||||
( 0, 1) -> go (midpoint ylo yhi offset) xlo
|
Infinity{} -> Nothing
|
||||||
_ -> error "enterLoc: bad direction"
|
Epsilon {} -> Just name
|
||||||
where
|
|
||||||
name' = case boxType box of
|
|
||||||
Link c -> c
|
|
||||||
Original{} -> name
|
|
||||||
((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
|
|
||||||
go y x = (Location name' y x,
|
|
||||||
fromIntegral(boxSize world box) * offset
|
|
||||||
- fromIntegral ((abs dy *x + abs dx*y)))
|
|
||||||
|
|
||||||
|
let go y x = Just
|
||||||
|
(Location name' y x,
|
||||||
|
fromIntegral(boxSize world box) * offset
|
||||||
|
- fromIntegral ((abs dy *x + abs dx*y)))
|
||||||
|
|
||||||
|
((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
|
||||||
|
|
||||||
|
case dir of
|
||||||
|
(-1, 0) -> go yhi (midpoint xlo xhi offset)
|
||||||
|
( 1, 0) -> go ylo (midpoint xlo xhi offset)
|
||||||
|
( 0,-1) -> go (midpoint ylo yhi offset) xhi
|
||||||
|
( 0, 1) -> go (midpoint ylo yhi offset) xlo
|
||||||
|
_ -> error "enterLoc: bad direction"
|
||||||
|
|
||||||
boxAt :: World -> Location -> Maybe (Char, Box)
|
boxAt :: World -> Location -> Maybe (Char, Box)
|
||||||
boxAt world loc =
|
boxAt world loc =
|
||||||
@ -195,5 +211,18 @@ nextLoc world (dy, dx) = go Set.empty
|
|||||||
$ (offset + fromIntegral (abs dy*x+abs dx*y))
|
$ (offset + fromIntegral (abs dy*x+abs dx*y))
|
||||||
/ fromIntegral (boxSize world box)
|
/ fromIntegral (boxSize world box)
|
||||||
|
|
||||||
|
go visited (Location b y x) offset
|
||||||
|
| Set.member b visited
|
||||||
|
, Just b' <- findInfinity world b
|
||||||
|
= go visited (Location b' y x) offset
|
||||||
|
|
||||||
go _ _ _ = Nothing
|
go _ _ _ = Nothing
|
||||||
|
|
||||||
|
findInfinity :: World -> Char -> Maybe Char
|
||||||
|
findInfinity world b =
|
||||||
|
listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world), Infinity i <- [boxType box], i == b]
|
||||||
|
|
||||||
|
|
||||||
|
findEpsilon :: World -> Char -> Maybe Char
|
||||||
|
findEpsilon world b =
|
||||||
|
listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world), Epsilon i _ <- [boxType box], i == b]
|
||||||
@ -49,17 +49,27 @@ renderCell world locMap name box y x scale =
|
|||||||
Nothing
|
Nothing
|
||||||
| Set.member loc (worldButtons world) -> button (boxColor box) scale
|
| Set.member loc (worldButtons world) -> button (boxColor box) scale
|
||||||
| loc == worldHome world -> home (boxColor box) scale
|
| loc == worldHome world -> home (boxColor box) scale
|
||||||
| otherwise -> unit (boxColor box) scale '░'
|
| otherwise -> unit (boxColor box) scale floorChar
|
||||||
where
|
where
|
||||||
loc = Location name' y x
|
loc = Location name' y x
|
||||||
name' =
|
name' =
|
||||||
case boxType box of
|
case boxType box of
|
||||||
Original{} -> name
|
Original{} -> name
|
||||||
Link c -> c
|
Link c -> c
|
||||||
|
Infinity c -> c
|
||||||
|
Epsilon{} -> name
|
||||||
wallChar =
|
wallChar =
|
||||||
case boxType box of
|
case boxType box of
|
||||||
Original{} -> '▓'
|
Original{} -> '▓'
|
||||||
Link{} -> '▒'
|
Link{} -> '▒'
|
||||||
|
Infinity {} -> '▓'
|
||||||
|
Epsilon {} -> '▓'
|
||||||
|
floorChar =
|
||||||
|
case boxType box of
|
||||||
|
Original{} -> '░'
|
||||||
|
Link{} -> '·'
|
||||||
|
Infinity {} -> '∞'
|
||||||
|
Epsilon {} -> 'ε'
|
||||||
|
|
||||||
renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image
|
renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image
|
||||||
renderBox world locMap box name scale =
|
renderBox world locMap box name scale =
|
||||||
@ -137,7 +147,10 @@ drawNestedWorld locMap world =
|
|||||||
stackedLoc :: World -> Map Location Char -> Location -> Maybe Location
|
stackedLoc :: World -> Map Location Char -> Location -> Maybe Location
|
||||||
stackedLoc world locMap = go Set.empty
|
stackedLoc world locMap = go Set.empty
|
||||||
where
|
where
|
||||||
go visited loc | Set.member loc visited = Nothing
|
go visited loc@(Location b y x)
|
||||||
|
| Set.member loc visited =
|
||||||
|
do b' <- findInfinity world b
|
||||||
|
go visited (Location b' y x)
|
||||||
|
|
||||||
go visited loc@(Location b y x) =
|
go visited loc@(Location b y x) =
|
||||||
do box <- Map.lookup b (worldBoxes world)
|
do box <- Map.lookup b (worldBoxes world)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user