parabox/app/Main.hs

module Main where

import Data.Map qualified as Map
import Graphics.Vty
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 ( getArgs )

import Model
import Rendering ( render )

data Game = Game {
  gameWorlds :: NonEmpty World,
  gameFlat :: Bool
}

main :: IO ()
main =
 do args <- getArgs
    case args of 
      x:_ | Just w <- Map.lookup x worldList ->  
        bracket (mkVty =<< userConfig) shutdown \vty ->
          loop vty Game {
            gameWorlds = pure w,
            gameFlat = True
            }
      _ ->
       do putStrLn "Usage: parabox <worldname>"
          putStrLn "" 
          putStrLn "Available worlds:" 
          mapM_ putStrLn (Map.keys worldList)

loop :: Vty -> Game -> IO ()
loop vty game =
 do let world = NonEmpty.head (gameWorlds game) 
    update vty (render (gameFlat game) (NonEmpty.head (gameWorlds game)))
    ev <- nextEvent vty
    case ev of
      EvKey key _modifier ->
        case key of
          KUp    -> loop vty game{ gameWorlds = NonEmpty.cons (move world (-1,0)) (gameWorlds game) }
          KDown  -> loop vty game{ gameWorlds = NonEmpty.cons (move world (1,0) ) (gameWorlds game) }
          KLeft  -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,-1)) (gameWorlds game) }
          KRight -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,1) ) (gameWorlds game) }
          KChar 'r' -> loop vty game{ gameWorlds = pure (NonEmpty.last (gameWorlds game)) }
          KChar 'z'
            | Just worlds <- NonEmpty.nonEmpty (NonEmpty.tail (gameWorlds game)) ->
              loop vty game{ gameWorlds = worlds }
          KEsc -> pure ()
          KChar 'f' -> loop vty game{ gameFlat = not (gameFlat game) }
          _ -> loop vty game
      _ -> loop vty game


worldList :: Map.Map String World
worldList = Map.fromList
  [ ("world0", world0)
  , ("small", smallWorld)
  , ("center8", center8)
  , ("center13", center13)
  , ("clone11", clone11)
  , ("transfer14", transfer14)
  , ("open4", open4)
  , ("cycle10", cycle10)
  , ("player10", player10)
  , ("player11", player11)
  , ("player18", player18)
  ]

smallWorld :: World
smallWorld =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 0 0)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓  ▓    ▓",
            "▓  ▓    ▓",
            "▓▓▓▓    ▓",
            "▓       ▓",
            "▓       ▓",
            "▓       ▓",
            "▓       ▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr black) False),
      ('1',
        Box
          (Location 'a' (-3) (-3))
          (Original (makeWalls (replicate 9 (replicate 9 ' '))))
          (withForeColor defAttr yellow) False),
      ('2',
        Box
          (Location 'a' (-3) (-2))
          (Original (makeWalls (replicate 9 (replicate 9 ' '))))
          (withForeColor defAttr magenta) False),
      ('3',
        Box
          (Location 'a' (-2) (-3))
          (Original (makeWalls (replicate 9 (replicate 9 ' '))))
          (withForeColor defAttr blue) False),
      ('4',
        Box
          (Location 'a' (-2) (-2))
          (Original (makeWalls (replicate 9 (replicate 9 ' '))))
          (withForeColor defAttr green) False),
      ('b',
        Box
          (Location '1' 0 0)
          (Original (solid 9))
          (withForeColor defAttr red) True)
    ]) 'b'
    Set.empty
    (Location 'b' 0 0)

center8 :: World
center8 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 3 (-3))
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓      ▓▓",
            "▓      ▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓ ▓▓   ▓▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr black)
          False),
      ('1',
        Box
          (Location 'a' 0 0)
          (Original (makeWalls [
            "       ▓▓",
            "    ▓▓▓▓▓",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         "
           ]))
          (withForeColor defAttr green)
          False),
      ('2',
        Box
          (Location '1' (-4) 0)
          (Original (solid 9))
          (withForeColor defAttr yellow)
          True),
      ('b',
        Box
          (Location 'a' (-1) 0)
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ]) 'b'
    Set.empty
    (Location 'a' 3 2)

