Commit b41bef59 authored by Nicolas Lenz's avatar Nicolas Lenz
Browse files

Cleaning up & improvements

parent b7edcdf3
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
clean:
rm -f out/* out.mp4
video: video:
rm -f out/*.png out.mp4 rm -f out/* out.mp4
stack run stack run
ffmpeg -framerate 12 -i out/%04d.png out.mp4 ffmpeg -framerate 12 -i out/%04d.bmp -vf scale=1680:-1 -sws_flags neighbor out.mp4
play: play:
mpv --loop out.mp4 mpv --loop out.mp4
...@@ -3,11 +3,16 @@ license: Apache-2.0 ...@@ -3,11 +3,16 @@ license: Apache-2.0
dependencies: dependencies:
- base - base
- relude
- optparse-applicative
- array - array
- split
- JuicyPixels - JuicyPixels
- megaparsec - megaparsec
- text
default-extensions:
- NoImplicitPrelude
- RecordWildCards
- LambdaCase
executables: executables:
game-of-life: game-of-life:
......
module Game where module Game where
import Relude
import qualified Prelude -- required so we can create Show instances
import Data.Array import Data.Array
import Data.List (intercalate)
import Data.List.Split (divvy)
import Control.Concurrent (threadDelay)
import Control.Monad
import Codec.Picture import Codec.Picture
{- | {- |
...@@ -72,9 +71,13 @@ boardSize board = (boardWidth board, boardHeight board) ...@@ -72,9 +71,13 @@ boardSize board = (boardWidth board, boardHeight board)
instance (Show Board) where instance (Show Board) where
show board@(Board cells) = intercalate "\n" cellRows where show board@(Board cells) = intercalate "\n" cellRows where
cellStrings = show <$> elems cells :: [String] cellStrings = show <$> elems cells :: [String]
cellStringRows = divvy (boardWidth board) (boardWidth board) cellStrings :: [[String]] cellStringRows = splitEvery (boardWidth board) cellStrings :: [[String]]
cellRows = concat <$> cellStringRows :: [String] cellRows = concat <$> cellStringRows :: [String]
splitEvery :: Int -> [a] -> [[a]]
splitEvery n [] = []
splitEvery n list = let (part, rest) = splitAt n list in part : splitEvery n rest
-- | A ruleset for a game of life world. -- | A ruleset for a game of life world.
data Ruleset = Ruleset data Ruleset = Ruleset
[Int] -- ^ amount of neighbors of an alive cell which will let it survive [Int] -- ^ amount of neighbors of an alive cell which will let it survive
...@@ -163,4 +166,4 @@ cellToPixel Alive = PixelRGB8 0 0 0 ...@@ -163,4 +166,4 @@ cellToPixel Alive = PixelRGB8 0 0 0
cellToPixel Dead = PixelRGB8 255 255 255 cellToPixel Dead = PixelRGB8 255 255 255
saveBoard :: Board -> String -> Int -> IO () saveBoard :: Board -> String -> Int -> IO ()
saveBoard board path magnification = writePng path (boardToImage board magnification) saveBoard board path magnification = writeBitmap path (boardToImage board magnification)
module Main where module Main where
import Relude
import Text.Printf import Text.Printf
import Control.Monad import Control.Monad
import Text.Megaparsec import Parser (parseBoard)
import Text.Megaparsec.Error import Options.Applicative
import qualified Parser
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Array
import Game import Game
data Options = Options
{ padding :: Int
, generations :: Int
, file :: String}
options :: Parser Options
options = Options
<$> option auto
( metavar "PADDING"
<> help "Number of fields with dead cells to pad the board with on each side"
<> showDefault
<> value 0
<> short 'p'
<> long "padding")
<*> option auto
( metavar "GENERATIONS"
<> help "Number of generations to simulate"
<> showDefault
<> value 1000
<> short 'n'
<> long "generations")
<*> strArgument (metavar "FILE" <> help "Board file to load")
main :: IO () main :: IO ()
main = do main = run =<< execParser (info (options <**> helper)
file <- T.readFile "example.gol" ( fullDesc
case parse Parser.board "example.gol" file of <> progDesc "Simulate Conway's Game of Life"
Left err -> putStrLn $ errorBundlePretty err <> header "A Game of Life implementation in Haskell by Eisfunke"))
Right board -> do
putStrLn $ printf "Width: %d, Height: %d" (boardWidth board) (boardHeight board)
putStrLn $ "Bounds: " <> show (bounds $ cells board) run :: Options -> IO ()
print board run Options{..} = parseBoard file >>= \case
putStrLn "" Left err -> putStrLn err
loop (padBoardAll 18 board) 1 Right board -> do
where putStrLn $ printf "Board %s (%dx%d) loaded." file (boardWidth board) (boardHeight board)
loop :: Board -> Int -> IO () putStrLn ""
loop board generation = do print board
putStrLn $ printf "Generation %04d" generation putStrLn ""
print board loop (padBoardAll padding board) 1 generations
saveBoard board (printf "out/%04d.png" generation) 30
putStrLn "" loop :: Board -> Int -> Int -> IO ()
-- threadDelay 200000 loop board generation generations = do
when (generation < 500) $ loop (transition conway board) (generation + 1) -- print board
saveBoard board (printf "out/%04d.bmp" generation) 1
-- putStrLn ""
-- threadDelay 200000
when (generation `mod` 50 == 0) $ putStrLn $ printf "Generation %4d processed" generation
when (generation < generations) $ loop (transition conway board) (generation + 1) generations
module Parser where module Parser where
import Data.Text (Text) import Relude hiding (many)
import Data.Void import Data.Void
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
...@@ -9,7 +10,10 @@ import Game ...@@ -9,7 +10,10 @@ import Game
type Parser = Parsec Void Text type Parser = Parsec Void Text
cell :: Parser Cell cell :: Parser Cell
cell = Alive <$ char '#' <|> Dead <$ char '_' cell = choice
[ Alive <$ char '#' <?> "alive cell"
, Dead <$ char '_' <?> "dead cell"
]
cellS :: Parser Cell cellS :: Parser Cell
cellS = cell <* space cellS = cell <* space
...@@ -25,3 +29,10 @@ board = do ...@@ -25,3 +29,10 @@ board = do
rest <- many cellS rest <- many cellS
eof eof
return $ boardFromList (length firstLine) (firstLine ++ rest) return $ boardFromList (length firstLine) (firstLine ++ rest)
parseBoard :: String -> IO (Either String Board)
parseBoard file = do
result <- readFileText file
return $ case parse board file result of
Left err -> Left $ errorBundlePretty err
Right board -> Right $ board
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment