{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# 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 hiding (V2(..)) import Linear import Foreign.C.Types (CInt(..)) -- internal imports import Types foreign import ccall unsafe "glewInit" glewInit :: IO CInt maxFood :: Word maxFood = 255 main :: IO () main = do logIO A.Debug "Starting" let conf = AffectionConfig { initComponents = All , 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 , loadState = load , preLoop = pre , eventLoop = handle , updateLoop = update , drawLoop = draw , cleanUp = clean } withAffection conf load :: IO UserData load = do -- emptyMatrix <- zero 60 60 liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "making random" randList <- mapM (\_ -> randomRIO (0,1)) [0..3599] liftIO $ logIO A.Debug "creating context" nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) let fullMatrix = fromList 60 60 randList -- logIO A.Debug $ prettyMatrix fullMatrix empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection UserData ())]) empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection UserData ())]) return $ UserData { subsystems = Subsystems (Window empty1) (Keyboard empty3) , lifeMat = fullMatrix , foodMat = fromList 60 60 (repeat maxFood) , timeMat = M.zero 60 60 , nano = nanoCtx } pre :: Affection UserData () pre = do sd <- getAffection _ <- 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) (fitViewport (600/600)) now <- getElapsedTime putAffection sd 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 _ _ 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 ud <- getAffection now <- getElapsedTime randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599] let fullMatrix = fromList 60 60 randList putAffection ud { lifeMat = fullMatrix , foodMat = fromList 60 60 (repeat maxFood) , timeMat = M.zero 60 60 } 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 () showFPS _ = return () exitOnWindowClose :: WindowMessage -> Affection UserData () exitOnWindowClose wm = case wm of MsgWindowClose _ _ -> do liftIO $ logIO A.Debug "I heard another one..." quit _ -> return () exitOnWindowClose _ = return () handle :: [SDL.EventPayload] -> Affection UserData () handle es = do (Subsystems a b) <- subsystems <$> getAffection _ <- consumeSDLEvents a =<< consumeSDLEvents b es return () update :: Double -> Affection UserData () update _ = do ud <- getAffection newList <- mapM (\coord -> do let x = (coord `mod` 60) + 1 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 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 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 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 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) 1 2 (lifeMat ud)) | y == 1 = (submatrix 60 60 (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) 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 (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 return (1, (foodMat ud M.! (y, x)) - 1, 0) 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 maxFood ((foodMat ud M.! (y, x)) + 1) else min maxFood (foodMat ud M.! (y, x)) , timeMat ud M.! (y, x) + 1 ) ) [0..3599] let newLifeMat = 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 else putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud) { lifeMat = newLifeMat , foodMat = newFoodMat , timeMat = newTimeMat } countLife :: Matrix Word -> Word countLife mat = res - (mat M.! (2, 2)) where res = foldr (flip (+)) 0 mat draw :: Affection UserData () draw = do ud <- getAffection liftIO $ do beginFrame (nano ud) 600 600 1 save (nano ud) mapM_ (\coord -> do 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 beginPath ctx rect ctx (fromIntegral $ x * 10) (fromIntegral $ y * 10) 10 10 if mult == 1 then fillColor ctx (rgba 255 255 255 255) else fillColor ctx (rgba 0 (fromIntegral $ (255 `div` maxFood) * (foodMat ud M.! (x+1, y+1))) 0 255) fill ctx ) [0..3599] restore (nano ud) endFrame (nano ud) clean _ = return ()