center13 :: World
center13 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 3 (-3))
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓       ▓",
            "▓       ▓",
            "▓       ▓",
            "▓       ▓",
            "▓  ▓▓▓ ▓▓",
            "▓  ▓ ▓ ▓▓",
            "▓ ▓▓    ▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr cyan)
          False),
      ('1',
        Box
          (Location 'a' (-1) 1)
          (Original (makeWalls [
            "         ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            " ▓▓▓▓▓▓▓ ",
            "         "
           ]))
          (withForeColor defAttr green)
          False),
      ('2',
        Box
          (Location 'a' (-1) (-1))
          (Original (solid 9))
          (withForeColor defAttr yellow)
          True),
      ('b',
        Box
          (Location 'a' (-3) 0)
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ]) 'b'
    Set.empty
    (Location 'a' 2 0)


clone11 :: World
clone11 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' (-2) 2)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓   ▓   ▓",
            "▓   ▓   ▓",
            "▓   ▓   ▓",
            "    ▓    ",
            "▓   ▓   ▓",
            "▓   ▓   ▓",
            "▓▓▓   ▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr green)
          False),
      ('A',
        Box
          (Location 'a' 0 2)
          (Link 'a')
          (withForeColor defAttr green)
          True),
      ('b',
        Box
          (Location 'a' 0 (-2))
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ])
    'b'
    (Set.fromList [Location 'a' (-1) (-3), Location 'a' (-2) (-3)])
    (Location 'a' (-3) (-3))

transfer14 :: World
transfer14 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 1 1)
          (Original (makeWalls [
            "         ",
            "         ",
            "         ",
            "         ",
            "    ▓    ",
            "         ",
            "         ",
            "         ",
            "         "
           ]))
          (withForeColor defAttr cyan)
          False),
      ('g',
        Box
          (Location 'a' (-1) (-1))
          (Original (makeWalls [
            "   ▓▓▓   ",
            "   ▓ ▓   ",
            "         ",
            "    ▓    ",
            "▓▓  ▓  ▓▓",
            "    ▓    ",
            "         ",
            "         ",
            "    ▓    "
          ]))
          (withForeColor defAttr green)
          False),
      ('x',
        Box
          (Location 'g' 3 (-3))
          (Original (makeWalls [
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         "
          ]))
          (withForeColor defAttr magenta)
          False),
      ('b',
        Box
          (Location 'a' 1 (-1))
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ])
    'b'
    (Set.fromList [Location 'g' (-2) 0])
    (Location 'g' (-3) 0)

