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

Indicate victory

Browse Source
This commit is contained in:
Eric Mertens 2022-12-02 21:33:44 -08:00
parent 86a360bfaf
commit 19fb1304bd
4 changed files with 40 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
72d8aba554552aa8d9c2db7486e8cc00.cast Normal file
View File

@ -0,0 +1,7 @@
<html>
<head><title>403 Forbidden</title></head>
<body>
<center><h1>403 Forbidden</h1></center>
<hr><center>nginx</center>
</body>
</html>

8
app/Main.hs
View File

@ -2,14 +2,14 @@ module Main where
import Data.Map qualified as Map import Data.Map qualified as Map
import Graphics.Vty import Graphics.Vty
import Control.Exception import Control.Exception ( bracket )
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import Data.List.NonEmpty qualified as NonEmpty import Data.List.NonEmpty qualified as NonEmpty
import Data.Set qualified as Set import Data.Set qualified as Set
import System.Environment import System.Environment ( getArgs )
import Model import Model
import Rendering import Rendering ( render )
world0 :: World world0 :: World
world0 = World { world0 = World {
@ -171,7 +171,7 @@ main =
loop :: Vty -> NonEmpty World -> IO () loop :: Vty -> NonEmpty World -> IO ()
loop vty (world :| history) = loop vty (world :| history) =
do update vty (picForImage (drawNestedWorld world)) do update vty (render world)
ev <- nextEvent vty ev <- nextEvent vty
case ev of case ev of
EvKey key _modifier -> EvKey key _modifier ->

7
app/Model.hs
View File

@ -40,6 +40,13 @@ data World = World {
} }
deriving (Show, Read, Eq) 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 :: [String] -> Array Coord Bool
makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows)) makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
where where

28
app/Rendering.hs
View File

@ -4,6 +4,7 @@ import Data.Array
import Data.Map (Map) import Data.Map (Map)
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.List (intersperse)
import Graphics.Vty import Graphics.Vty
import Model import Model
@ -26,8 +27,6 @@ home a n = vertCat $
replicate (n-2) (string a ('║' : replicate (2*n-2) '░' ++ "║")) ++ replicate (n-2) (string a ('║' : replicate (2*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 -> Map Location Char -> Char -> Box -> Int -> Int -> Int -> Image
renderCell world locMap name box y x scale = renderCell world locMap name box y x scale =
if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar
@ -54,10 +53,8 @@ renderCell world locMap name box y x scale =
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 =
vertCat vertCat [
[ horizCat [
horizCat
[
renderCell world locMap name box y x scale renderCell world locMap name box y x scale
| x <- [xlo .. xhi] | x <- [xlo .. xhi]
] ]
@ -65,6 +62,17 @@ renderBox world locMap box name scale =
, y <- [ylo .. yhi] , 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 -> Image
drawNestedWorld world = drawNestedWorld world =
@ -73,8 +81,12 @@ drawNestedWorld world =
cropLeft (2*(81 + 2*border)) $ cropLeft (2*(81 + 2*border)) $
cropBottom (2*81 + border) $ cropBottom (2*81 + border) $
cropRight (2*(2*81 + border)) $ cropRight (2*(2*81 + border)) $
vertCat [ vertCat $
horizCat [ intersperse (char defAttr ' ')
[
horizCat $
intersperse (char defAttr ' ')
[
case stackedLoc world locMap (Location name1 y_ x_) of case stackedLoc world locMap (Location name1 y_ x_) of
Nothing -> unit (withForeColor defAttr black) 81 '?' Nothing -> unit (withForeColor defAttr black) 81 '?'
Just (Location n y x) -> Just (Location n y x) ->