game of life works now
This commit is contained in:
nek0
parent
93140bd713
commit
e83a36910a
3 changed files with 134 additions and 68 deletions
|
|
@ -148,5 +148,6 @@ executable example01
|
|||
, linear
|
||||
, matrix
|
||||
, nanovg
|
||||
, deepseq
|
||||
else
|
||||
buildable: False
|
||||
|
|
|
|||
|
|
@ -3,18 +3,23 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
import Affection as A
|
||||
import SDL (($=))
|
||||
import qualified SDL
|
||||
import qualified Graphics.Rendering.OpenGL as GL
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad (when)
|
||||
import Control.DeepSeq (deepseq)
|
||||
|
||||
import Data.Matrix as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import System.Random (randomRIO)
|
||||
|
||||
import NanoVG
|
||||
import NanoVG hiding (V2(..))
|
||||
|
||||
import Linear
|
||||
|
||||
import Foreign.C.Types (CInt(..))
|
||||
|
||||
|
|
@ -30,12 +35,13 @@ main = do
|
|||
logIO A.Debug "Starting"
|
||||
let conf = AffectionConfig
|
||||
{ initComponents = All
|
||||
, windowTitle = "affection: example00"
|
||||
, windowTitle = "affection: example01"
|
||||
, windowConfig = SDL.defaultWindow
|
||||
{ SDL.windowOpenGL = Just SDL.defaultOpenGL
|
||||
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
|
||||
}
|
||||
, SDL.windowInitialSize = SDL.V2 600 600
|
||||
, SDL.windowResizable = True
|
||||
}
|
||||
, initScreenMode = SDL.Windowed
|
||||
, canvasSize = Nothing
|
||||
|
|
@ -66,7 +72,10 @@ load = do
|
|||
(Window empty1)
|
||||
(Keyboard empty3)
|
||||
, lifeMat = fullMatrix
|
||||
, foodMat = fromList 60 60 (repeat 10)
|
||||
, timeMat = M.zero 60 60
|
||||
, nano = nanoCtx
|
||||
, lastUpdate = 0
|
||||
}
|
||||
|
||||
pre :: Affection UserData ()
|
||||
|
|
@ -74,8 +83,13 @@ pre = do
|
|||
sd <- getAffection
|
||||
_ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc
|
||||
_ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR
|
||||
_ <- partSubscribe (subKeyboard $ subsystems sd) showFPS
|
||||
_ <- partSubscribe (subWindow $ subsystems sd) exitOnWindowClose
|
||||
return ()
|
||||
_ <- partSubscribe (subWindow $ subsystems sd) windowResize
|
||||
now <- getElapsedTime
|
||||
putAffection sd
|
||||
{ lastUpdate = floor now
|
||||
}
|
||||
|
||||
exitOnEsc :: KeyboardMessage -> Affection UserData ()
|
||||
exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
|
||||
|
|
@ -88,14 +102,28 @@ exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
|
|||
reloadOnR :: KeyboardMessage -> Affection UserData ()
|
||||
reloadOnR (MsgKeyboardEvent _ _ _ _ sym) =
|
||||
case SDL.keysymKeycode sym of
|
||||
SDL.KeycodeR -> do
|
||||
SDL.KeycodeR -> reload
|
||||
_ -> return ()
|
||||
|
||||
reload :: Affection UserData ()
|
||||
reload = do
|
||||
ud <- getAffection
|
||||
now <- getElapsedTime
|
||||
randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599]
|
||||
let fullMatrix = fromList 60 60 randList
|
||||
nState <- liftIO $ load
|
||||
putAffection ud
|
||||
{ lifeMat = fullMatrix
|
||||
, foodMat = fromList 60 60 (repeat 10)
|
||||
, timeMat = M.zero 60 60
|
||||
, lastUpdate = floor now
|
||||
}
|
||||
|
||||
showFPS :: KeyboardMessage -> Affection UserData ()
|
||||
showFPS (MsgKeyboardEvent _ _ _ _ sym) =
|
||||
case SDL.keysymKeycode sym of
|
||||
SDL.KeycodeF -> do
|
||||
dt <- getDelta
|
||||
liftIO $ logIO A.Debug $ "FPS: " ++ show (1 / dt)
|
||||
_ -> return ()
|
||||
|
||||
exitOnWindowClose :: WindowMessage -> Affection UserData ()
|
||||
|
|
@ -106,6 +134,15 @@ exitOnWindowClose wm =
|
|||
quit
|
||||
_ -> return ()
|
||||
|
||||
windowResize :: WindowMessage -> Affection UserData ()
|
||||
windowResize msg = case msg of
|
||||
(MsgWindowResize _ _ (V2 w h)) -> do
|
||||
liftIO $ logIO A.Debug "Window resized"
|
||||
let nw = floor (fromIntegral h)
|
||||
dw = floor ((fromIntegral w - fromIntegral nw) / 2)
|
||||
GL.viewport $= (GL.Position dw 0, GL.Size nw h)
|
||||
_ -> return ()
|
||||
|
||||
handle :: [SDL.EventPayload] -> Affection UserData ()
|
||||
handle es = do
|
||||
(Subsystems a b) <- subsystems <$> getAffection
|
||||
|
|
@ -115,64 +152,89 @@ handle es = do
|
|||
update :: Double -> Affection UserData ()
|
||||
update _ = do
|
||||
ud <- getAffection
|
||||
-- when (lastUpdate ud < floor now) $ do
|
||||
liftIO $ logIO A.Debug "stepping life"
|
||||
-- now <- getElapsedTime
|
||||
when (True) $ do
|
||||
newList <- mapM (\coord -> do
|
||||
let x = (coord `div` 60) + 1
|
||||
y = (coord `mod` 60) + 1
|
||||
let x = (coord `mod` 60) + 1
|
||||
y = (coord `div` 60) + 1
|
||||
subm
|
||||
| x == 1 && y == 1 =
|
||||
(submatrix 60 60 60 60 (lifeMat ud) <-> submatrix 1 2 60 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix 60 60 1 2 (lifeMat ud) <-> submatrix 1 2 1 2 (lifeMat ud))
|
||||
(submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud))
|
||||
| x == 1 && y == 60 =
|
||||
(submatrix 60 60 59 60 (lifeMat ud) <-> submatrix 1 2 59 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix 60 60 1 1 (lifeMat ud) <-> submatrix 1 2 1 1 (lifeMat ud))
|
||||
(submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud))
|
||||
| x == 60 && y == 1 =
|
||||
(submatrix 59 60 60 60 (lifeMat ud) <-> submatrix 1 1 60 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix 59 60 1 2 (lifeMat ud) <-> submatrix 1 1 1 2 (lifeMat ud))
|
||||
(submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 2 59 60 (lifeMat ud) <|> submatrix 1 2 1 1 (lifeMat ud))
|
||||
| x == 60 && y == 60 =
|
||||
(submatrix 59 60 59 60 (lifeMat ud) <-> submatrix 1 1 59 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix 59 60 1 1 (lifeMat ud) <-> submatrix 1 1 1 1 (lifeMat ud))
|
||||
(submatrix 59 60 59 60 (lifeMat ud) <|> submatrix 59 60 1 1 (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud))
|
||||
| x == 1 =
|
||||
(submatrix 60 60 (y - 1) (y + 1) (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 2 (y - 1) (y + 1) (lifeMat ud))
|
||||
(submatrix (y - 1) (y + 1) 60 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix (y - 1) (y + 1) 1 2 (lifeMat ud))
|
||||
| y == 1 =
|
||||
(submatrix (x - 1) (x + 1) 60 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix (x - 1) (x + 1) 1 2 (lifeMat ud))
|
||||
| x == 60 =
|
||||
(submatrix 1 1 (y - 1) (y + 1) (lifeMat ud))
|
||||
(submatrix 60 60 (x - 1) (x + 1) (lifeMat ud))
|
||||
<->
|
||||
(submatrix 59 60 (y - 1) (y + 1) (lifeMat ud))
|
||||
| y == 60 =
|
||||
(submatrix (x - 1) (x + 1) 1 1 (lifeMat ud))
|
||||
(submatrix 1 2 (x - 1) (x + 1) (lifeMat ud))
|
||||
| x == 60 =
|
||||
(submatrix (y - 1) (y + 1) 59 60 (lifeMat ud))
|
||||
<|>
|
||||
(submatrix (x -1 ) (x + 1) 59 60 (lifeMat ud))
|
||||
(submatrix (y - 1) (y + 1) 1 1 (lifeMat ud))
|
||||
| y == 60 =
|
||||
(submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud))
|
||||
<->
|
||||
(submatrix 1 1 (x - 1) (x + 1) (lifeMat ud))
|
||||
| otherwise =
|
||||
submatrix (x - 1) (x + 1) (y - 1) (y + 1) (lifeMat ud)
|
||||
submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
|
||||
life = countLife subm
|
||||
if (lifeMat ud) M.! (x, y) == 1
|
||||
if (lifeMat ud) M.! (y, x) == 1
|
||||
then if life == 2 || life == 3
|
||||
then return 1
|
||||
else return 0
|
||||
then if foodMat ud M.! (y, x) > 0
|
||||
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
|
||||
else return (0, foodMat ud M.! (y, x), 1)
|
||||
else return (0, foodMat ud M.! (y, x), 1)
|
||||
else if life == 3
|
||||
then return 1
|
||||
else return 0
|
||||
then if foodMat ud M.! (y, x) > 0
|
||||
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
|
||||
else return
|
||||
( 0
|
||||
, if timeMat ud M.! (y, x) > 10
|
||||
then min 10 ((foodMat ud M.! (y, x)) + 1)
|
||||
else foodMat ud M.! (y, x)
|
||||
, timeMat ud M.! (y, x) + 1
|
||||
)
|
||||
else return
|
||||
( 0
|
||||
, if timeMat ud M.! (y, x) > 10
|
||||
then min 10 ((foodMat ud M.! (y, x)) + 1)
|
||||
else foodMat ud M.! (y, x)
|
||||
, (timeMat ud M.! (y, x)) + 1
|
||||
)
|
||||
) [0..3599]
|
||||
let newM = fromList 60 60 newList
|
||||
putAffection ud
|
||||
{ lifeMat = newM
|
||||
let newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList)
|
||||
let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
|
||||
let newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
|
||||
if (newLifeMat == M.zero 60 60)
|
||||
then
|
||||
reload
|
||||
else
|
||||
putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud)
|
||||
{ lifeMat = newLifeMat
|
||||
, foodMat = newFoodMat
|
||||
, timeMat = newTimeMat
|
||||
-- , lastUpdate = floor now
|
||||
}
|
||||
|
||||
countLife :: Matrix Word -> Word
|
||||
countLife mat = res - (mat M.! (2, 2))
|
||||
where
|
||||
res = foldr (\a acc -> a + acc) 0 mat
|
||||
res = foldr (\a acc -> acc + a) 0 mat
|
||||
|
||||
draw :: Affection UserData ()
|
||||
draw = do
|
||||
|
|
@ -181,8 +243,8 @@ draw = do
|
|||
beginFrame (nano ud) 600 600 1
|
||||
save (nano ud)
|
||||
mapM_ (\coord -> do
|
||||
let x = coord `div` 60
|
||||
y = coord `mod` 60
|
||||
let x = coord `mod` 60
|
||||
y = coord `div` 60
|
||||
ctx = nano ud
|
||||
mult = lifeMat ud M.! (x + 1, y + 1)
|
||||
-- logIO A.Debug $ show mult
|
||||
|
|
@ -192,7 +254,7 @@ draw = do
|
|||
then do
|
||||
fillColor ctx (rgba 255 255 255 255)
|
||||
else do
|
||||
fillColor ctx (rgba 0 0 0 255)
|
||||
fillColor ctx (rgba 0 (fromIntegral $ 25 * (foodMat ud M.! (x+1, y+1))) 0 255)
|
||||
fill ctx
|
||||
) [0..3599]
|
||||
restore (nano ud)
|
||||
|
|
|
|||
|
|
@ -14,8 +14,11 @@ import Control.Monad.IO.Class (liftIO)
|
|||
|
||||
data UserData = UserData
|
||||
{ lifeMat :: Matrix Word
|
||||
, foodMat :: Matrix Word
|
||||
, timeMat :: Matrix Word
|
||||
, subsystems :: Subsystems
|
||||
, nano :: Context
|
||||
, lastUpdate :: Int
|
||||
}
|
||||
|
||||
data Subsystems = Subsystems
|
||||
|
|
|
|||
Loading…
Reference in a new issue