betris 0.1.1.0 → 0.1.1.1
raw patch · 3 files changed
+42/−37 lines, 3 filesdep −stm-chansdep ~basedep ~lensPVP ok
version bump matches the API change (PVP)
Dependencies removed: stm-chans
Dependency ranges changed: base, lens
API changes (from Hackage documentation)
Files
- app/Main.hs +1/−0
- betris.cabal +7/−9
- src/Command/Betris.hs +34/−28
app/Main.hs view
@@ -2,6 +2,7 @@ import qualified Command.Betris as Betris import Control.Monad (join)+import Data.Semigroup ((<>)) import Options.Applicative main = join $ execParser $ info (helper <*> Betris.command) $
betris.cabal view
@@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: fe3279b316adac9c02a50ad90f46dd1800c4189084639dd9ff3b91c81847dc20+-- hash: a79ba4c668b7653cb2397c625f1a7eaee37bee3eb6e1a2744a64ac110d153fe7 name: betris-version: 0.1.1.0+version: 0.1.1.1 synopsis: A horizontal version of tetris for braille users-description: Please see the README at <https://github.com/mlang/betris#readme>+description: The game of tetris for braille display users, implemented using unicode braille rotated 90 degrees. Tetriminos are "falling" from right to left. category: Game homepage: https://github.com/mlang/betris#readme bug-reports: https://github.com/mlang/betris/issues@@ -34,14 +34,13 @@ hs-source-dirs: src build-depends:- base >=4.11.0 && <4.12+ base >=4.9.0 && <4.12 , containers >=0.5.7 && <0.6- , lens >=4.16.0 && <4.17+ , lens >=4.15.4 && <4.17 , linear >=1.20.7 && <1.21 , optparse-applicative >=0.14.2 && <0.15 , random >=1.1 && <1.2 , stm >=2.4.5 && <2.5- , stm-chans >=3.0.0 && <3.1 , time-units >=1.0.0 && <1.1 , vty >=5.21 && <5.24 default-language: Haskell2010@@ -54,15 +53,14 @@ app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends:- base >=4.11.0 && <4.12+ base >=4.9.0 && <4.12 , betris , containers >=0.5.7 && <0.6- , lens >=4.16.0 && <4.17+ , lens >=4.15.4 && <4.17 , linear >=1.20.7 && <1.21 , optparse-applicative >=0.14.2 && <0.15 , random >=1.1 && <1.2 , stm >=2.4.5 && <2.5- , stm-chans >=3.0.0 && <3.1 , time-units >=1.0.0 && <1.1 , vty >=5.21 && <5.24 default-language: Haskell2010
src/Command/Betris.hs view
@@ -5,18 +5,20 @@ module Command.Betris (command, Options(..), betris) where import Control.Concurrent (forkIO, threadDelay)-import Control.Concurrent.STM.TVar-import Control.Concurrent.STM.TBChan+import Control.Concurrent.STM.TChan import Control.Lens hiding (argument) import Control.Monad (forever) import Control.Monad.STM (atomically) import Data.Char (chr) import Data.Foldable (for_)+import Data.IORef import qualified Data.Map as Map+import Data.Semigroup ((<>)) import Data.Time.Units import Data.Version (showVersion) import Game.Tetris-import Graphics.Vty+import Graphics.Vty hiding (Event)+import qualified Graphics.Vty as Vty (Event) import Linear.V2 (V2(..)) import Paths_betris (version) import Prelude hiding (Left, Right)@@ -28,47 +30,42 @@ data Options = Options { initialDelay :: Millisecond } deriving (Eq, Show) programOptions :: Parser Options-programOptions =- Options <$> option auto (long "initial-delay" <> metavar "DURATION" <>- value (fromMicroseconds 1000000) <> showDefault <>- help "Initial delay")+programOptions = Options <$> initialDelayOption data Event e = Tick | Ev e deriving (Eq, Read, Show, Functor) +betris :: Options -> IO () betris Options{..} = do vty <- mkVty =<< userConfig- chan <- newTBChanIO 10+ chan <- newTChanIO game <- initGame 0- speed <- newTVarIO $ fromIntegral $ toMicroseconds initialDelay-- forkIO $ forever $ do- e <- nextEvent vty- atomically $ writeTBChan chan $ Ev e+ speed <- newIORef $ fromIntegral $ toMicroseconds initialDelay + forkIO $ forever $ nextEvent vty >>= atomically . writeTChan chan . Ev forkIO $ forever $ do- atomically $ writeTBChan chan Tick- delay <- readTVarIO speed- atomically $ modifyTVar speed ((-) 500)- threadDelay delay+ readIORef speed >>= threadDelay+ modifyIORef speed ((-) 500)+ atomically $ writeTChan chan Tick _ <- play vty chan game shutdown vty putStrLn "" -play vty chan game- | isGameOver game = pure $ game ^. score+play :: Vty -> TChan (Event Vty.Event) -> Game -> IO Game+play vty chan tetris+ | isGameOver tetris = pure tetris | otherwise = do update vty $ picForImage $- string defAttr (emboss game) <|> string defAttr (show $ game ^. score)- e <- atomically $ readTBChan chan+ string defAttr (emboss tetris) <|> string defAttr (show $ tetris ^. score)+ e <- atomically $ readTChan chan case e of- Ev (EvKey KEsc []) -> pure $ game ^. score- Tick -> timeStep game >>= play vty chan- Ev (EvKey KLeft []) -> play vty chan (hardDrop game)- Ev (EvKey KUp []) -> play vty chan (shift Left game)- Ev (EvKey KDown []) -> play vty chan (shift Right game)- Ev (EvKey KEnter []) -> play vty chan (rotate game)- _ -> play vty chan game+ Tick -> play vty chan =<< timeStep tetris+ Ev (EvKey KLeft []) -> play vty chan $ hardDrop tetris+ Ev (EvKey KUp []) -> play vty chan $ Left `shift` tetris+ Ev (EvKey KDown []) -> play vty chan $ Right `shift` tetris+ Ev (EvKey KEnter []) -> play vty chan $ rotate tetris+ Ev (EvKey KEsc []) -> pure tetris+ _ -> play vty chan tetris emboss :: Game -> String emboss g = map go [1, 3 .. boardHeight] where@@ -81,6 +78,15 @@ x = minimum $ (boardWidth - 3) : map (\(V2 x _) -> x) (coords $ g ^. block) fullBoard = g ^. board <> blk (g ^. block) blk b = Map.fromList $ map (, b ^. shape) $ coords b++initialDelayOption :: Parser Millisecond+initialDelayOption = option auto $+ long "initial-delay"+ <> short 'i'+ <> metavar "DURATION"+ <> value (fromMicroseconds 1000000)+ <> showDefault+ <> help "Initial delay" versionOption :: Parser (a -> a) versionOption = infoOption (showVersion version) $