blergh
This commit is contained in:
nek0
parent
b2e622a5c8
commit
ef6aa71142
2 changed files with 25 additions and 185 deletions
|
|
@ -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
|
||||
|
|
|
|||
192
src/Main.hs
192
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 ()
|
||||
|
|
|
|||
Loading…
Reference in a new issue