glguy/parabox
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

epsilon working

Browse Source
This commit is contained in:
Eric Mertens 2022-12-04 15:59:22 -08:00
parent b77716c6bc
commit 50a01efc5f
3 changed files with 616 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

541
app/Main.hs
View File

@ -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
@ -800,3 +806,538 @@ 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)

75
app/Model.hs
View File

@ -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]

17
app/Rendering.hs
View File

@ -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)