Skip to content

Commit 0a3fc3b

Browse files
CozyDoomerCozyDoomer
committed
improve code and add example gif
1 parent c53608a commit 0a3fc3b

12 files changed

+196
-81
lines changed

‎.gitignore

100644100755
File mode changed.

‎LICENSE

100644100755
File mode changed.

‎README.md

100644100755
+13-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,15 @@
11
# Game of Life Haskell
22

3-
still very unefficient implementation of [Conway's Game of Life](https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life) in Haskell
3+
Still very unefficient implementation of [Conway's Game of Life](https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life) in Haskell.
4+
5+
# Setup
6+
7+
execute:
8+
9+
`stack build`
10+
11+
then
12+
13+
`stack run`
14+
15+
![](example.gif)

‎app/Main.hs

100644100755
+43-14
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,55 @@
11
module Main where
22

33
import Lib
4-
import Control.Concurrent
4+
import Graphics
55

6+
import Control.Concurrent
67
import Data.Array
8+
import Graphics.Gloss
9+
import Graphics.Gloss.Data.Color()
710

811
{-
12+
ASCII version (laggy)
13+
--------------
914
clear screen
10-
show board
11-
wait for 0.5 seconds
15+
show board in terminal
16+
wait for 0.25 seconds
1217
recursive call with updated board
1318
-}
14-
gameOfLife :: Board -> IO ()
15-
gameOfLife b = if not $ isBoardEmpty b then
16-
do clearScreen
17-
displayBoard b
18-
threadDelay 500000
19-
gameOfLife $ updateBoard b
20-
else
21-
do clearScreen
22-
putStr "Done.\n"
19+
asciiGoL :: Board -> IO ()
20+
asciiGoL b
21+
| not $ isBoardEmpty b =
22+
do clearScreen
23+
displayBoard b
24+
threadDelay 250000
25+
asciiGoL $ updateBoard b
26+
| otherwise =
27+
do clearScreen
28+
putStr "Done.\n"
29+
30+
{-
31+
graphic version
32+
---------------
33+
basically let `gloss` deal with it :)
34+
35+
`visualize` creates a square (type `Picture`) for each cell
36+
this is passed to `simulate`
37+
creates a window
38+
displays the boardstate
39+
updates 4 times per second by calling `updateBoard`
40+
-}
41+
42+
bgColor :: Color
43+
bgColor = makeColor 255 255 255 255
44+
45+
window :: Display
46+
window = InWindow "Game of Life" (1920, 1080) (0, 0)
47+
48+
graphicGoL :: Board -> IO ()
49+
graphicGoL board = simulate window bgColor 4 board visualize (\_ _ -> updateBoard)
2350

2451
main :: IO()
25-
main = do board <- createBoard "examples/blinker_block.txt"
26-
gameOfLife board
52+
main = do board <- createBoard "examples/rpentomino_predecessor_big.txt"
53+
-- putStrLn $ show board
54+
-- asciiGoL board
55+
graphicGoL board

‎example.gif

170 KB
Loading

‎examples/blinker_block.txt

100644100755
File mode changed.

‎examples/rpentomino_predecessor.txt

100644100755
+29-29
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,30 @@
1-
2-
3-
4-
5-
6-
7-
8-
O
9-
10-
OOO OO
11-
12-
13-
14-
15-
16-
17-
18-
19-
20-
21-
22-
23-
24-
25-
26-
27-
28-
29-
1+
2+
3+
4+
5+
6+
7+
8+
O
9+
10+
OOO OO
11+
12+
13+
14+
15+
16+
17+
18+
19+
20+
21+
22+
23+
24+
25+
26+
27+
28+
29+
3030

‎examples/rpentomino_predecessor_big.txt

+60
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
2+
3+
4+
5+
6+
7+
8+
9+
10+
11+
12+
13+
14+
15+
16+
17+
18+
19+
20+
21+
22+
23+
O
24+
25+
OOO OO
26+
27+
28+
29+
30+
31+
32+
33+
34+
35+
36+
37+
38+
39+
40+
41+
42+
43+
44+
45+
46+
47+
48+
49+
50+
51+
52+
53+
54+
55+
56+
57+
58+
59+
60+

‎package.yaml

100644100755
+2-14
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,20 @@
11
name: game-of-life
22
version: 0.2.1.0
33
github: "cozyDoomer/game-of-life-haskell"
4-
license: "GPLv3"
4+
license: "GPL-3"
55
author: "Christian Unterrainer"
66
maintainer: "chr.unterrainer@gmail.com"
77
copyright: "2020 Christian Unterrainer"
88

99
extra-source-files:
1010
- README.md
11-
- ChangeLog.md
1211

1312
description: Please see the README on GitHub at https://github.com/cozyDoomer/game-of-life-haskell/blob/master/README.md
1413

1514
dependencies:
1615
- base >= 4.7 && < 5
1716
- array
18-
- polyparse
17+
- gloss
1918

2019
library:
2120
source-dirs: src
@@ -30,14 +29,3 @@ executables:
3029
- -with-rtsopts=-N
3130
dependencies:
3231
- game-of-life
33-
34-
tests:
35-
game-of-life-test:
36-
main: Spec.hs
37-
source-dirs: test
38-
ghc-options:
39-
- -threaded
40-
- -rtsopts
41-
- -with-rtsopts=-N
42-
dependencies:
43-
- game-of-life

‎src/Graphics.hs

+26
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
module Graphics where
2+
3+
import Lib
4+
5+
import Graphics.Gloss
6+
import Data.Array
7+
8+
squareSize :: Num a => a
9+
squareSize = 25
10+
11+
visualize :: Board -> Picture
12+
visualize b =
13+
Pictures
14+
[ Color color sq | (x, y) <- indices boardArray,
15+
let xv = width + (x * 30)
16+
yv = height - (y * 30)
17+
sq = square (fromIntegral xv) (fromIntegral yv)
18+
color = if boardArray ! (y, x) == "O" then black else white
19+
]
20+
where boardArray = unpack b
21+
width = fst . snd $ bounds boardArray
22+
height = snd . snd $ bounds boardArray
23+
24+
square :: Float -> Float -> Picture
25+
square x y = Polygon [(x, y), (x + s, y), (x + s, y + s), (x, y + s)]
26+
where s = squareSize

‎src/Lib.hs

100644100755
+23-23
Original file line numberDiff line numberDiff line change
@@ -5,12 +5,6 @@ import Data.Array
55
-- Board type using Data.Array with custom Show typeclass
66
newtype Board = B (Array (Int, Int) String)
77

8-
instance Show Board where
9-
show (B b) = showRows b 0
10-
11-
unpack :: Board -> Array (Int, Int) String
12-
unpack (B b) = b
13-
148
showRows :: Array (Int, Int) String -> Int -> String
159
showRows r i -- tail recursion
1610
| i < maxRow = "|" ++ rowStr ++ "|\n" ++ showRows r (i+1)
@@ -19,13 +13,19 @@ showRows r i -- tail recursion
1913
maxCol = snd . snd $ bounds r
2014
rowStr = concat [ r ! (i, j) ++ " " | j <- [0 .. maxCol] ]
2115

16+
instance Show Board where
17+
show (B b) = showRows b 0
18+
19+
unpack :: Board -> Array (Int, Int) String
20+
unpack (B b) = b
21+
2222
createBoard :: String -> IO Board
23-
createBoard s = do fileString <- readFile s
24-
-- TODO: read line wise
25-
let height = (length $ filter (== '\n') fileString) + 1
26-
let fileList = fmap (\x -> [x]) (filter (/= '\n') fileString)
27-
let width = length fileList `div` height
28-
pure $ B (listArray ((0, 0), (width-1, height-1)) fileList)
23+
createBoard s =
24+
do fileString <- readFile s
25+
let height = (length $ filter (== '\n') fileString) + 1
26+
let fileList = fmap (\x -> [x]) (filter (/= '\n') fileString)
27+
let width = length fileList `div` height
28+
pure $ B (listArray ((0, 0), (width-1, height-1)) fileList)
2929

3030
-- command line related
3131
clearScreen :: IO ()
@@ -36,31 +36,31 @@ displayBoard b = putStr $ show b
3636

3737
-- count living neighbors; when out of bounds continue on the other side of the board
3838
countNeighbors :: (Int, Int) -> Board -> Int
39-
countNeighbors p b = length . filter (== "O") . map (\i -> boardArray ! i) $ map (handleOverflow (width, height)) neighborIndices
39+
countNeighbors p b =
40+
length . filter (== "O") $ map (\i -> boardArray ! i) neighborIndices
4041
where boardArray = unpack b
4142
width = fst . snd $ bounds boardArray
4243
height = snd . snd $ bounds boardArray
4344
neighborIndices = [ (i, j) | i <- [fst p + 1, fst p, fst p - 1],
4445
j <- [snd p + 1, snd p, snd p - 1],
45-
i /= fst p || j /= snd p]
46-
47-
handleOverflow :: (Int, Int) -> (Int, Int) -> (Int, Int)
48-
handleOverflow (width, height) (i,j) = (i `mod` width,
49-
j `mod` height)
46+
(i /= fst p || j /= snd p) &&
47+
(i > 0 && i < width && j > 0 && j < height)]
5048

