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

Cleaning up & improvements

parent b7edcdf3
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_
clean:
rm -f out/* out.mp4
video:
rm -f out/*.png out.mp4
rm -f out/* out.mp4
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:
mpv --loop out.mp4
......@@ -3,11 +3,16 @@ license: Apache-2.0
dependencies:
- base
- relude
- optparse-applicative
- array
- split
- JuicyPixels
- megaparsec
- text
default-extensions:
- NoImplicitPrelude
- RecordWildCards
- LambdaCase
executables:
game-of-life:
......
module Game where
import Relude
import qualified Prelude -- required so we can create Show instances
import Data.Array
import Data.List (intercalate)
import Data.List.Split (divvy)
import Control.Concurrent (threadDelay)
import Control.Monad
import Codec.Picture
{- |
......@@ -72,9 +71,13 @@ boardSize board = (boardWidth board, boardHeight board)
instance (Show Board) where
show board@(Board cells) = intercalate "\n" cellRows where
cellStrings = show <$> elems cells :: [String]
cellStringRows = divvy (boardWidth board) (boardWidth board) cellStrings :: [[String]]
cellStringRows = splitEvery (boardWidth board) cellStrings :: [[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.
data Ruleset = Ruleset
[Int] -- ^ amount of neighbors of an alive cell which will let it survive
......@@ -163,4 +166,4 @@ cellToPixel Alive = PixelRGB8 0 0 0
cellToPixel Dead = PixelRGB8 255 255 255
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
import Relude
import Text.Printf
import Control.Monad
import Text.Megaparsec
import Text.Megaparsec.Error
import qualified Parser
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Array
import Parser (parseBoard)
import Options.Applicative
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 = do
file <- T.readFile "example.gol"
case parse Parser.board "example.gol" file of
Left err -> putStrLn $ errorBundlePretty err
Right board -> do
putStrLn $ printf "Width: %d, Height: %d" (boardWidth board) (boardHeight board)
putStrLn $ "Bounds: " <> show (bounds $ cells board)
print board
putStrLn ""
loop (padBoardAll 18 board) 1
where
loop :: Board -> Int -> IO ()
loop board generation = do
putStrLn $ printf "Generation %04d" generation
print board
saveBoard board (printf "out/%04d.png" generation) 30
putStrLn ""
-- threadDelay 200000
when (generation < 500) $ loop (transition conway board) (generation + 1)
main = run =<< execParser (info (options <**> helper)
( fullDesc
<> progDesc "Simulate Conway's Game of Life"
<> header "A Game of Life implementation in Haskell by Eisfunke"))
run :: Options -> IO ()
run Options{..} = parseBoard file >>= \case
Left err -> putStrLn err
Right board -> do
putStrLn $ printf "Board %s (%dx%d) loaded." file (boardWidth board) (boardHeight board)
putStrLn ""
print board
putStrLn ""
loop (padBoardAll padding board) 1 generations
loop :: Board -> Int -> Int -> IO ()
loop board generation generations = do
-- 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
import Data.Text (Text)
import Relude hiding (many)
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
......@@ -9,7 +10,10 @@ import Game
type Parser = Parsec Void Text
cell :: Parser Cell
cell = Alive <$ char '#' <|> Dead <$ char '_'
cell = choice
[ Alive <$ char '#' <?> "alive cell"
, Dead <$ char '_' <?> "dead cell"
]
cellS :: Parser Cell
cellS = cell <* space
......@@ -25,3 +29,10 @@ board = do
rest <- many cellS
eof
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