diff --git a/src/InGame.hs b/src/InGame.hs index 9a9f8c1..80559fa 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -94,7 +94,7 @@ updateGame sec = do putAffection ud2 { haskelloids = nhs } - liftIO $ traceIO $ show $ length nhs + -- liftIO $ traceIO $ show $ length nhs ud3 <- getAffection ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw ud4 <- getAffection @@ -102,6 +102,22 @@ updateGame sec = do { shots = ups } +drawGame :: Affection UserData () +drawGame = do + ud <- getAffection + liftIO $ gegl_node_process $ nodeGraph ud M.! KeySink + present + (GeglRectangle (floor $ fst $ sPos $ ship ud) (floor $ snd $ sPos $ ship ud) 50 50) + (buffer ud) + False + mapM_ (\h -> do + let s = 100 `div` hDiv h + present + (GeglRectangle (floor $ fst $ hPos h) (floor $ snd $ hPos h) s s) + (buffer ud) + False + ) (haskelloids ud) + handleGameEvent :: Double -> SDL.Event -> Affection UserData () handleGameEvent sec e = do ad <- get diff --git a/src/Main.hs b/src/Main.hs index a9afdf1..4545a72 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -35,199 +35,23 @@ main = withAffection AffectionConfig } pre :: Affection UserData () -pre = smLoad Menu +pre = do + smLoad Menu + -- ud <- getAffection + -- liftIO $ gegl_node_process (nodeGraph ud M.! KeySink) + -- present + -- (GeglRectangle 0 0 800 600) + -- (buffer ud) + -- True update :: Double -> Affection UserData () update sec = do - -- traceM $ (show $ 1 / sec) ++ " FPS" - -- ad <- get wd <- getAffection - -- when (((floor $ elapsedTime ad :: Int) * 100) `mod` 10 < 2 && pixelSize wd > 3) $ do - -- liftIO $ gegl_node_set (nodeGraph wd M.! KeyPixelize) $ Operation "gegl:pixelize" - -- [ Property "size-x" $ PropertyInt $ pixelSize wd - 1 - -- , Property "size-y" $ PropertyInt $ pixelSize wd - 1 - -- ] - -- pd <- getAffection - -- putAffection pd - -- { pixelSize = pixelSize wd -1 - -- } - -- case state wd of - -- Menu -> - -- updateMenu sec - -- _ -> return () smUpdate (state wd) sec evs <- SDL.pollEvents - -- mapM_ (\e -> - -- case state wd of - -- Menu -> - -- handleMenuEvent sec e - -- InGame -> - -- handleGameEvent sec e - -- _ -> error "not yet implemented" - -- ) evs mapM_ (smEvent (state wd) sec) evs - -- ud2 <- getAffection - -- nhs <- mapM (updateHaskelloid sec) (haskelloids ud2) - -- -- liftIO $ traceIO $ show $ length nhs - -- putAffection ud2 - -- { haskelloids = nhs - -- } - -- ud3 <- getAffection - -- let nx = fst (sPos $ ship ud3) + (fst (sVel $ ship ud3)) * sec - -- ny = snd (sPos $ ship ud3) + (snd (sVel $ ship ud3)) * sec - -- (nnx, nny) = wrapAround (nx, ny) 50 - -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipTranslate) $ Operation "gegl:translate" - -- [ Property "x" $ PropertyDouble $ nnx - -- , Property "y" $ PropertyDouble $ nny - -- ] - -- liftIO $ gegl_node_set (nodeGraph ud3 M.! KeyShipRotate) $ Operation "gegl:rotate" - -- [ Property "degrees" $ PropertyDouble $ sRot $ ship ud3 - -- ] - -- ups <- updateParticleSystem (shots ud3) sec shotsUpd shotsDraw - -- ud4 <- getAffection - -- putAffection ud4 - -- { ship = (ship ud3) - -- { sPos = (nnx, nny) - -- } - -- , shots = ups - -- } - --- wrapAround :: (Ord t, Num t) => (t, t) -> t -> (t, t) --- wrapAround (nx, ny) width = (nnx, nny) --- where --- nnx = --- if nx > 800 --- then nx - (800 + width) --- else if nx < -width then nx + 800 + width else nx --- nny = --- if ny > 600 --- then ny - (600 + width) --- else if ny < -width then ny + 600 + width else ny draw :: Affection UserData () draw = do ud <- getAffection smDraw $ state ud - --- shotsUpd :: Double -> Particle -> Affection UserData Particle --- shotsUpd sec part@Particle{..} = do --- let newX = (fst particlePosition) + sec * (fromIntegral $ fst particleVelocity) --- newY = (snd particlePosition) + sec * (fromIntegral $ snd particleVelocity) --- (nnx, nny) = wrapAround (newX, newY) 4 --- liftIO $ gegl_node_set (particleNodeGraph M.! "rect") $ Operation "gegl:rectangle" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- ud <- getAffection --- inters <- catMaybes <$> mapM (\h -> do --- col <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ hPos h) --- (floor $ snd $ hPos h) --- (100 `div` hDiv h) --- (100 `div` hDiv h) --- ) --- case col of --- Just _ -> return $ Just h --- Nothing -> return Nothing --- ) (haskelloids ud) --- when (not $ null inters) $ --- haskelloidShotDown $ head inters --- lost <- liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) 4 4) --- (GeglRectangle --- (floor $ fst $ sPos $ ship ud) --- (floor $ snd $ sPos $ ship ud) --- 50 --- 50 --- ) --- maybe (return ()) (\_ -> --- lose --- ) lost --- return part --- { particlePosition = (nnx, nny) --- , particleTimeToLive = if (not $ null inters) then 0 else particleTimeToLive --- } --- --- haskelloidShotDown :: Haskelloid -> Affection UserData () --- haskelloidShotDown h = do --- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" --- ud <- getAffection --- let redHaskelloids = delete h (haskelloids ud) --- liftIO $ gegl_node_drop $ hNodeGraph h M.! "root" --- newHaskelloids <- catMaybes <$> foldM --- (\acc _ -> --- if hDiv h < 4 --- then --- liftIO $ insertHaskelloid acc (Just $ hDiv h) $ hPos h --- else --- return $ Nothing : acc --- ) --- (map Just redHaskelloids) ([0..1] :: [Int]) --- liftIO $ gegl_node_link_many $ map hFlange newHaskelloids --- if not $ null newHaskelloids --- then --- liftIO $ gegl_node_link --- (last $ map hFlange newHaskelloids) --- (nodeGraph ud M.! KeyHNop) --- else do --- liftIO $ traceIO "YOU WON!" --- liftIO $ gegl_node_link --- (nodeGraph ud M.! KeyWon) --- (nodeGraph ud M.! KeyFGNop) --- putAffection ud --- { wonlost = True --- } --- putAffection ud --- { haskelloids = newHaskelloids --- } --- --- shotsDraw :: GeglBuffer -> GeglNode -> Particle -> Affection UserData () --- shotsDraw _ _ _ = return () --- --- updateHaskelloid :: Double -> Haskelloid -> Affection UserData Haskelloid --- updateHaskelloid sec h@Haskelloid{..} = do --- let newX = (fst $ hPos) + sec * (fst $ hVel) --- newY = (snd $ hPos) + sec * (snd $ hVel) --- newRot = hRot + hPitch * sec --- (nnx, nny) = wrapAround (newX, newY) (100 / fromIntegral hDiv) --- liftIO $ gegl_node_set (hNodeGraph M.! "trans") $ Operation "gegl:translate" --- [ Property "x" $ PropertyDouble $ nnx --- , Property "y" $ PropertyDouble $ nny --- ] --- liftIO $ gegl_node_set (hNodeGraph M.! "rot") $ Operation "gegl:rotate" --- [ Property "degrees" $ PropertyDouble newRot --- ] --- ud <- getAffection --- lost <- --- case state ud of --- InGame -> liftIO $ gegl_rectangle_intersect --- (GeglRectangle (floor nnx) (floor nny) (100 `div` hDiv) (100 `div` hDiv)) --- (GeglRectangle --- (floor $ fst $ sPos $ ship ud) --- (floor $ snd $ sPos $ ship ud) --- 50 --- 50 --- ) --- _ -> return Nothing --- maybe (return ()) (\_ -> --- lose --- ) lost --- return h --- { hPos = (nnx, nny) --- , hRot = newRot --- } --- --- lose :: Affection UserData () --- lose = do --- ud <- getAffection --- liftIO $ traceIO "YOU LOST!" --- _ <- liftIO $ gegl_node_link --- (nodeGraph ud M.! KeyLost) --- (nodeGraph ud M.! KeyFGNop) --- putAffection ud --- { wonlost = True --- } --- _ <- liftIO $ gegl_node_disconnect (nodeGraph ud M.! KeyShipOver) "aux" --- return ()