packages feed

betris 0.2.0.0 → 0.2.1.0

raw patch · 4 files changed

+51/−24 lines, 4 filesdep ~basedep ~lensdep ~linearPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, lens, linear, optparse-applicative, vty

API changes (from Hackage documentation)

+ Game.Tetris: class Translatable s
+ Game.Tetris: initBlock :: Tetrimino -> Block
+ Game.Tetris: nextShape :: Lens' Game Tetrimino
+ Game.Tetris: origin :: Lens' Block Coord
+ Game.Tetris: translate :: Translatable s => Direction -> s -> s
+ Game.Tetris: translateBy :: Translatable s => Int -> Direction -> s -> s

Files

README.md view
@@ -1,4 +1,26 @@ # betris -A horizontal version of tetris for braille display users.+A tetris-clone for braille display users.++## How does it work++Every block is a dot.  And the game has been flipped 90 degrees,+so you are playing from right to left instead of top to bottom.++The size of the playing field is identical to the+original game.  Since a braille character is 4 dots+in height, the player needs to scroll up/down to see+the full field of 10 blocks.+There is no need to interact with a screen reader.+Moving the current tetrimino around will also move the+currently visible area.  The tetrimino is always aligned+at the top of the display, except for the last column.++## Demo++This game can be played online.++```console+$ ssh betris@blind.guru+``` 
betris.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 507e72cc3846b3370a9756e6fefd69c3d026964cef52a4f2ea2a2ced50975744+-- hash: c88ccbaf751536b4da160882aefe63b89cda6e9c7ea3ecb6837eadf5ec8a8453  name:           betris-version:        0.2.0.0+version:        0.2.1.0 synopsis:       A horizontal version of tetris for braille users 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@@ -15,7 +15,7 @@ bug-reports:    https://github.com/mlang/betris/issues author:         Mario Lang maintainer:     mlang@blind.guru-copyright:      2018 Mario Lang+copyright:      2020 Mario Lang license:        BSD3 license-file:   LICENSE tested-with:    GHC == 8.0.1, GHC == 8.4.3@@ -38,15 +38,15 @@   ghc-options: -Wall   build-depends:       ansi-terminal-    , base >=4.9.0 && <4.13+    , base >=4.9.0 && <4.15     , containers >=0.5.7 && <0.7-    , lens >=4.15.4 && <4.18-    , linear >=1.20.7 && <1.21-    , optparse-applicative >=0.14.2 && <0.15+    , lens >=4.15.4 && <4.20+    , linear >=1.20.7 && <1.22+    , optparse-applicative >=0.14.2 && <0.16     , random >=1.1 && <1.2     , stm >=2.4.5 && <2.6     , time-units >=1.0.0 && <1.1-    , vty >=5.21 && <5.26+    , vty >=5.21 && <5.33   default-language: Haskell2010  executable betris@@ -58,14 +58,14 @@   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       ansi-terminal-    , base >=4.9.0 && <4.13+    , base >=4.9.0 && <4.15     , betris     , containers >=0.5.7 && <0.7-    , lens >=4.15.4 && <4.18-    , linear >=1.20.7 && <1.21-    , optparse-applicative >=0.14.2 && <0.15+    , lens >=4.15.4 && <4.20+    , linear >=1.20.7 && <1.22+    , optparse-applicative >=0.14.2 && <0.16     , random >=1.1 && <1.2     , stm >=2.4.5 && <2.6     , time-units >=1.0.0 && <1.1-    , vty >=5.21 && <5.26+    , vty >=5.21 && <5.33   default-language: Haskell2010
src/Command/Betris.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE RecordWildCards #-} module Command.Betris (command, Options(..), betris) where +import Prelude hiding (Left, Right) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM.TChan import Control.Lens hiding (argument)@@ -13,7 +14,6 @@ import Data.Char (chr) import Data.IORef import qualified Data.Map as Map-import Data.Semigroup ((<>)) import Data.Time.Units import Data.Version (showVersion) import Game.Tetris@@ -42,13 +42,13 @@   input <- inputForConfig =<< userConfig   chan <- newTChanIO   game <- initGame 0-  speed <- newIORef $ fromIntegral $ toMicroseconds initialDelay+  delay <- newIORef $ fromIntegral $ toMicroseconds initialDelay    _ <- forkIO . forever . atomically $     readTChan (_eventChannel input) >>= writeTChan chan . Ev   _ <- forkIO $ forever $ do-    readIORef speed >>= threadDelay-    modifyIORef speed (subtract 500)+    readIORef delay >>= threadDelay+    modifyIORef delay (subtract 100)     atomically $ writeTChan chan Tick    _ <- play chan game@@ -66,6 +66,7 @@     hFlush stdout     atomically (readTChan chan) >>= \case       Tick                 -> play chan =<< timeStep tetris+      Ev (EvKey (KChar ' ') []) -> play chan =<< timeStep tetris       Ev (EvKey KLeft [])  -> play chan $ hardDrop tetris       Ev (EvKey KUp [])    -> play chan $ Left `shift` tetris       Ev (EvKey KDown [])  -> play chan $ Right `shift` tetris@@ -74,15 +75,18 @@       _                    -> play chan tetris  emboss :: Game -> String-emboss game = map go [1, 3 .. boardHeight] where+emboss game = map go [1, 3 .. boardHeight + 6] 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)]   f y ((x',y'), v) a = case Map.lookup (V2 (x+x') (y+y')) fullBoard of     Just _ -> a + v     _ -> a-  x = minimum $ (boardWidth - 3) : map (^. _x) (coords $ game ^. block)-  fullBoard = game ^. board <> blk (game ^. block)+  minx b = minimum $ (boardWidth - 3) : map (^. _x) (coords b)+  x = minx (game ^. block)+  fullBoard = game ^. board <> blk (game ^. block) <> blk next+  next = let b = initBlock (game ^. nextShape) in+         translateBy (-4) Down $ translateBy (x - minx b) Right b   blk b = Map.fromList $ map (, b ^. shape) $ coords b  initialDelayOption :: Parser Millisecond@@ -90,7 +94,7 @@     long "initial-delay"  <> short 'i'  <> metavar "DURATION"- <> value (fromMicroseconds 1000000)+ <> value (fromMicroseconds 1500000)  <> showDefault  <> help "Initial delay" 
src/Game/Tetris.hs view
@@ -17,7 +17,8 @@ , boardWidth, boardHeight , initGame, isGameOver , timeStep, rotate, shift, hardDrop-, board, shape, score, block, coords+, Translatable(..)+, board, shape, origin, score, block, coords, nextShape, initBlock ) where  import Control.Lens hiding ((:<), (<|), (|>), (:>))