diff --git a/72d8aba554552aa8d9c2db7486e8cc00.cast b/72d8aba554552aa8d9c2db7486e8cc00.cast
new file mode 100644
index 0000000..99ea9fa
--- /dev/null
+++ b/72d8aba554552aa8d9c2db7486e8cc00.cast
@@ -0,0 +1,7 @@
+
+403 Forbidden
+
+403 Forbidden
+
nginx
+
+
diff --git a/app/Main.hs b/app/Main.hs
index 1c939fa..75fbc22 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,14 +2,14 @@ module Main where
import Data.Map qualified as Map
import Graphics.Vty
-import Control.Exception
+import Control.Exception ( bracket )
import Data.List.NonEmpty (NonEmpty(..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Set qualified as Set
-import System.Environment
+import System.Environment ( getArgs )
import Model
-import Rendering
+import Rendering ( render )
world0 :: World
world0 = World {
@@ -171,7 +171,7 @@ main =
loop :: Vty -> NonEmpty World -> IO ()
loop vty (world :| history) =
- do update vty (picForImage (drawNestedWorld world))
+ do update vty (render world)
ev <- nextEvent vty
case ev of
EvKey key _modifier ->
diff --git a/app/Model.hs b/app/Model.hs
index f65d47a..00b3793 100644
--- a/app/Model.hs
+++ b/app/Model.hs
@@ -40,6 +40,13 @@ data World = World {
}
deriving (Show, Read, Eq)
+winCondition :: World -> Bool
+winCondition world =
+ Set.isSubsetOf (worldButtons world) coverage &&
+ worldHome world == boxLocation (worldBoxes world Map.! worldMe world)
+ where
+ coverage = Set.fromList $ map boxLocation $ Map.elems (worldBoxes world)
+
makeWalls :: [String] -> Array Coord Bool
makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
where
diff --git a/app/Rendering.hs b/app/Rendering.hs
index f17d809..cafc961 100644
--- a/app/Rendering.hs
+++ b/app/Rendering.hs
@@ -4,6 +4,7 @@ import Data.Array
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set qualified as Set
+import Data.List (intersperse)
import Graphics.Vty
import Model
@@ -26,8 +27,6 @@ home a n = vertCat $
replicate (n-2) (string a ('║' : replicate (2*n-2) '░' ++ "║")) ++
[string a ('╚' : replicate (2*n-2) '═' ++ "╝")]
-
-
renderCell :: World -> Map Location Char -> Char -> Box -> Int -> Int -> Int -> Image
renderCell world locMap name box y x scale =
if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar
@@ -54,17 +53,26 @@ renderCell world locMap name box y x scale =
renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image
renderBox world locMap box name scale =
- vertCat
- [
- horizCat
- [
- renderCell world locMap name box y x scale
- | x <- [xlo .. xhi]
+ vertCat [
+ horizCat [
+ renderCell world locMap name box y x scale
+ | x <- [xlo .. xhi]
]
| let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box)
, y <- [ylo .. yhi]
]
+render :: World -> Picture
+render world = picForLayers $
+ [ pad 98 6 0 0 $
+ string defAttr "██╗ ██╗██╗███╗ ██╗███╗ ██╗███████╗██████╗ " <->
+ string defAttr "██║ ██║██║████╗ ██║████╗ ██║██╔════╝██╔══██╗" <->
+ string defAttr "██║ █╗ ██║██║██╔██╗ ██║██╔██╗ ██║█████╗ ██████╔╝" <->
+ string defAttr "██║███╗██║██║██║╚██╗██║██║╚██╗██║██╔══╝ ██╔══██╗" <->
+ string defAttr "╚███╔███╔╝██║██║ ╚████║██║ ╚████║███████╗██║ ██║" <->
+ string defAttr " ╚══╝╚══╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═══╝╚══════╝╚═╝ ╚═╝"
+ | winCondition world ] ++
+ [drawNestedWorld world]
drawNestedWorld :: World -> Image
drawNestedWorld world =
@@ -73,8 +81,12 @@ drawNestedWorld world =
cropLeft (2*(81 + 2*border)) $
cropBottom (2*81 + border) $
cropRight (2*(2*81 + border)) $
- vertCat [
- horizCat [
+ vertCat $
+ intersperse (char defAttr ' ')
+ [
+ horizCat $
+ intersperse (char defAttr ' ')
+ [
case stackedLoc world locMap (Location name1 y_ x_) of
Nothing -> unit (withForeColor defAttr black) 81 '?'
Just (Location n y x) ->