nek0/affection
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

modernize example01

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

82
examples/example01/Main.hs
View file

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

1
examples/example01/Types.hs
View file

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