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 =
|
||||
do args <- getArgs
|
||||
case args of
|
||||
x:_ | Just w <- Map.lookup x worldList ->
|
||||
case args of
|
||||
x:_ | Just w <- Map.lookup x worldList ->
|
||||
bracket (mkVty =<< userConfig) shutdown \vty ->
|
||||
loop vty Game {
|
||||
gameWorlds = pure w,
|
||||
|
|
@ -28,13 +28,13 @@ main =
|
|||
}
|
||||
_ ->
|
||||
do putStrLn "Usage: parabox <worldname>"
|
||||
putStrLn ""
|
||||
putStrLn "Available worlds:"
|
||||
putStrLn ""
|
||||
putStrLn "Available worlds:"
|
||||
mapM_ putStrLn (Map.keys worldList)
|
||||
|
||||
loop :: Vty -> Game -> IO ()
|
||||
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)))
|
||||
ev <- nextEvent vty
|
||||
case ev of
|
||||
|
|
@ -67,6 +67,12 @@ worldList = Map.fromList
|
|||
, ("player10", player10)
|
||||
, ("player11", player11)
|
||||
, ("player18", player18)
|
||||
, ("infiniteExit5", infiniteExit5)
|
||||
, ("infiniteExit15", infiniteExit15)
|
||||
, ("infiniteEnter17", infiniteEnter17)
|
||||
, ("infiniteEnter19", infiniteEnter19)
|
||||
, ("infiniteEnter20", infiniteEnter20)
|
||||
, ("multiInfinite8", multiInfinite8)
|
||||
]
|
||||
|
||||
smallWorld :: World
|
||||
|
|
@ -491,7 +497,7 @@ world0 = World {
|
|||
('y', Box {
|
||||
boxColor = withForeColor defAttr magenta,
|
||||
boxLocation = Location '1' 0 (-2),
|
||||
boxType = Original $ makeWalls [
|
||||
boxType = Original $ makeWalls [
|
||||
"▓▓ ▓ ",
|
||||
" ",
|
||||
"▓▓ ▓▓▓ ",
|
||||
|
|
@ -799,4 +805,539 @@ player18 =
|
|||
])
|
||||
'u'
|
||||
(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
|
||||
Original walls -> walls
|
||||
Link c -> boxWalls world (worldBoxes world Map.! c)
|
||||
Infinity c -> boxWalls world (worldBoxes world Map.! c)
|
||||
Epsilon _ walls -> walls
|
||||
|
||||
data BoxType
|
||||
= Original (Array Coord Bool)
|
||||
| Link Char
|
||||
| Link Char
|
||||
| Infinity Char
|
||||
| Epsilon Char (Array Coord Bool)
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
data Location = Location Char Int Int
|
||||
data Location = Location { locName :: Char, locY :: Int, locX :: Int }
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
data World = World {
|
||||
|
|
@ -115,7 +119,7 @@ moveBlock world visited loc dir offset =
|
|||
do (loc', offset') <- nextLoc world dir loc offset
|
||||
--traceM (show "Next loc " ++ show loc' ++ " offset " ++ show offset')
|
||||
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' ::
|
||||
World ->
|
||||
|
|
@ -125,9 +129,10 @@ moveBlock' ::
|
|||
Movement ->
|
||||
Char ->
|
||||
Box ->
|
||||
Set Location ->
|
||||
Rational {- ^ offset -} ->
|
||||
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]
|
||||
where
|
||||
moveTo =
|
||||
|
|
@ -135,32 +140,43 @@ moveBlock' world visited loc loc' dir name box offset =
|
|||
|
||||
moveInto =
|
||||
do (n,b) <- boxAt world loc'
|
||||
let (locI, offset') = enterLoc world n b dir offset
|
||||
moveBlock' world visited loc locI dir name box offset' -- beware epsilon!
|
||||
|
||||
(locI, offset') <- enterLoc world n b dir offset
|
||||
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 =
|
||||
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'
|
||||
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 =
|
||||
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"
|
||||
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)))
|
||||
do name' <-
|
||||
case boxType box of
|
||||
Link c -> Just c
|
||||
Original{} -> Just name
|
||||
Infinity{} -> Nothing
|
||||
Epsilon {} -> Just name
|
||||
|
||||
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 loc =
|
||||
|
|
@ -195,5 +211,18 @@ nextLoc world (dy, dx) = go Set.empty
|
|||
$ (offset + fromIntegral (abs dy*x+abs dx*y))
|
||||
/ 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
|
||||
|
||||
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
|
||||
| Set.member loc (worldButtons world) -> button (boxColor box) scale
|
||||
| loc == worldHome world -> home (boxColor box) scale
|
||||
| otherwise -> unit (boxColor box) scale '░'
|
||||
| otherwise -> unit (boxColor box) scale floorChar
|
||||
where
|
||||
loc = Location name' y x
|
||||
name' =
|
||||
case boxType box of
|
||||
Original{} -> name
|
||||
Link c -> c
|
||||
Infinity c -> c
|
||||
Epsilon{} -> name
|
||||
wallChar =
|
||||
case boxType box of
|
||||
Original{} -> '▓'
|
||||
Link{} -> '▒'
|
||||
Infinity {} -> '▓'
|
||||
Epsilon {} -> '▓'
|
||||
floorChar =
|
||||
case boxType box of
|
||||
Original{} -> '░'
|
||||
Link{} -> '·'
|
||||
Infinity {} -> '∞'
|
||||
Epsilon {} -> 'ε'
|
||||
|
||||
renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image
|
||||
renderBox world locMap box name scale =
|
||||
|
|
@ -137,7 +147,10 @@ drawNestedWorld locMap world =
|
|||
stackedLoc :: World -> Map Location Char -> Location -> Maybe Location
|
||||
stackedLoc world locMap = go Set.empty
|
||||
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) =
|
||||
do box <- Map.lookup b (worldBoxes world)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user