open4 :: World
open4 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 0 (-1))
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓   ▓▓▓▓",
            "▓▓      ▓",
            "▓       ▓",
            "▓▓      ▓",
            "▓▓      ▓",
            "▓▓      ▓",
            "▓▓      ▓",
            "▓▓      ▓"
           ]))
          (withForeColor defAttr cyan)
          False),
      ('g',
        Box
          (Location 'a' 2 (-1))
          (Original (makeWalls [
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓"
          ]))
          (withForeColor defAttr green)
          False),
      ('y',
        Box
          (Location 'a' 2 1)
          (Original (makeWalls [
            "▓▓▓▓▓▓ ▓▓",
            "▓▓▓▓▓▓ ▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
          ]))
          (withForeColor defAttr yellow)
          False),
      ('b',
        Box
          (Location 'a' 0 1)
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ])
    '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 [
        "▓▓     ▓▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "        ▓",
        "▓   ▓   ▓",
        "▓       ▓",
        "▓       ▓",
        "▓ ▓▓▓▓▓ ▓"
        ],
      boxBoring = False
    }),
    ('2', Box {
      boxColor = withForeColor defAttr cyan,
      boxLocation = Location '1' 1 1,
      boxType = Original $ makeWalls [
        "▓ ▓▓ ▓▓ ▓",
        "         ",
        "        ▓",
        "        ▓",
        "         ",
        "▓       ▓",
        "▓       ▓",
        "         ",
        "▓ ▓▓ ▓▓ ▓"
      ],
      boxBoring = False
    }),
    ('₂', Box {
      boxColor = withForeColor defAttr cyan,
      boxLocation = Location '1' 2 (-1),
      boxType = Link '2',
      boxBoring = True
    }),
    ('3', Box {
      boxColor = withForeColor defAttr blue,
      boxLocation = Location '2' 1 1,
      boxType = Original $ makeWalls [
        "▓▓▓▓▓▓▓▓▓",
        "         ",
        "▓▓▓▓▓▓▓▓ ",
        "▓▓   ▓▓▓ ",
        "▓▓   ▓▓▓ ",
        "▓▓▓▓ ▓▓▓ ",
        "▓▓   ▓▓▓▓",
        "▓▓   ▓▓▓▓",
        "▓▓▓▓ ▓▓▓▓"
      ],
      boxBoring = False
    }),
        ('4', Box {
      boxColor = withForeColor defAttr black,
      boxLocation = Location 'b' (-3) 0,
      boxType = Original $ makeWalls [
        "▓▓▓   ▓▓▓",
        "▓   ▓   ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓▓▓▓ ▓▓▓▓"
      ],
      boxBoring = False
    }),
    ('b', Box {
        boxColor = withForeColor defAttr red,
        boxLocation = Location '1' 0 1,
        boxType = Original $ makeWalls [
        "▓▓▓▓▓▓▓▓▓",
        "▓       ▓",
        "▓       ▓",
        "▓  ▓  ▓ ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓       ▓",
        "▓▓▓▓▓▓▓▓▓"
        ],
        boxBoring = True
    }),
    ('x', Box {
        boxColor = withForeColor defAttr yellow,
        boxLocation = Location '1' 0 (-1),
        boxType = Original $
        makeWalls [
        "▓▓  ▓    ",
        "         ",
        " ▓   ▓▓▓ ",
        " ▓       ",
        "▓    ▓▓▓▓",
        " ▓▓▓     ",
        " ▓   ▓▓▓ ",
        "         ",
        "▓   ▓   ▓"],
        boxBoring = False
    }),
    ('y', Box {
        boxColor = withForeColor defAttr magenta,
        boxLocation = Location '1' 0 (-2),
        boxType = Original $ makeWalls [ 
        "▓▓  ▓    ",
        "         ",
        "▓▓   ▓▓▓ ",
        "▓▓       ",
        "     ▓▓▓▓",
        "▓▓▓▓     ",
        "▓▓   ▓▓▓ ",
        "         ",
        "▓   ▓   ▓"],
        boxBoring = False
    }),
    ('i', Box {
        boxColor = withForeColor defAttr black,
        boxLocation = Location 'b' 0 (-2),
        boxType = Original $ solid 9,
        boxBoring = True
    }),
    ('j', Box {
        boxColor = withForeColor defAttr black,
        boxLocation = Location 'b' 0 (-1),
        boxType = Original $ solid 9,
        boxBoring = True
    }),
        ('k', Box {
        boxColor = withForeColor defAttr black,
        boxLocation = Location 'b' 0 0,
        boxType = Original $ solid 9,
        boxBoring = True
    }),
        ('l', Box {
        boxColor = withForeColor defAttr black,
        boxLocation = Location 'b' 0 1,
        boxType = Original $ solid 9,
        boxBoring = True
    }),
    ('₁', Box {
      boxColor = withForeColor defAttr green,
      boxLocation = Location '1' 2 1,
      boxType = Link '1',
      boxBoring = True
    })
    ]
  }

