From d3f3890dc5408581eb6181125c871d1cf2c0e18f Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sun, 25 Aug 2019 13:28:10 -0400
Subject: An @-sign in a box, in haskell

Initial commit of a Haskell version of Xanthous, written using Brick and
built with Nix.

This is so much nicer and so much easier
---
 src/Main.hs               | 17 +++++++++++++++++
 src/Xanthous/App.hs       | 21 +++++++++++++++++++++
 src/Xanthous/Game.hs      | 12 ++++++++++++
 src/Xanthous/Game/Draw.hs | 28 ++++++++++++++++++++++++++++
 src/Xanthous/Prelude.hs   | 10 ++++++++++
 src/Xanthous/Resource.hs  | 11 +++++++++++
 6 files changed, 99 insertions(+)
 create mode 100644 src/Main.hs
 create mode 100644 src/Xanthous/App.hs
 create mode 100644 src/Xanthous/Game.hs
 create mode 100644 src/Xanthous/Game/Draw.hs
 create mode 100644 src/Xanthous/Prelude.hs
 create mode 100644 src/Xanthous/Resource.hs

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 000000000000..1cd4e9445789
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,17 @@
+module Main where
+
+import Xanthous.Prelude
+import Brick
+
+import Xanthous.Game (getInitialState)
+import Xanthous.App (makeApp)
+
+ui :: Widget ()
+ui = str "Hello, world!"
+
+main :: IO ()
+main = do
+  app <- makeApp
+  initialState <- getInitialState
+  _ <- defaultMain app initialState
+  pure ()
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
new file mode 100644
index 000000000000..5c0383c38e19
--- /dev/null
+++ b/src/Xanthous/App.hs
@@ -0,0 +1,21 @@
+module Xanthous.App (makeApp) where
+
+import Xanthous.Prelude
+import Brick hiding (App)
+import qualified Brick
+import Graphics.Vty.Attributes (defAttr)
+
+import Xanthous.Game
+import Xanthous.Game.Draw (drawGame)
+import Xanthous.Resource (Name)
+
+type App = Brick.App GameState () Name
+
+makeApp :: IO App
+makeApp = pure $ Brick.App
+  { appDraw = drawGame
+  , appChooseCursor = const headMay
+  , appHandleEvent = resizeOrQuit
+  , appStartEvent = pure
+  , appAttrMap = const $ attrMap defAttr []
+  }
diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
new file mode 100644
index 000000000000..c88509819cbb
--- /dev/null
+++ b/src/Xanthous/Game.hs
@@ -0,0 +1,12 @@
+module Xanthous.Game
+  ( GameState(..)
+  , getInitialState
+  ) where
+
+import Xanthous.Prelude
+
+data GameState = GameState
+  { }
+
+getInitialState :: IO GameState
+getInitialState = pure GameState
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
new file mode 100644
index 000000000000..2d793ba27bd5
--- /dev/null
+++ b/src/Xanthous/Game/Draw.hs
@@ -0,0 +1,28 @@
+module Xanthous.Game.Draw
+  ( drawGame
+  ) where
+
+import Xanthous.Prelude
+import Brick
+import Brick.Widgets.Border
+import Brick.Widgets.Border.Style
+
+import Xanthous.Game (GameState(..))
+import Xanthous.Resource (Name(..))
+
+drawMessages :: GameState -> Widget Name
+drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?"
+
+drawMap :: GameState -> Widget Name
+drawMap _game
+  = viewport MapViewport Both
+  $ vBox mapRows
+  where
+    -- TODO
+    firstRow = [str "@"] <> replicate 79 (str " ")
+    mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ")
+
+drawGame :: GameState -> [Widget Name]
+drawGame game = pure . withBorderStyle unicode
+  $   drawMessages game
+  <=> border (drawMap game)
diff --git a/src/Xanthous/Prelude.hs b/src/Xanthous/Prelude.hs
new file mode 100644
index 000000000000..e75c11d7bb56
--- /dev/null
+++ b/src/Xanthous/Prelude.hs
@@ -0,0 +1,10 @@
+module Xanthous.Prelude
+  ( module ClassyPrelude
+  , Type
+  , Constraint
+  , module GHC.TypeLits
+  ) where
+
+import ClassyPrelude hiding (return)
+import Data.Kind
+import GHC.TypeLits hiding (Text)
diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs
new file mode 100644
index 000000000000..2310a68cc26a
--- /dev/null
+++ b/src/Xanthous/Resource.hs
@@ -0,0 +1,11 @@
+module Xanthous.Resource
+  ( Name(..)
+  ) where
+
+import Xanthous.Prelude
+
+data Name = MapViewport
+            -- ^ The main viewport where we display the game content
+          | MessageBox
+            -- ^ The box where we display messages to the user
+  deriving stock (Show, Eq, Ord)
-- 
cgit 1.4.1