aadit/tetris-cli
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix bug in hard drop

Browse source
This commit is contained in:
Sam Tay 2017-06-18 17:53:42 -04:00
parent 47f6f40267
commit 6b24b54cb5
1 changed files with 3 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/Tetris.hs
View file

@ -18,10 +18,9 @@ import Data.Maybe (fromMaybe)
import Data.Monoid (First(..)) import Data.Monoid (First(..))
-- TODO -- TODO
-- 0. BUG in hard drop - if block is under an overhang then it gets sent above
-- 1. leaderboard saved to txt file (requires adding viewport for name entry) -- 1. leaderboard saved to txt file (requires adding viewport for name entry)
-- and probably wrapping game in a ui state -- and probably wrapping game in a ui state
-- 3. USE linear V2 instead of tuples.. dummy -- 2. USE linear V2 instead of tuples.. dummy
-- 3. Consider refactoring (Game -> a) with State or Reader abstraction -- 3. Consider refactoring (Game -> a) with State or Reader abstraction
-- 4. README with gif -- 4. README with gif
-- 5. release binaries for darwin and linux -- 5. release binaries for darwin and linux
@ -231,11 +230,9 @@ hardDrop g = g & block .~ hardDroppedBlock g
hardDroppedBlock :: Game -> Block hardDroppedBlock :: Game -> Block
hardDroppedBlock g = translateBy n Down $ g ^. block hardDroppedBlock g = translateBy n Down $ g ^. block
where n = minimum $ (subtract 1) <$> (minY : diffs) where n = minimum $ (subtract 1) <$> (minY : diffs)
diffs = [y - yo | (xo,yo) <- brdCs, (x,y) <- blkCs, xo == x] diffs = [y - yo | (xo,yo) <- brdCs, (x,y) <- blkCs, xo == x, yo < y]
brdCs = M.keys $ M.filterWithKey inCols $ g ^. board brdCs = g ^. board ^. to M.keys
blkCs = g ^. block ^. to coords blkCs = g ^. block ^. to coords
inCols (x,_) _ = x `elem` cols
cols = fst <$> blkCs
minY = minimum (snd <$> blkCs) minY = minimum (snd <$> blkCs)
-- | Freeze current block -- | Freeze current block