cycle10 :: World
cycle10 =
  World
    (Map.fromList
    [('g',
      Box (Location 'g' 3 3)
          (Original (makeWalls [
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓     ▓▓▓",
            "▓     ▓▓▓",
            "▓     ▓▓▓",
            "▓     ▓▓▓",
            "▓     ▓ ▓",
            "▓     ▓ ▓"
           ]))
          (withForeColor defAttr green)
          False),
      ('G',
        Box
          (Location 'g' 0 (-2))
          (Link 'g')
          (withForeColor defAttr green)
          True),
      ('p',
        Box
          (Location 'g' 0 0)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓ ▓▓▓ ▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
          ]))
          (withForeColor defAttr magenta)
          True),
      ('y',
        Box
          (Location 'g' (-4) 0)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓  ",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
          ]))
          (withForeColor defAttr yellow)
          False),
    ('1',
        Box
          (Location 'g' (-2) 0)
          (Original (solid 9))
          (withForeColor defAttr red)
          True),
    ('2',
        Box
          (Location 'g' 2 0)
          (Original (solid 9))
          (withForeColor defAttr red)
          True),
    ('3',
        Box
          (Location 'g' 2 (-2))
          (Original (solid 9))
          (withForeColor defAttr red)
          True)
    ])
    'p'
    Set.empty
    (Location 'y' 0 3)


player10 :: World
player10 =
  World
    (Map.fromList
    [('a',
      Box (Location 'a' 3 3)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓ ▓▓▓▓▓▓",
            "▓▓    ▓▓▓",
            "▓▓    ▓ ▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr cyan)
          False),
      ('p',
        Box
          (Location 'a' (-2) 0)
          (Link 'c')
          (withForeColor defAttr magenta)
          True),
      ('C',
        Box
          (Location 'a' 0 2)
          (Link 'c')
          (withForeColor defAttr magenta)
          True),
      ('c',
        Box
          (Location 'a' (-1) 0)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓    ",
            "▓▓▓▓▓    ",
            "▓▓▓▓▓    ",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
          ]))
          (withForeColor defAttr magenta)
          False),
    ('1',
        Box
          (Location 'a' (-3) 2)
          (Original (solid 9))
          (withForeColor defAttr blue)
          True)
    ])
    'p'
    (Set.singleton (Location 'a' 2 1))
    (Location 'a' 3 1)

player11 :: World
player11 =
  World
    (Map.fromList
    [('_',
      Box (Location '_' 3 3)
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓ ▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr cyan)
          True),
      ('a',
        Box
          (Location '_' 0 0)
          (Original (makeWalls [
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         "
          ]))
          (withForeColor defAttr magenta)
          True),
      ('A',
        Box
          (Location 'a' 0 0)
          (Link 'a')
          (withForeColor defAttr brightMagenta)
          True),
      ('b',
        Box
          (Location 'a' (-1) (-4))
          (Original (makeWalls [
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         ",
            "         "
          ]))
          (withForeColor defAttr yellow)
          False),
    ('1',
        Box
          (Location 'a' 0 4)
          (Original (solid 9))
          (withForeColor defAttr blue)
          True)
    ])
    'A'
    (Set.fromList [Location 'a' 1 4, Location 'a' (-1) 4])
    (Location 'a' 1 (-4))

player18 :: World
player18 =
  World
    (Map.fromList
    [('c',
      Box (Location 'c' (-1) (-1))
          (Original (makeWalls [
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓       ",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
           ]))
          (withForeColor defAttr yellow)
          False),
      ('u',
        Box
          (Location 'c' 0 0)
          (Original (makeWalls [
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓▓▓ ▓▓▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓     ▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓",
            "▓▓▓▓▓▓▓▓▓"
          ]))
          (withForeColor defAttr magenta)
          False),
    ('1',
        Box
          (Location 'c' (-1) 1)
          (Original (solid 9))
          (withForeColor defAttr blue)
          True),
    ('2',
        Box
          (Location 'c' 1 (-1))
          (Original (solid 9))
          (withForeColor defAttr blue)
          True),
    ('3',
        Box
          (Location 'c' 1 1)
          (Original (solid 9))
          (withForeColor defAttr blue)
          True)
    ])
    'u'
    (Set.singleton (Location 'u' (-1) 2))
    (Location 'u' 1 (-2))