modernize example01

This commit is contained in:
nek0 2018-12-25 18:12:14 +01:00
parent fa2501021c
commit 6f05969fab
2 changed files with 44 additions and 39 deletions

View file

@ -75,7 +75,6 @@ load = do
, foodMat = fromList 60 60 (repeat 10)
, timeMat = M.zero 60 60
, nano = nanoCtx
, lastUpdate = 0
}
pre :: Affection UserData ()
@ -84,26 +83,33 @@ pre = do
_ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc
_ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR
_ <- partSubscribe (subKeyboard $ subsystems sd) showFPS
_ <- partSubscribe (subKeyboard $ subsystems sd) toggleFullScreen
_ <- partSubscribe (subWindow $ subsystems sd) exitOnWindowClose
_ <- partSubscribe (subWindow $ subsystems sd) windowResize
_ <- partSubscribe (subWindow $ subsystems sd) (fitViewport (600/600))
now <- getElapsedTime
putAffection sd
{ lastUpdate = floor now
}
toggleFullScreen :: KeyboardMessage -> Affection UserData ()
toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym)
| SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen
| otherwise = return ()
toggleFullScreen _ = return ()
exitOnEsc :: KeyboardMessage -> Affection UserData ()
exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
exitOnEsc (MsgKeyboardEvent _ _ SDL.Pressed False sym) =
case SDL.keysymKeycode sym of
SDL.KeycodeEscape -> do
liftIO $ logIO A.Debug "Yo dog I heard..."
quit
_ -> return ()
exitOnEsc _ = return ()
reloadOnR :: KeyboardMessage -> Affection UserData ()
reloadOnR (MsgKeyboardEvent _ _ _ _ sym) =
case SDL.keysymKeycode sym of
SDL.KeycodeR -> reload
_ -> return ()
reloadOnR _ = return ()
reload :: Affection UserData ()
reload = do
@ -115,7 +121,6 @@ reload = do
{ lifeMat = fullMatrix
, foodMat = fromList 60 60 (repeat 10)
, timeMat = M.zero 60 60
, lastUpdate = floor now
}
showFPS :: KeyboardMessage -> Affection UserData ()
@ -125,6 +130,7 @@ showFPS (MsgKeyboardEvent _ _ _ _ sym) =
dt <- getDelta
liftIO $ logIO A.Debug $ "FPS: " ++ show (1 / dt)
_ -> return ()
showFPS _ = return ()
exitOnWindowClose :: WindowMessage -> Affection UserData ()
exitOnWindowClose wm =
@ -133,15 +139,7 @@ exitOnWindowClose wm =
liftIO $ logIO A.Debug "I heard another one..."
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 ()
exitOnWindowClose _ = return ()
handle :: [SDL.EventPayload] -> Affection UserData ()
handle es = do
@ -157,57 +155,66 @@ update _ = do
y = (coord `div` 60) + 1
subm
| x == 1 && y == 1 =
submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 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)
(submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud))
| x == 1 && y == 60 =
submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (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)
(submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud))
| x == 60 && y == 1 =
submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (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)
(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 59 60 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)
(submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud))
| x == 1 =
submatrix (y - 1) (y + 1) 60 60 (lifeMat ud)
(submatrix (y - 1) (y + 1) 60 60 (lifeMat ud))
<|>
submatrix (y - 1) (y + 1) 1 2 (lifeMat ud)
(submatrix (y - 1) (y + 1) 1 2 (lifeMat ud))
| y == 1 =
submatrix 60 60 (x - 1) (x + 1) (lifeMat ud)
(submatrix 60 60 (x - 1) (x + 1) (lifeMat ud))
<->
submatrix 1 2 (x - 1) (x + 1) (lifeMat ud)
(submatrix 1 2 (x - 1) (x + 1) (lifeMat ud))
| x == 60 =
submatrix (y - 1) (y + 1) 59 60 (lifeMat ud)
(submatrix (y - 1) (y + 1) 59 60 (lifeMat ud))
<|>
submatrix (y - 1) (y + 1) 1 1 (lifeMat ud)
(submatrix (y - 1) (y + 1) 1 1 (lifeMat ud))
| y == 60 =
submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud)
(submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud))
<->
submatrix 1 1 (x - 1) (x + 1) (lifeMat ud)
(submatrix 1 1 (x - 1) (x + 1) (lifeMat ud))
| otherwise =
submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
(submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud))
life = countLife subm
ret
| life == 0 && lifeMat ud M.! (y, x) == 0 =
( 0
, if timeMat ud M.! (y, x) >= 10
then min 10 (foodMat ud M.! (y, x) + 1)
else min 10 (foodMat ud M.! (y, x))
, timeMat ud M.! (y, x) + 1
)
| otherwise = (1, 1, 1)
if lifeMat ud M.! (y, x) == 1
then if life == 2 || life == 3 && foodMat ud M.! (y, x) > 0
then if (life == 2 || life == 3) && 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), 0)
else if life == 3 && 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)
else min 10 (foodMat ud M.! (y, x))
, timeMat ud M.! (y, x) + 1
)
) [0..3599]
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)
newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
if newLifeMat == M.zero 60 60
then
reload
@ -216,7 +223,6 @@ update _ = do
{ lifeMat = newLifeMat
, foodMat = newFoodMat
, timeMat = newTimeMat
-- , lastUpdate = floor now
}
countLife :: Matrix Word -> Word

View file

@ -18,7 +18,6 @@ data UserData = UserData
, timeMat :: Matrix Word
, subsystems :: Subsystems
, nano :: Context
, lastUpdate :: Int
}
data Subsystems = Subsystems