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

7
app/Model.hs
View File

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

32
app/Rendering.hs
View File

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