feat (*.*): basic skeleton in place

.editorconfig

@@ -0,0 +1,12 @@
+# EditorConfig - http://EditorConfig.org
+
+# top-most EditorConfig file
+root = true
+
+[*]
+end_of_line = lf
+trim_trailing_whitespace = true
+insert_final_newline = false
+indent_style = space
+indent_size = 4
+charset = utf-8

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+haskell-game.cabal
+*~

LICENSE

@@ -0,0 +1,30 @@
+Copyright Mark Wales (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Mark Wales nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,13 @@
+# ASCII-Runner
+
+An infinite runner in your terminal
+
+## FAQ
+
+### Why?
+
+Why not
+
+### Seriously?
+
+Yup

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,8 @@
+module Main (main) where
+
+import ClassyPrelude
+
+import Game (play)
+
+main :: IO ()
+main = play

package.yaml

@@ -0,0 +1,54 @@
+name:                runner
+version:             0.1.0.0
+github:              "smallhadroncollider/ascii-runner"
+license:             BSD3
+author:              "Mark Wales"
+maintainer:          "[email protected]"
+copyright:           "2018 Mark Wales"
+
+extra-source-files:
+- README.md
+
+synopsis:            An ASCII inifinite runner
+category:            Game
+
+description:         Please see the README on GitHub at <https://github.com/smallhadroncollider/ascii-runner#readme>
+
+default-extensions:
+- OverloadedStrings
+- NoImplicitPrelude
+
+dependencies:
+- base >= 4.7 && < 5
+- classy-prelude
+- lens
+- text
+
+library:
+  source-dirs: src
+  dependencies:
+  - vty
+  - brick
+  - terminal-size
+
+executables:
+  runner:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - runner
+
+tests:
+  runner-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - runner

runner.cabal

@@ -0,0 +1,81 @@
+-- This file has been generated from package.yaml by hpack version 0.28.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: a1fe108139c7ce97a970a01de3e8fd766c8f1914e1d08a88019fc9f28c6a5688
+
+name:           runner
+version:        0.1.0.0
+synopsis:       An ASCII inifinite runner
+description:    Please see the README on GitHub at <https://github.com/smallhadroncollider/ascii-runner#readme>
+category:       Game
+homepage:       https://github.com/smallhadroncollider/ascii-runner#readme
+bug-reports:    https://github.com/smallhadroncollider/ascii-runner/issues
+author:         Mark Wales
+maintainer:     [email protected]
+copyright:      2018 Mark Wales
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/smallhadroncollider/ascii-runner
+
+library
+  exposed-modules:
+      Draw
+      Game
+      Loop
+      Types
+      Window
+  other-modules:
+      Paths_runner
+  hs-source-dirs:
+      src
+  default-extensions: OverloadedStrings NoImplicitPrelude
+  build-depends:
+      base >=4.7 && <5
+    , brick
+    , classy-prelude
+    , lens
+    , terminal-size
+    , text
+    , vty
+  default-language: Haskell2010
+
+executable runner
+  main-is: Main.hs
+  other-modules:
+      Paths_runner
+  hs-source-dirs:
+      app
+  default-extensions: OverloadedStrings NoImplicitPrelude
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , classy-prelude
+    , lens
+    , runner
+    , text
+  default-language: Haskell2010
+
+test-suite runner-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_runner
+  hs-source-dirs:
+      test
+  default-extensions: OverloadedStrings NoImplicitPrelude
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , classy-prelude
+    , lens
+    , runner
+    , text
+  default-language: Haskell2010

src/Draw.hs

@@ -0,0 +1,25 @@
+module Draw (draw) where
+
+import ClassyPrelude
+
+import Control.Lens ((^.))
+
+import Brick (vBox, txt, Widget)
+import Types (Name, UI, dimensions, position)
+
+period :: Float
+period = 4 * pi
+
+pixel :: Float -> Float -> Char
+pixel y i = if y > cos i then '█' else ' '
+
+makeRow :: Float -> Float -> Float -> Text
+makeRow xStart screenWidth y = pack $ pixel y <$> [xStart, xStart + w .. period + xStart]
+    where w = period / screenWidth
+
+draw :: UI -> [Widget Name]
+draw ui = do
+    let i = ui ^. position
+    let (w, h) = ui ^. dimensions
+    let h' = 2 / (fromIntegral h - 1)
+    [vBox $ txt . makeRow (fromIntegral i * 0.1) (fromIntegral w - 1) <$> [-1, (-1 + h') .. 1]]

src/Game.hs

@@ -0,0 +1,40 @@
+module Game (play) where
+
+import ClassyPrelude
+
+import Control.Lens ((&), (+~), (.~))
+
+import Brick
+import Brick.BChan (newBChan)
+import Graphics.Vty (Event(EvKey), Key(KChar), defAttr, mkVty, defaultConfig)
+
+import Draw (draw)
+import Loop (loop)
+import Types (Name, UI, Tick(Tick), create, dimensions, position)
+import Window (getDimensions)
+
+handleTick :: UI -> EventM Name (Next UI)
+handleTick ui = do
+    s <- liftIO getDimensions
+    continue $ ui & position +~ 1 & dimensions .~ s
+
+handleEvent :: UI -> BrickEvent Name Tick -> EventM Name (Next UI)
+handleEvent ui (VtyEvent (EvKey (KChar 'q') [])) = halt ui
+handleEvent ui (AppEvent Tick) = handleTick ui
+handleEvent ui _ = continue ui
+
+app :: App UI Tick Name
+app = App {
+    appDraw = draw
+  , appChooseCursor = neverShowCursor
+  , appHandleEvent = handleEvent
+  , appStartEvent = return
+  , appAttrMap = const $ attrMap defAttr []
+}
+
+play :: IO ()
+play = do
+    chan <- newBChan 1
+    loop chan
+    s <- getDimensions
+    void $ customMain (mkVty defaultConfig) (Just chan) app $ create s

src/Loop.hs

@@ -0,0 +1,13 @@
+module Loop (loop) where
+
+import ClassyPrelude
+
+import Control.Concurrent (forkIO, threadDelay)
+import Brick.BChan (BChan, writeBChan)
+
+import Types (Tick(Tick))
+
+loop :: BChan Tick -> IO ()
+loop chan = void . forkIO . forever $ do
+    writeBChan chan Tick
+    threadDelay 64000

src/Types.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Types (
+    UI
+  , Tick(..)
+  , Name
+  , create
+  , position
+  , dimensions
+) where
+
+import ClassyPrelude
+
+import Control.Lens (makeLenses)
+
+import Window (Dimensions)
+
+data UI = UI {
+    _position :: Int
+  , _dimensions :: Dimensions
+}
+
+$(makeLenses ''UI)
+
+create :: Dimensions -> UI
+create s = UI {
+        _position = 0
+      , _dimensions = s
+    }
+
+data Tick = Tick
+type Name = ()

src/Window.hs

@@ -0,0 +1,17 @@
+module Window (
+    Dimensions
+  , getDimensions
+) where
+
+import ClassyPrelude
+
+import qualified System.Console.Terminal.Size as S (Window(..), size)
+
+type Dimensions = (Int, Int)
+
+deMaybe :: Maybe (S.Window Int) -> Dimensions
+deMaybe (Just (S.Window h w)) = (w, h)
+deMaybe Nothing = (80, 30)
+
+getDimensions :: IO Dimensions
+getDimensions = deMaybe <$> S.size

stack.yaml

@@ -0,0 +1 @@
+resolver: lts-11.13

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"