Skip to content

Instantly share code, notes, and snippets.

@danbst
Last active October 2, 2015 17:08
Show Gist options
  • Save danbst/2281537 to your computer and use it in GitHub Desktop.
Save danbst/2281537 to your computer and use it in GitHub Desktop.
Console Tetris
ТЕТРІС 0.0.0.12
Реалізація класичного тетріса (з урізаними можливостями), з виводом у консоль.
Урізано: відображення наступної фігури та рахунку
клавіша прискореного падіння фігури
рівні та зміна швидкостей
Код переписано багато разів, з кожним разом він ставав все кращим та кращим.
> {-# LANGUAGE TemplateHaskell #-}
> import Data.List
> import System.Random
> import System.IO
> import System.Info
> import Control.Applicative
> import Control.Monad
> import GHC.Conc
> import Data.Time.Clock
> import Control.Monad.Trans.State.Strict
> import Control.Monad.Trans.Class
> import Control.Lens
БОЙЛЕРПЛЕЙТ
> rotate = reverse . transpose
> matrixSize [] = (0, 0)
> matrixSize m = (length (head m), length m)
> randomItem xs = (xs!!) <$> randomRIO (0, length xs - 1)
РОБОТА З ЧАСОМ
В процесі розробки виявилось, що для роботи з часом потрібні таймери - програмні
структури, що дозволяють відмірювати інтервали часу. Найпростішою такою структурою
виявилась наступна:
> -- | Таймер для відмірювання одного інтервалу
> type Timer = ( Rational -- ^ показник часу на початок відмірювання
> , Rational) -- ^ інтервал відмірювання
> -- | Створити новий таймер
> createTimer :: Rational -- ^ Інтервал часу для таймера
> -> IO Timer
> createTimer interval =
> (\x -> (x, interval)) . toRational . utctDayTime <$> getCurrentTime
В цьому випадку потрібно моніторити різницю поточного часу і першого поля кортежу,
і коли ця різниця стане більшою за друге поле кортежу (інтервал), то значить
відміряли.
> -- | Оновити стан таймера. Друге поле кортежу результату показує,
> -- чи прошов вказаний інтервал часу
> updateTimer :: Timer -> IO (Timer, Bool)
> updateTimer (time, interval) =
> do newTime <- toRational . utctDayTime <$> getCurrentTime
> if (newTime - time) > interval
> then return ((newTime, interval), True)
> else return ((time, interval), False)
РОБОТА З КЛАВІАТУРОЮ
Для управління грою планувалося використати стандартні функції System.IO, але через баг
GHC на Windows платформах воно не запрацювало як хотілося. Тому була написана альтернативна
реалізація, з використанням нативних консольних функцій conio.h
> foreign import ccall unsafe "conio.h getch" c_getch :: IO Char
> foreign import ccall unsafe "conio.h kbhit" c_kbhit :: IO Bool
> getKeyDefault = do hSetEcho stdin False
> oldBufferMode <- hGetBuffering stdin
> hSetBuffering stdin NoBuffering
> ready <- hReady stdin
> let result = if ready then Just <$> getChar
> else return Nothing
> hSetBuffering stdin oldBufferMode
> hSetEcho stdin True
> result
> getKeyWindows = do keypressed <- c_kbhit
> if keypressed then Just <$> c_getch
> else return Nothing
> -- | Повертає натиснену клавішу або Nothing, якщо нічого не було натиснено.
> -- Платформо-залежна функція
> getKey :: IO (Maybe Char)
> getKey = if os == "mingw32" then getKeyWindows else getKeyDefault
ІГРОВА ЛОГІКА
Поле для гри зберігається як [[Char]], що є доволі хорошим приближенням до
прямокутної матриці блоків. В такому ж форматі зберігається і фігура, це дає можливість
задати фігури візуально:
> figures = [ [ "##"
> , "##" ]
>
> , [ "####" ]
>
> , [ "###"
> , "# " ]
>
> , [ "###"
> , " #" ]
>
> , [ "###"
> , " # " ]
>
> , [ " ##"
> , "## " ]
>
> , [ "## "
> , " ##" ]
> ]
> emptyLine w = replicate w ' '
> emptyScreen w h = replicate h (emptyLine w)
Більша частина стану гри зберігається у структурі @World.
> data World = World [[Char]] -- ^ поле гри
> (Maybe ( Int -- ^ координата X фігури
> , Int -- ^ координата Y фігури
> , [[Char]])) -- ^ геометрія фігури
> -- | Об'єднати поле гри та фігуру у матрицю символів
> uniteWith :: (Char -> Char -> Char) -> World -> [[Char]]
> uniteWith f (World screen Nothing) = screen
> uniteWith f (World screen (Just (x, y, fig))) =
> let ((figW, figH), (scrW, scrH)) = both %~ matrixSize $ (fig, screen)
> newFig = concat [ emptyScreen scrW y
> , (emptyLine x ++).(++ emptyLine (scrW - figW)) <$> fig
> , emptyScreen scrW (scrH - figH)
> ]
> in unite' screen newFig
> where unite' = zipWith (zipWith f)
Цікавить, яка це функція йде першим аргументом @uniteWith ? Ось два приклади:
> -- Логічне І над блоками, дозволяє знайти перетин поля гри та фігури
> and' '#' '#' = '#'
> and' _ _ = ' '
> -- Логічне АБО над блоками, довзоляє об'єднати фігіру та поле у єдине поле
> or' ' ' ' ' = ' '
> or' _ _ = '#'
> -- | Поворот фігури проти годинникової
> rotateFigure :: World -> World
> rotateFigure (World screen figure) = World screen ((_3 %~ rotate) <$> figure)
> -- | Переміщення фігури по відносним координатам
> translateFigure :: Int -> Int -> World -> World
> translateFigure dx dy (World screen figure) = World screen ((_1 +~ dx).(_2 +~ dy) <$> figure)
> -- | Вивід поточного світу на консоль.
> showWorld :: World -> IO ()
> showWorld world =
> let screen = uniteWith or' world
> border = replicate (length (head screen)) '*' in
> sequence_ $ putStrLn . ("*" ++).(++ "*") <$> ([border] ++ screen ++ [border])
Щоб взнати, чи може фігура рухатись, потрібно зробити перевірку на перетин, здійснивши
при цьому необхідний рух. Функція @findPossibleMoves вираховує одразу всі можливі варіанти
руху, але, внаслідок лінивості Хаскеля, обчислює їх тільки при необхідності.
> -- | Визначити, які рухи довзолено фігурі в заданій позиції
> findPossibleMoves :: World
> -> ( Bool -- ^ рух вправо
> , Bool -- ^ рух вліво
> , Bool -- ^ рух вниз
> , Bool) -- ^ поворот проти годинникової
> findPossibleMoves (World screen Nothing) = (False, False, False, False)
> findPossibleMoves (World screen (Just (x, y, fig))) =
> let [(figW, figH), (scrW, scrH)] = matrixSize <$> [fig, screen]
> in ( x > 0 && doesNotCollide (x-1, y, fig)
> , x + figW < scrW && doesNotCollide (x+1, y, fig)
> , y + figH < scrH && doesNotCollide (x, y+1, fig)
> , x + figH <= scrW && y + figW <= scrH && doesNotCollide (x, y, rotate fig)
> )
> where doesNotCollide = all (== ' ') . join . uniteWith and' . World screen . Just
> -- | Об'єднує поле з фігурою та викидує заповнені рядки.
> removeFilledLines :: World
> -> ( [[Char]] -- ^ об'єднане з фігурою поле гри
> , Int) -- ^ кількість заповнених та видалених рядків
> removeFilledLines world =
> let screen = uniteWith or' world
> (scrW, scrH) = matrixSize screen
> filtered = filter (any (== ' ')) screen
> in ( emptyScreen scrW (scrH - length filtered) ++ filtered
> , scrH - length filtered
> )
ВЛАСНЕ ГРА
> data GameState = GameState
> { _getWorld :: World
> , _getTimer :: Timer
> }
> makeLenses ''GameState
> --modifyWorld f (GameState w t) = GameState (f w) t
> --modifyTimer f (GameState w t) = GameState w (f t)
> modifyWorld f gameState = getWorld %~ f
> modifyTimer f gameState = getTimer %~ f
> putWorld w (GameState _ t) = GameState w t
> putTimer t (GameState w _) = GameState w t
> getTimer' = gets getTimer
> getWorld' = gets getWorld
> putTimer' = modify . putTimer
> putWorld' = modify . putWorld
> modifyWorld' = modify . modifyWorld
> updateTimer' :: StateT GameState IO Bool
> updateTimer' = do
> (newFigureFallTimer, isFigureFallTime) <- lift . updateTimer =<< getTimer'
> putTimer' newFigureFallTimer
> return isFigureFallTime
> gameLoop :: Int -> StateT GameState IO Int
> gameLoop score = do
> lift $ threadDelay 10000
> isFigureFallTime <- updateTimer'
> key <- lift getKey
> let [userLeft, userRight, userRotate, userQuit] = (key ==) . Just <$> ['h', 'l', ' ', 'q']
> (moveL, moveR, moveD, canRotate) <- findPossibleMoves <$> getWorld'
> let horShift | userLeft && moveL = (-1)
> | userRight && moveR = 1
> | otherwise = 0
> downShift = fromEnum . (isFigureFallTime &&)
> (figureNotReachedBottom, isWorldUpdated) <- do
> if userRotate && canRotate
> then do modifyWorld' $ translateFigure 0 (downShift moveD) . rotateFigure
> return (moveD, True)
> else do (_, _, moveD2, _) <- findPossibleMoves . translateFigure horShift 0 <$> getWorld'
> modifyWorld' $ translateFigure horShift (downShift moveD2)
> return (moveD2, horShift /= 0 || downShift moveD2 /= 0)
> (newScore, newRoundStarted) <- do
> if figureNotReachedBottom
> then return (score, False)
> else do (updatedField, linesRemoved) <- removeFilledLines <$> getWorld'
> randomFigure <- lift $ randomItem figures
> putWorld' $ World updatedField (Just (4, 0, randomFigure))
> return (score + linesRemoved, True)
> let isWorldFilled = any (/= ' ') . head . uniteWith and'
> isGameOver <- isWorldFilled <$> getWorld'
> when (isWorldUpdated || newRoundStarted) $ lift . showWorld =<< getWorld'
> if userQuit || isGameOver
> then return newScore
> else gameLoop newScore
> main = do timer <- createTimer 1
> score <- evalStateT (gameLoop 0) (GameState (World (emptyScreen 10 12) Nothing) timer)
> putStrLn ("Your score - " ++ (show score))
@danbst
Copy link
Author

danbst commented Apr 2, 2012

Якщо хтось хоче запустити програму, поставте ghc, потім запустіть ghci

$ghci Prelude> :l path/to/file.lhs
$ghci *Main> main

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment