betris 0.1.0.1 → 0.1.0.2

raw patch · 3 files changed

+30/−12 lines, 3 filesdep +optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-applicative

API changes (from Hackage documentation)

Files

• app/Main.hs +25/−9
• betris.cabal +4/−2
• src/Game/Tetris.hs +1/−1

@@ -1,12 +1,13 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-} module Main where  import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM.TVar import Control.Concurrent.STM.TBChan-import Control.Lens+import Control.Lens hiding (argument) import Control.Monad (forever) import Control.Monad.STM (atomically) import Data.Char (chr)@@ -17,44 +18,59 @@ import Graphics.Vty import Linear.V2 (V2(..)) import Prelude hiding (Left, Right)+import Options.Applicative hiding ((<|>)) +versionOption :: Parser (a -> a)+versionOption = infoOption "0.1.0.2" (long "version" <> help "Show version")++data Options = Options { initialDelay :: Int } deriving Eq++programOptions :: Parser Options+programOptions =+  Options <$> option auto (long "initial-delay" <> metavar "MICROSECONDS" <>+                           value 1000000 <> showDefault <>+                           help "Initial delay")+ data Event e = Tick | Ev e deriving (Eq, Read, Show, Functor)  main = do+  Options {..} <- execParser $+    info (helper <*> versionOption <*> programOptions)+         (fullDesc <> progDesc "Braille Tetris")   vty <- mkVty defaultConfig   chan <- atomically $ newTBChan 10   game <- initGame 0-  speed <- newTVarIO 1000000+  speed <- newTVarIO initialDelay    forkIO $ forever $ do     e <- nextEvent vty     atomically $ writeTBChan chan $ Ev e    forkIO $ forever $ do+    atomically $ writeTBChan chan Tick     delay <- readTVarIO speed     atomically $ modifyTVar speed ((-) 100)     threadDelay delay-    atomically $ writeTBChan chan Tick    consume vty chan game    shutdown vty  consume vty chan game = if isGameOver game then pure () else do-  update vty $ picForImage $ string defAttr (gstr game) <|> string defAttr (show $ game ^. score)+  update vty $ picForImage $+   string defAttr (emboss game) <|> string defAttr (show $ game ^. score)   e <- atomically $ readTBChan chan   case e of-    Ev (EvKey KEsc []) -> return ()+    Ev (EvKey KEsc []) -> pure ()     Tick -> timeStep game >>= consume vty chan     Ev (EvKey KLeft []) -> consume vty chan (hardDrop game)     Ev (EvKey KUp []) -> consume vty chan (shift Left game)     Ev (EvKey KDown []) -> consume vty chan (shift Right game)     Ev (EvKey KEnter []) -> consume vty chan (rotate game)-    _ -> do-      consume vty chan game+    _ -> consume vty chan game -gstr :: Game -> String-gstr g = map go [1, 3 .. boardHeight] where+emboss :: Game -> String+emboss g = map go [1, 3 .. boardHeight] where   go y = chr $ foldr (f y) 0x2800 [((0,0),1), ((1,0), 2), ((2,0), 4)                                   ,((0,1),8), ((1,1),16), ((2,1),32)                                   ,((3,0),64),((3,1),128)]

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: af2ba80b35c973a4cc0a173694bdba4ac17263923f169624815228e5ce572086+-- hash: 5360efc32ccffdd515059c6e1e560a8654006da8d9f4bf594d7712a8f739cd92  name:           betris-version:        0.1.0.1+version:        0.1.0.2 synopsis:       Braille friendly horizontal version of tetris description:    Please see the README at <https://github.com/mlang/betris#readme> category:       Game@@ -37,6 +37,7 @@     , containers     , lens     , linear+    , optparse-applicative     , random     , stm     , stm-chans@@ -56,6 +57,7 @@     , containers     , lens     , linear+    , optparse-applicative     , random     , stm     , stm-chans

@@ -143,7 +143,7 @@   where     go (t :< ts) = pure (t, ts)     go EmptyL = freshList >>= bagFourTetriminoEach-    freshList = shuffle . Seq.fromList . take 28 . cycle $ [(I)..]+    freshList = shuffle . Seq.fromList . take 28 . cycle $ [I ..]  -- | Initialize a game with a given level initGame :: Int ->  IO Game