optional flat view
This commit is contained in:
parent
b0f14846d9
commit
100087d1fb
384
app/Main.hs
384
app/Main.hs
@ -11,150 +11,10 @@ import System.Environment ( getArgs )
|
|||||||
import Model
|
import Model
|
||||||
import Rendering ( render )
|
import Rendering ( render )
|
||||||
|
|
||||||
world0 :: World
|
data Game = Game {
|
||||||
world0 = World {
|
gameWorlds :: NonEmpty World,
|
||||||
worldButtons = Set.empty,
|
gameFlat :: Bool
|
||||||
worldHome = Location '2' 0 0,
|
}
|
||||||
worldMe = 'b',
|
|
||||||
worldBoxes = Map.fromList
|
|
||||||
[('1', Box {
|
|
||||||
boxColor = withForeColor defAttr green,
|
|
||||||
boxLocation = Location '1' (-1) 0,
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓▓ ▓▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
" ▓",
|
|
||||||
"▓ ▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓▓▓▓▓ ▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('2', Box {
|
|
||||||
boxColor = withForeColor defAttr cyan,
|
|
||||||
boxLocation = Location '1' 1 1,
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓ ▓▓ ▓▓ ▓",
|
|
||||||
" ",
|
|
||||||
" ▓",
|
|
||||||
" ▓",
|
|
||||||
" ",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
" ",
|
|
||||||
"▓ ▓▓ ▓▓ ▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('₂', Box {
|
|
||||||
boxColor = withForeColor defAttr cyan,
|
|
||||||
boxLocation = Location '1' 2 (-1),
|
|
||||||
boxType = Link '2'
|
|
||||||
}),
|
|
||||||
('3', Box {
|
|
||||||
boxColor = withForeColor defAttr blue,
|
|
||||||
boxLocation = Location '2' 1 1,
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓▓▓▓▓▓▓▓▓",
|
|
||||||
" ",
|
|
||||||
"▓▓▓▓▓▓▓▓ ",
|
|
||||||
"▓▓ ▓▓▓ ",
|
|
||||||
"▓▓ ▓▓▓ ",
|
|
||||||
"▓▓▓▓ ▓▓▓ ",
|
|
||||||
"▓▓ ▓▓▓▓",
|
|
||||||
"▓▓ ▓▓▓▓",
|
|
||||||
"▓▓▓▓ ▓▓▓▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('4', Box {
|
|
||||||
boxColor = withForeColor defAttr black,
|
|
||||||
boxLocation = Location 'b' (-3) 0,
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓▓▓ ▓▓▓",
|
|
||||||
"▓ ▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓▓▓▓ ▓▓▓▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('b', Box {
|
|
||||||
boxColor = withForeColor defAttr red,
|
|
||||||
boxLocation = Location '1' 0 1,
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓▓▓▓▓▓▓▓▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓ ▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓ ▓",
|
|
||||||
"▓▓▓▓▓▓▓▓▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('x', Box {
|
|
||||||
boxColor = withForeColor defAttr yellow,
|
|
||||||
boxLocation = Location '1' 0 (-1),
|
|
||||||
boxType = Original $
|
|
||||||
makeWalls [
|
|
||||||
"▓▓ ▓ ",
|
|
||||||
" ",
|
|
||||||
" ▓ ▓▓▓ ",
|
|
||||||
" ▓ ",
|
|
||||||
"▓ ▓▓▓▓",
|
|
||||||
" ▓▓▓ ",
|
|
||||||
" ▓ ▓▓▓ ",
|
|
||||||
" ",
|
|
||||||
"▓ ▓ ▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('y', Box {
|
|
||||||
boxColor = withForeColor defAttr magenta,
|
|
||||||
boxLocation = Location '1' 0 (-2),
|
|
||||||
boxType = Original $ makeWalls [
|
|
||||||
"▓▓ ▓ ",
|
|
||||||
" ",
|
|
||||||
"▓▓ ▓▓▓ ",
|
|
||||||
"▓▓ ",
|
|
||||||
" ▓▓▓▓",
|
|
||||||
"▓▓▓▓ ",
|
|
||||||
"▓▓ ▓▓▓ ",
|
|
||||||
" ",
|
|
||||||
"▓ ▓ ▓"
|
|
||||||
]
|
|
||||||
}),
|
|
||||||
('i', Box {
|
|
||||||
boxColor = withForeColor defAttr black,
|
|
||||||
boxLocation = Location 'b' 0 (-2),
|
|
||||||
boxType = Original $ solid 9
|
|
||||||
}),
|
|
||||||
('j', Box {
|
|
||||||
boxColor = withForeColor defAttr black,
|
|
||||||
boxLocation = Location 'b' 0 (-1),
|
|
||||||
boxType = Original $ solid 9
|
|
||||||
}),
|
|
||||||
('k', Box {
|
|
||||||
boxColor = withForeColor defAttr black,
|
|
||||||
boxLocation = Location 'b' 0 0,
|
|
||||||
boxType = Original $ solid 9
|
|
||||||
}),
|
|
||||||
('l', Box {
|
|
||||||
boxColor = withForeColor defAttr black,
|
|
||||||
boxLocation = Location 'b' 0 1,
|
|
||||||
boxType = Original $ solid 9
|
|
||||||
}),
|
|
||||||
('₁', Box {
|
|
||||||
boxColor = withForeColor defAttr green,
|
|
||||||
boxLocation = Location '1' 2 1,
|
|
||||||
boxType = Link '1'
|
|
||||||
})
|
|
||||||
]
|
|
||||||
}
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
@ -162,31 +22,36 @@ main =
|
|||||||
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 (pure w)
|
loop vty Game {
|
||||||
|
gameWorlds = pure w,
|
||||||
|
gameFlat = True
|
||||||
|
}
|
||||||
_ ->
|
_ ->
|
||||||
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 -> NonEmpty World -> IO ()
|
loop :: Vty -> Game -> IO ()
|
||||||
loop vty (world :| history) =
|
loop vty game =
|
||||||
do update vty (render world)
|
do let world = 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
|
||||||
EvKey key _modifier ->
|
EvKey key _modifier ->
|
||||||
case key of
|
case key of
|
||||||
KUp -> loop vty (move world (-1,0) :| world : history)
|
KUp -> loop vty game{ gameWorlds = NonEmpty.cons (move world (-1,0)) (gameWorlds game) }
|
||||||
KDown -> loop vty (move world (1,0) :| world : history)
|
KDown -> loop vty game{ gameWorlds = NonEmpty.cons (move world (1,0) ) (gameWorlds game) }
|
||||||
KLeft -> loop vty (move world (0,-1) :| world : history)
|
KLeft -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,-1)) (gameWorlds game) }
|
||||||
KRight -> loop vty (move world (0,1) :| world : history)
|
KRight -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,1) ) (gameWorlds game) }
|
||||||
KChar 'r' -> loop vty (pure (NonEmpty.last (world :| history)))
|
KChar 'r' -> loop vty game{ gameWorlds = pure (NonEmpty.last (gameWorlds game)) }
|
||||||
KChar 'z'
|
KChar 'z'
|
||||||
| Just worlds <- NonEmpty.nonEmpty history ->
|
| Just worlds <- NonEmpty.nonEmpty (NonEmpty.tail (gameWorlds game)) ->
|
||||||
loop vty worlds
|
loop vty game{ gameWorlds = worlds }
|
||||||
KEsc -> pure ()
|
KEsc -> pure ()
|
||||||
_ -> loop vty (world :| history)
|
KChar 'f' -> loop vty game{ gameFlat = not (gameFlat game) }
|
||||||
_ -> loop vty (world :| history)
|
_ -> loop vty game
|
||||||
|
_ -> loop vty game
|
||||||
|
|
||||||
|
|
||||||
worldList :: Map.Map String World
|
worldList :: Map.Map String World
|
||||||
@ -197,6 +62,7 @@ worldList = Map.fromList
|
|||||||
, ("center13", center13)
|
, ("center13", center13)
|
||||||
, ("clone11", clone11)
|
, ("clone11", clone11)
|
||||||
, ("transfer14", transfer14)
|
, ("transfer14", transfer14)
|
||||||
|
, ("open4", open4)
|
||||||
]
|
]
|
||||||
|
|
||||||
smallWorld :: World
|
smallWorld :: World
|
||||||
@ -431,3 +297,207 @@ transfer14 =
|
|||||||
'b'
|
'b'
|
||||||
(Set.fromList [Location 'g' (-2) 0])
|
(Set.fromList [Location 'g' (-2) 0])
|
||||||
(Location 'g' (-3) 0)
|
(Location 'g' (-3) 0)
|
||||||
|
|
||||||
|
open4 :: World
|
||||||
|
open4 =
|
||||||
|
World
|
||||||
|
(Map.fromList
|
||||||
|
[('a',
|
||||||
|
Box (Location 'a' 0 (-1))
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓▓ ▓",
|
||||||
|
"▓▓ ▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr cyan)),
|
||||||
|
('g',
|
||||||
|
Box
|
||||||
|
(Location 'a' 2 (-1))
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr green)),
|
||||||
|
('y',
|
||||||
|
Box
|
||||||
|
(Location 'a' 2 1)
|
||||||
|
(Original (makeWalls [
|
||||||
|
"▓▓▓▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓ ▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]))
|
||||||
|
(withForeColor defAttr yellow)),
|
||||||
|
('b',
|
||||||
|
Box
|
||||||
|
(Location 'a' 0 1)
|
||||||
|
(Original (solid 9))
|
||||||
|
(withForeColor defAttr red))
|
||||||
|
])
|
||||||
|
'b'
|
||||||
|
Set.empty
|
||||||
|
(Location 'y' (-3) 2)
|
||||||
|
|
||||||
|
|
||||||
|
world0 :: World
|
||||||
|
world0 = World {
|
||||||
|
worldButtons = Set.empty,
|
||||||
|
worldHome = Location '2' 0 0,
|
||||||
|
worldMe = 'b',
|
||||||
|
worldBoxes = Map.fromList
|
||||||
|
[('1', Box {
|
||||||
|
boxColor = withForeColor defAttr green,
|
||||||
|
boxLocation = Location '1' (-1) 0,
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓▓ ▓▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
" ▓",
|
||||||
|
"▓ ▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓▓▓▓▓ ▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('2', Box {
|
||||||
|
boxColor = withForeColor defAttr cyan,
|
||||||
|
boxLocation = Location '1' 1 1,
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓ ▓▓ ▓▓ ▓",
|
||||||
|
" ",
|
||||||
|
" ▓",
|
||||||
|
" ▓",
|
||||||
|
" ",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
" ",
|
||||||
|
"▓ ▓▓ ▓▓ ▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('₂', Box {
|
||||||
|
boxColor = withForeColor defAttr cyan,
|
||||||
|
boxLocation = Location '1' 2 (-1),
|
||||||
|
boxType = Link '2'
|
||||||
|
}),
|
||||||
|
('3', Box {
|
||||||
|
boxColor = withForeColor defAttr blue,
|
||||||
|
boxLocation = Location '2' 1 1,
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
" ",
|
||||||
|
"▓▓▓▓▓▓▓▓ ",
|
||||||
|
"▓▓ ▓▓▓ ",
|
||||||
|
"▓▓ ▓▓▓ ",
|
||||||
|
"▓▓▓▓ ▓▓▓ ",
|
||||||
|
"▓▓ ▓▓▓▓",
|
||||||
|
"▓▓ ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('4', Box {
|
||||||
|
boxColor = withForeColor defAttr black,
|
||||||
|
boxLocation = Location 'b' (-3) 0,
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓▓▓ ▓▓▓",
|
||||||
|
"▓ ▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓▓▓▓ ▓▓▓▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('b', Box {
|
||||||
|
boxColor = withForeColor defAttr red,
|
||||||
|
boxLocation = Location '1' 0 1,
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓▓▓▓▓▓▓▓▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓ ▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓ ▓",
|
||||||
|
"▓▓▓▓▓▓▓▓▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('x', Box {
|
||||||
|
boxColor = withForeColor defAttr yellow,
|
||||||
|
boxLocation = Location '1' 0 (-1),
|
||||||
|
boxType = Original $
|
||||||
|
makeWalls [
|
||||||
|
"▓▓ ▓ ",
|
||||||
|
" ",
|
||||||
|
" ▓ ▓▓▓ ",
|
||||||
|
" ▓ ",
|
||||||
|
"▓ ▓▓▓▓",
|
||||||
|
" ▓▓▓ ",
|
||||||
|
" ▓ ▓▓▓ ",
|
||||||
|
" ",
|
||||||
|
"▓ ▓ ▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('y', Box {
|
||||||
|
boxColor = withForeColor defAttr magenta,
|
||||||
|
boxLocation = Location '1' 0 (-2),
|
||||||
|
boxType = Original $ makeWalls [
|
||||||
|
"▓▓ ▓ ",
|
||||||
|
" ",
|
||||||
|
"▓▓ ▓▓▓ ",
|
||||||
|
"▓▓ ",
|
||||||
|
" ▓▓▓▓",
|
||||||
|
"▓▓▓▓ ",
|
||||||
|
"▓▓ ▓▓▓ ",
|
||||||
|
" ",
|
||||||
|
"▓ ▓ ▓"
|
||||||
|
]
|
||||||
|
}),
|
||||||
|
('i', Box {
|
||||||
|
boxColor = withForeColor defAttr black,
|
||||||
|
boxLocation = Location 'b' 0 (-2),
|
||||||
|
boxType = Original $ solid 9
|
||||||
|
}),
|
||||||
|
('j', Box {
|
||||||
|
boxColor = withForeColor defAttr black,
|
||||||
|
boxLocation = Location 'b' 0 (-1),
|
||||||
|
boxType = Original $ solid 9
|
||||||
|
}),
|
||||||
|
('k', Box {
|
||||||
|
boxColor = withForeColor defAttr black,
|
||||||
|
boxLocation = Location 'b' 0 0,
|
||||||
|
boxType = Original $ solid 9
|
||||||
|
}),
|
||||||
|
('l', Box {
|
||||||
|
boxColor = withForeColor defAttr black,
|
||||||
|
boxLocation = Location 'b' 0 1,
|
||||||
|
boxType = Original $ solid 9
|
||||||
|
}),
|
||||||
|
('₁', Box {
|
||||||
|
boxColor = withForeColor defAttr green,
|
||||||
|
boxLocation = Location '1' 2 1,
|
||||||
|
boxType = Link '1'
|
||||||
|
})
|
||||||
|
]
|
||||||
|
}
|
||||||
@ -67,13 +67,6 @@ boxSize world box = yhi-ylo+1
|
|||||||
solid :: Int -> Array Coord Bool
|
solid :: Int -> Array Coord Bool
|
||||||
solid n = makeWalls (replicate n (replicate n 'x'))
|
solid n = makeWalls (replicate n (replicate n 'x'))
|
||||||
|
|
||||||
-- Move an object
|
|
||||||
-- 1. remove it from the world
|
|
||||||
-- 2. compute where it would move to
|
|
||||||
-- 3. a. that spot is empty
|
|
||||||
-- b. try to move that object forward
|
|
||||||
-- c. try to move that object backward into me
|
|
||||||
|
|
||||||
move :: World -> (Int,Int) -> World
|
move :: World -> (Int,Int) -> World
|
||||||
move world dir =
|
move world dir =
|
||||||
case moveBlock world Map.empty (myLocation world) dir 0 of
|
case moveBlock world Map.empty (myLocation world) dir 0 of
|
||||||
|
|||||||
@ -9,10 +9,20 @@ import Graphics.Vty
|
|||||||
|
|
||||||
import Model
|
import Model
|
||||||
|
|
||||||
|
border :: Int
|
||||||
|
border = 20
|
||||||
|
|
||||||
unit :: Attr -> Int -> Char -> Image
|
unit :: Attr -> Int -> Char -> Image
|
||||||
unit a scale x =
|
unit a scale x =
|
||||||
vertCat (replicate scale (string a (replicate (2*scale) x)))
|
vertCat (replicate scale (string a (replicate (2*scale) x)))
|
||||||
|
|
||||||
|
drawBox :: Attr -> Int {- ^ width -} -> Int {- ^ height -} -> Image
|
||||||
|
drawBox a _ 1 = string a "[]"
|
||||||
|
drawBox a w h = vertCat $
|
||||||
|
string a ('┌' : replicate (w-2) '─' ++ "┐") :
|
||||||
|
replicate (h-2) (string a ('│' : replicate (w-2) ' ' ++ "│")) ++
|
||||||
|
[string a ('└' : replicate (w-2) '─' ++ "┘")]
|
||||||
|
|
||||||
button :: Attr -> Int -> Image
|
button :: Attr -> Int -> Image
|
||||||
button a 1 = string a "[]"
|
button a 1 = string a "[]"
|
||||||
button a n = vertCat $
|
button a n = vertCat $
|
||||||
@ -62,9 +72,12 @@ renderBox world locMap box name scale =
|
|||||||
, y <- [ylo .. yhi]
|
, y <- [ylo .. yhi]
|
||||||
]
|
]
|
||||||
|
|
||||||
render :: World -> Picture
|
render ::
|
||||||
render world = picForLayers $
|
Bool {- ^ show flat overlay -} ->
|
||||||
[ pad 98 6 0 0 $
|
World ->
|
||||||
|
Picture
|
||||||
|
render flat world = picForLayers $
|
||||||
|
[ pad 98 12 0 0 $
|
||||||
string defAttr "██╗ ██╗██╗███╗ ██╗███╗ ██╗███████╗██████╗ " <->
|
string defAttr "██╗ ██╗██╗███╗ ██╗███╗ ██╗███████╗██████╗ " <->
|
||||||
string defAttr "██║ ██║██║████╗ ██║████╗ ██║██╔════╝██╔══██╗" <->
|
string defAttr "██║ ██║██║████╗ ██║████╗ ██║██╔════╝██╔══██╗" <->
|
||||||
string defAttr "██║ █╗ ██║██║██╔██╗ ██║██╔██╗ ██║█████╗ ██████╔╝" <->
|
string defAttr "██║ █╗ ██║██║██╔██╗ ██║██╔██╗ ██║█████╗ ██████╔╝" <->
|
||||||
@ -72,10 +85,29 @@ render world = picForLayers $
|
|||||||
string defAttr "╚███╔███╔╝██║██║ ╚████║██║ ╚████║███████╗██║ ██║" <->
|
string defAttr "╚███╔███╔╝██║██║ ╚████║██║ ╚████║███████╗██║ ██║" <->
|
||||||
string defAttr " ╚══╝╚══╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═══╝╚══════╝╚═╝ ╚═╝"
|
string defAttr " ╚══╝╚══╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═══╝╚══════╝╚═╝ ╚═╝"
|
||||||
| winCondition world ] ++
|
| winCondition world ] ++
|
||||||
[drawNestedWorld world]
|
(if flat then renderFlat locMap world else []) ++
|
||||||
|
[drawNestedWorld locMap world]
|
||||||
|
where
|
||||||
|
locMap = Map.fromList [(boxLocation loc, n) | (n, loc) <- Map.toList (worldBoxes world)]
|
||||||
|
|
||||||
drawNestedWorld :: World -> Image
|
renderFlat :: Map Location Char -> World -> [Image]
|
||||||
drawNestedWorld world =
|
renderFlat locMap world =
|
||||||
|
[ pad offset 0 0 0 baseImage
|
||||||
|
, pad offset 0 0 0 $ drawBox borderAttr (imageWidth baseImage) (imageHeight baseImage)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
borderAttr = defAttr `withForeColor` white `withBackColor` black
|
||||||
|
offset = max 0 ( (2*(81+2*border)+2 - imageWidth baseImage) `div` 2)
|
||||||
|
baseImage =
|
||||||
|
pad 2 1 2 1 $
|
||||||
|
horizCat $
|
||||||
|
intersperse (char borderAttr ' ')
|
||||||
|
[renderBox world locMap b n 1
|
||||||
|
| (n,b) <- Map.assocs (worldBoxes world)
|
||||||
|
, Original{} <- [boxType b]]
|
||||||
|
|
||||||
|
drawNestedWorld :: Map Location Char -> World -> Image
|
||||||
|
drawNestedWorld locMap world =
|
||||||
-- (3*81) + 81 + (3*81)
|
-- (3*81) + 81 + (3*81)
|
||||||
cropTop (81 + 2*border) $
|
cropTop (81 + 2*border) $
|
||||||
cropLeft (2*(81 + 2*border)) $
|
cropLeft (2*(81 + 2*border)) $
|
||||||
@ -97,12 +129,8 @@ drawNestedWorld world =
|
|||||||
| y_ <- [y1-1 .. y1+1]
|
| y_ <- [y1-1 .. y1+1]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
border = 20
|
|
||||||
locMap = Map.fromList [(boxLocation loc, n) | (n, loc) <- Map.toList (worldBoxes world)]
|
|
||||||
|
|
||||||
-- name1 is the box the player is standing in
|
-- name1 is the box the player is standing in
|
||||||
Location name0 _ _ = boxLocation (worldBoxes world Map.! worldMe world)
|
Location name0 _ _ = myLocation world
|
||||||
|
|
||||||
Location name1 y1 x1 = boxLocation (worldBoxes world Map.! name0)
|
Location name1 y1 x1 = boxLocation (worldBoxes world Map.! name0)
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user