5149
-- game of life logic for each cell: https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life#Rules
5250
nextCellValue :: (Int, Int) -> Board -> String
5351
nextCellValue (i,j) b
54-
| boardArray ! (i,j) == "O" && (neighborCount > 3 || neighborCount < 2) = " "
55-
| boardArray ! (i,j) == " " && neighborCount == 3 = "O"
56-
| otherwise = boardArray ! (i,j)
52+
| boardArray ! (i, j) == "O" && (neighborCount > 3 || neighborCount < 2) = " "
53+
| boardArray ! (i, j) == " " && neighborCount == 3 = "O"
54+
| otherwise = boardArray ! (i, j)
5755
where boardArray = unpack b
5856
neighborCount = countNeighbors (i, j) b
5957

6058
updateBoard :: Board -> Board
61-
updateBoard b = B (boardArray // [(i, nextCellValue i b) | i <- indices boardArray])
59+
updateBoard b =
60+
B (boardArray // [(i, nextCellValue i b) | i <- indices boardArray])
6261
where boardArray = unpack b
6362

6463
isBoardEmpty :: Board -> Bool
65-
isBoardEmpty b = not $ or [value == "O" | value <- elems boardArray]
64+
isBoardEmpty b =
65+
not $ or [value == "O" | value <- elems boardArray]
6666
where boardArray = unpack b

‎stack.yaml

100644100755
File mode changed.

0 commit comments

Comments
 (0)